vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 02:52:24 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

ulm library compiled by fixing integer, longint, shortint and set sizes. -- noch

Browse source
This commit is contained in:
norayr 2016-11-30 19:39:26 +04:00
parent c549f5847b
commit 0e1c5fe498
39 changed files with 733 additions and 723 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/library/ulm/ulmAssertions.Mod
View file

@ -35,7 +35,7 @@ MODULE ulmAssertions;
(* general error handling of library routines *) (* general error handling of library routines *)
IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, IO := ulmIO, Priorities := ulmPriorities, RelatedEvents := ulmRelatedEvents, Services := ulmServices; IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, IO := ulmIO, Priorities := ulmPriorities, RelatedEvents := ulmRelatedEvents, Services := ulmServices, Types := ulmTypes;
TYPE TYPE
Object = Disciplines.Object; Object = Disciplines.Object;

12
src/library/ulm/ulmAsymmetricCiphers.Mod
View file

@ -30,13 +30,13 @@ MODULE ulmAsymmetricCiphers; (* Michael Szczuka *)
(* abstraction for the use of public key ciphers *) (* abstraction for the use of public key ciphers *)
IMPORT BlockCiphers := ulmBlockCiphers, Ciphers := ulmCiphers, NetIO := ulmNetIO, PersistentObjects := ulmPersistentObjects, Services := ulmServices, Streams := ulmStreams; IMPORT BlockCiphers := ulmBlockCiphers, Ciphers := ulmCiphers, NetIO := ulmNetIO, PersistentObjects := ulmPersistentObjects, Services := ulmServices, Streams := ulmStreams, Types := ulmTypes;
CONST CONST
composed* = 0; isPrivateKey* = 1; composed* = 0; isPrivateKey* = 1;
TYPE TYPE
CapabilitySet* = SET; CapabilitySet* = Types.Set;
TYPE TYPE
Cipher* = POINTER TO CipherRec; Cipher* = POINTER TO CipherRec;
@ -66,13 +66,13 @@ MODULE ulmAsymmetricCiphers; (* Michael Szczuka *)
(* need to have this in case anyone wants to decrypt something with (* need to have this in case anyone wants to decrypt something with
a public cipher ... *) a public cipher ... *)
PROCEDURE Identity(in: Streams.Stream; key: Ciphers.Cipher; PROCEDURE Identity(in: Streams.Stream; key: Ciphers.Cipher;
length: INTEGER; out: Streams.Stream) : BOOLEAN; length: Types.Int32; out: Streams.Stream) : BOOLEAN;
BEGIN BEGIN
RETURN Streams.Copy(in, out, length); RETURN Streams.Copy(in, out, length);
END Identity; END Identity;
PROCEDURE Init* (key: Cipher; if: Interface; PROCEDURE Init* (key: Cipher; if: Interface;
cap: CapabilitySet; inLength, outLength: INTEGER); cap: CapabilitySet; inLength, outLength: Types.Int32);
BEGIN BEGIN
IF if.decrypt = NIL THEN IF if.decrypt = NIL THEN
(* decrypt is not defined, so we have only the public part of a cipher; (* decrypt is not defined, so we have only the public part of a cipher;
@ -122,7 +122,7 @@ MODULE ulmAsymmetricCiphers; (* Michael Szczuka *)
END ComposedEncrypt; END ComposedEncrypt;
PROCEDURE ComposedEncryptPart* (in: Streams.Stream; key: Cipher; PROCEDURE ComposedEncryptPart* (in: Streams.Stream; key: Cipher;
length: INTEGER; length: Types.Int32;
out: Streams.Stream) : BOOLEAN; out: Streams.Stream) : BOOLEAN;
BEGIN BEGIN
RETURN key.asymIf.compencrypt(in, key, length, out); RETURN key.asymIf.compencrypt(in, key, length, out);
@ -131,7 +131,7 @@ MODULE ulmAsymmetricCiphers; (* Michael Szczuka *)
PROCEDURE ComposedEncryptBlock* (in: Streams.Stream; key: Cipher; PROCEDURE ComposedEncryptBlock* (in: Streams.Stream; key: Cipher;
out: Streams.Stream) : BOOLEAN; out: Streams.Stream) : BOOLEAN;
VAR VAR
length : INTEGER; length : Types.Int32;
BEGIN BEGIN
length := BlockCiphers.GetInLength(key); length := BlockCiphers.GetInLength(key);
RETURN key.asymIf.compencrypt(in, key, length, out); RETURN key.asymIf.compencrypt(in, key, length, out);

16
src/library/ulm/ulmBlockCiphers.Mod
View file

@ -30,7 +30,7 @@ MODULE ulmBlockCiphers; (* Michael Szczuka *)
(* abstraction for the use of block ciphers *) (* abstraction for the use of block ciphers *)
IMPORT Ciphers := ulmCiphers, NetIO := ulmNetIO, PersistentObjects := ulmPersistentObjects, Services := ulmServices, Streams := ulmStreams; IMPORT Ciphers := ulmCiphers, NetIO := ulmNetIO, PersistentObjects := ulmPersistentObjects, Services := ulmServices, Streams := ulmStreams, Types := ulmTypes;
TYPE TYPE
Cipher* = POINTER TO CipherRec; Cipher* = POINTER TO CipherRec;
@ -38,8 +38,8 @@ MODULE ulmBlockCiphers; (* Michael Szczuka *)
CipherRec* = RECORD CipherRec* = RECORD
(Ciphers.CipherRec) (Ciphers.CipherRec)
(* private *) (* private *)
inLength: INTEGER; inLength: Types.Int32;
outLength: INTEGER; outLength: Types.Int32;
END; END;
VAR VAR
@ -47,7 +47,7 @@ MODULE ulmBlockCiphers; (* Michael Szczuka *)
if : PersistentObjects.Interface; if : PersistentObjects.Interface;
PROCEDURE Init* (key: Cipher; if: Ciphers.Interface; PROCEDURE Init* (key: Cipher; if: Ciphers.Interface;
inLength, outLength: INTEGER); inLength, outLength: Types.Int32);
(* init a block cipher with its special interface *) (* init a block cipher with its special interface *)
BEGIN BEGIN
Ciphers.Init(key, if); Ciphers.Init(key, if);
@ -57,13 +57,13 @@ MODULE ulmBlockCiphers; (* Michael Szczuka *)
key.outLength := outLength; key.outLength := outLength;
END Init; END Init;
PROCEDURE GetInLength* (key: Cipher) : INTEGER; PROCEDURE GetInLength* (key: Cipher) : Types.Int32;
(* returns the input block length of a block cipher *) (* returns the input block length of a block cipher *)
BEGIN BEGIN
RETURN key.inLength; RETURN key.inLength;
END GetInLength; END GetInLength;
PROCEDURE GetOutLength* (key: Cipher) : INTEGER; PROCEDURE GetOutLength* (key: Cipher) : Types.Int32;
(* returns the output block length of a block cipher *) (* returns the output block length of a block cipher *)
BEGIN BEGIN
RETURN key.outLength; RETURN key.outLength;
@ -72,7 +72,7 @@ MODULE ulmBlockCiphers; (* Michael Szczuka *)
PROCEDURE EncryptBlock* (in: Streams.Stream; key: Cipher; PROCEDURE EncryptBlock* (in: Streams.Stream; key: Cipher;
out: Streams.Stream) : BOOLEAN; out: Streams.Stream) : BOOLEAN;
VAR VAR
length : INTEGER; length : Types.Int32;
BEGIN BEGIN
length := GetInLength(key); length := GetInLength(key);
RETURN Ciphers.EncryptPart(in, key, length, out); RETURN Ciphers.EncryptPart(in, key, length, out);
@ -81,7 +81,7 @@ MODULE ulmBlockCiphers; (* Michael Szczuka *)
PROCEDURE DecryptBlock* (in: Streams.Stream; key: Cipher; PROCEDURE DecryptBlock* (in: Streams.Stream; key: Cipher;
out: Streams.Stream) : BOOLEAN; out: Streams.Stream) : BOOLEAN;
VAR VAR
length : INTEGER; length : Types.Int32;
BEGIN BEGIN
length := GetOutLength(key); length := GetOutLength(key);
RETURN Ciphers.DecryptPart(in, key, length, out); RETURN Ciphers.DecryptPart(in, key, length, out);

10
src/library/ulm/ulmCipherOps.Mod
View file

@ -30,18 +30,18 @@ MODULE ulmCipherOps; (* Michael Szczuka *)
(* useful functions for stream ciphers *) (* useful functions for stream ciphers *)
IMPORT Streams := ulmStreams, SYS := SYSTEM, Write := ulmWrite; IMPORT Streams := ulmStreams, SYS := SYSTEM, Write := ulmWrite, Types := ulmTypes;
PROCEDURE XorByte* (b1, b2: SYS.BYTE) : SYS.BYTE; PROCEDURE XorByte* (b1, b2: SYS.BYTE) : SYS.BYTE;
(* adds two bytes bitwise modulo 2 *) (* adds two bytes bitwise modulo 2 *)
BEGIN BEGIN
(*RETURN SYS.VAL(SYS.BYTE, SYS.VAL(SET, LONG(b1)) / SYS.VAL(SET, LONG(b2)))*) (*RETURN SYS.VAL(SYS.BYTE, SYS.VAL(Types.Set, LONG(b1)) / SYS.VAL(Types.Set, LONG(b2)))*)
RETURN SYS.VAL(SYS.BYTE, SYS.VAL(SET, LONG(LONG(SYS.VAL(SHORTINT, b1)))) RETURN SYS.VAL(SYS.BYTE, SYS.VAL(Types.Set, LONG(LONG(SYS.VAL(Types.Int8, b1))))
/ SYS.VAL(SET, LONG(LONG(SYS.VAL(SHORTINT, b2))))) / SYS.VAL(Types.Set, LONG(LONG(SYS.VAL(Types.Int8, b2)))))
END XorByte; END XorByte;
PROCEDURE XorStream* (in1, in2, out: Streams.Stream; PROCEDURE XorStream* (in1, in2, out: Streams.Stream;
length: INTEGER) : BOOLEAN; length: Types.Int32) : BOOLEAN;
(* adds two streams bitwise modulo 2; restricted to length bytes *) (* adds two streams bitwise modulo 2; restricted to length bytes *)
VAR VAR
b1, b2, res : SYS.BYTE; b1, b2, res : SYS.BYTE;

8
src/library/ulm/ulmCiphers.Mod
View file

@ -30,14 +30,14 @@
MODULE ulmCiphers; MODULE ulmCiphers;
IMPORT Objects := ulmObjects, PersistentObjects := ulmPersistentObjects, PersistentDisciplines := ulmPersistentDisciplines, Services := ulmServices, IMPORT Objects := ulmObjects, PersistentObjects := ulmPersistentObjects, PersistentDisciplines := ulmPersistentDisciplines, Services := ulmServices,
Streams := ulmStreams, Write := ulmWrite; Streams := ulmStreams, Write := ulmWrite, Types := ulmTypes;
TYPE TYPE
Cipher* = POINTER TO CipherRec; Cipher* = POINTER TO CipherRec;
TYPE TYPE
CryptProc* = PROCEDURE (in: Streams.Stream; key: Cipher; CryptProc* = PROCEDURE (in: Streams.Stream; key: Cipher;
length: INTEGER; out: Streams.Stream) : BOOLEAN; length: Types.Int32; out: Streams.Stream) : BOOLEAN;
TYPE TYPE
Interface* = POINTER TO InterfaceRec; Interface* = POINTER TO InterfaceRec;
@ -77,13 +77,13 @@ BEGIN
END Decrypt; END Decrypt;
PROCEDURE EncryptPart*(in: Streams.Stream; key: Cipher; PROCEDURE EncryptPart*(in: Streams.Stream; key: Cipher;
length: INTEGER; out: Streams.Stream) : BOOLEAN; length: Types.Int32; out: Streams.Stream) : BOOLEAN;
BEGIN BEGIN
RETURN key.if.encrypt(in, key, length, out); RETURN key.if.encrypt(in, key, length, out);
END EncryptPart; END EncryptPart;
PROCEDURE DecryptPart*(in: Streams.Stream; key: Cipher; PROCEDURE DecryptPart*(in: Streams.Stream; key: Cipher;
length: INTEGER; out: Streams.Stream) : BOOLEAN; length: Types.Int32; out: Streams.Stream) : BOOLEAN;
BEGIN BEGIN
RETURN key.if.decrypt(in, key, length, out); RETURN key.if.decrypt(in, key, length, out);
END DecryptPart; END DecryptPart;

8
src/library/ulm/ulmClocks.Mod
View file

@ -37,7 +37,7 @@
MODULE ulmClocks; MODULE ulmClocks;
IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Op := ulmOperations, Priorities := ulmPriorities, IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Op := ulmOperations, Priorities := ulmPriorities,
RelatedEvents := ulmRelatedEvents, Services := ulmServices, Times := ulmTimes; RelatedEvents := ulmRelatedEvents, Services := ulmServices, Times := ulmTimes, Types := ulmTypes;
TYPE TYPE
Clock* = POINTER TO ClockRec; Clock* = POINTER TO ClockRec;
@ -45,7 +45,7 @@ MODULE ulmClocks;
CONST CONST
settime* = 0; timer* = 1; passed* = 2; settime* = 0; timer* = 1; passed* = 2;
TYPE TYPE
CapabilitySet* = SET; (* OF [settime..passed] *) CapabilitySet* = Types.Set; (* OF [settime..passed] *)
TYPE TYPE
GetTimeProc* = PROCEDURE (clock: Clock; VAR time: Times.Time); GetTimeProc* = PROCEDURE (clock: Clock; VAR time: Times.Time);
SetTimeProc* = PROCEDURE (clock: Clock; time: Times.Time); SetTimeProc* = PROCEDURE (clock: Clock; time: Times.Time);
@ -102,13 +102,13 @@ MODULE ulmClocks;
ErrorEventRec* = ErrorEventRec* =
RECORD RECORD
(Events.EventRec) (Events.EventRec)
errorcode*: SHORTINT; errorcode*: Types.Int8;
END; END;
VAR VAR
errormsg*: ARRAY errorcodes OF Events.Message; errormsg*: ARRAY errorcodes OF Events.Message;
error*: Events.EventType; error*: Events.EventType;
PROCEDURE Error(clock: Clock; code: SHORTINT); PROCEDURE Error(clock: Clock; code: Types.Int8);
VAR VAR
event: ErrorEvent; event: ErrorEvent;
BEGIN BEGIN

12
src/library/ulm/ulmConclusions.Mod
View file

@ -39,22 +39,22 @@ MODULE ulmConclusions;
*) *)
IMPORT Errors := ulmErrors, Events := ulmEvents, Process := ulmProcess, RelatedEvents := ulmRelatedEvents, StreamDisciplines := ulmStreamDisciplines, IMPORT Errors := ulmErrors, Events := ulmEvents, Process := ulmProcess, RelatedEvents := ulmRelatedEvents, StreamDisciplines := ulmStreamDisciplines,
Streams := ulmStreams, Strings := ulmStrings, Write := ulmWrite; Streams := ulmStreams, Strings := ulmStrings, Write := ulmWrite, Types := ulmTypes;
VAR VAR
handlerSet*: Errors.HandlerSet; handlerSet*: Errors.HandlerSet;
errors*: INTEGER; (* number of errors *) errors*: Types.Int32; (* number of errors *)
fatalcode*: INTEGER; (* exit code on fatal events *) fatalcode*: Types.Int32; (* exit code on fatal events *)
(* private variables *) (* private variables *)
cmdName: Process.Name; (* should be sufficient for a base name *) cmdName: Process.Name; (* should be sufficient for a base name *)
cmdNameLen: INTEGER; (* Strings.Len(cmdName) *) cmdNameLen: Types.Int32; (* Strings.Len(cmdName) *)
(* private procedures *) (* private procedures *)
PROCEDURE GeneralHandler(event: Events.Event; kind: Errors.Kind); PROCEDURE GeneralHandler(event: Events.Event; kind: Errors.Kind);
VAR VAR
width: INTEGER; width: Types.Int32;
BEGIN BEGIN
IF event # NIL THEN IF event # NIL THEN
Write.IndentS(Streams.stderr); Write.IndentS(Streams.stderr);
@ -114,7 +114,7 @@ MODULE ulmConclusions;
text: ARRAY OF CHAR); text: ARRAY OF CHAR);
VAR VAR
queue: RelatedEvents.Queue; queue: RelatedEvents.Queue;
width: INTEGER; width: Types.Int32;
PROCEDURE ReverseQueue(VAR queue: RelatedEvents.Queue); PROCEDURE ReverseQueue(VAR queue: RelatedEvents.Queue);
VAR VAR

44
src/library/ulm/ulmConditions.Mod
View file

@ -60,12 +60,12 @@
MODULE ulmConditions; MODULE ulmConditions;
IMPORT Clocks := ulmClocks, Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Op := ulmOperations, IMPORT Clocks := ulmClocks, Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Op := ulmOperations,
Priorities := ulmPriorities, Process := ulmProcess, RelatedEvents := ulmRelatedEvents, Scales := ulmScales, Timers := ulmTimers, Times := ulmTimes, SYSTEM; Priorities := ulmPriorities, Process := ulmProcess, RelatedEvents := ulmRelatedEvents, Scales := ulmScales, Timers := ulmTimers, Times := ulmTimes, SYSTEM, Types := ulmTypes;
CONST CONST
tags = 64; tags = 64;
TYPE TYPE
Tag = INTEGER; (* 0..tags-1 *) Tag = Types.Int32; (* 0..tags-1 *)
(* tags are used for the hashs *) (* tags are used for the hashs *)
VAR VAR
nextTag: Tag; (* 0..tags-1, 0..tags-1, ... *) nextTag: Tag; (* 0..tags-1, 0..tags-1, ... *)
@ -95,16 +95,16 @@ MODULE ulmConditions;
ConditionSetRec* = ConditionSetRec* =
RECORD RECORD
(Objects.ObjectRec) (Objects.ObjectRec)
cardinality: INTEGER; cardinality: Types.Int32;
bucket: BucketTable; bucket: BucketTable;
(* for the iterator *) (* for the iterator *)
next: ConditionList; i: INTEGER; next: ConditionList; i: Types.Int32;
END; END;
CONST CONST
select* = 0; timelimit* = 1; async* = 2; timecond* = 3; preconditions* = 4; select* = 0; timelimit* = 1; async* = 2; timecond* = 3; preconditions* = 4;
TYPE TYPE
CapabilitySet* = SET; (* OF [select..preconditions] *) CapabilitySet* = Types.Set; (* OF [select..preconditions] *)
TYPE TYPE
SelectProc* = PROCEDURE (domain: Domain; conditionSet: ConditionSet; SelectProc* = PROCEDURE (domain: Domain; conditionSet: ConditionSet;
time: Times.Time; time: Times.Time;
@ -159,7 +159,7 @@ MODULE ulmConditions;
END; END;
TYPE TYPE
GetTimeOfNextTryProc* = PROCEDURE (iteration: INTEGER; GetTimeOfNextTryProc* = PROCEDURE (iteration: Types.Int32;
VAR time: Times.Time); VAR time: Times.Time);
(* return a relative time measure *) (* return a relative time measure *)
VAR VAR
@ -188,7 +188,7 @@ MODULE ulmConditions;
getTimeOfNextTry := p; getTimeOfNextTry := p;
END SetGetTimeOfNextTryProc; END SetGetTimeOfNextTryProc;
PROCEDURE GetTimeOfNextTry(iteration: INTEGER; VAR time: Times.Time); PROCEDURE GetTimeOfNextTry(iteration: Types.Int32; VAR time: Times.Time);
BEGIN BEGIN
Times.CreateAndSet(time, Times.relative, 0, 1, 0); Times.CreateAndSet(time, Times.relative, 0, 1, 0);
iteration := iteration DIV 5; iteration := iteration DIV 5;
@ -203,7 +203,7 @@ MODULE ulmConditions;
PROCEDURE CreateSet*(VAR conditionSet: ConditionSet); PROCEDURE CreateSet*(VAR conditionSet: ConditionSet);
VAR VAR
i: INTEGER; i: Types.Int32;
cset: ConditionSet; cset: ConditionSet;
BEGIN BEGIN
NEW(cset); NEW(cset);
@ -226,7 +226,7 @@ MODULE ulmConditions;
VAR VAR
listp: ConditionList; listp: ConditionList;
new: ConditionList; new: ConditionList;
i: INTEGER; i: Types.Int32;
BEGIN BEGIN
(* check if condition is already present in conditionSet *) (* check if condition is already present in conditionSet *)
i := condition.tag; i := condition.tag;
@ -245,7 +245,7 @@ MODULE ulmConditions;
PROCEDURE Excl*(conditionSet: ConditionSet; condition: Condition); PROCEDURE Excl*(conditionSet: ConditionSet; condition: Condition);
VAR VAR
prev, listp: ConditionList; prev, listp: ConditionList;
i: INTEGER; i: Types.Int32;
BEGIN BEGIN
i := condition.tag; i := condition.tag;
listp := conditionSet.bucket[i]; prev := NIL; listp := conditionSet.bucket[i]; prev := NIL;
@ -282,8 +282,8 @@ MODULE ulmConditions;
VAR VAR
listp: ConditionList; listp: ConditionList;
newelem, newelems: ConditionList; newelem, newelems: ConditionList;
count: INTEGER; (* # of added elements in newelems *) count: Types.Int32; (* # of added elements in newelems *)
i: INTEGER; i: Types.Int32;
BEGIN BEGIN
count := 0; count := 0;
i := 0; i := 0;
@ -320,7 +320,7 @@ MODULE ulmConditions;
CreateSet(result); Union(result, set1); Union(result, set2); CreateSet(result); Union(result, set1); Union(result, set2);
END Union3; END Union3;
PROCEDURE Card*(conditionSet: ConditionSet) : INTEGER; PROCEDURE Card*(conditionSet: ConditionSet) : Types.Int32;
BEGIN BEGIN
RETURN conditionSet.cardinality RETURN conditionSet.cardinality
END Card; END Card;
@ -334,7 +334,7 @@ MODULE ulmConditions;
PROCEDURE GetNextCondition*(conditionSet: ConditionSet; PROCEDURE GetNextCondition*(conditionSet: ConditionSet;
VAR condition: Condition) : BOOLEAN; VAR condition: Condition) : BOOLEAN;
VAR VAR
i: INTEGER; i: Types.Int32;
BEGIN BEGIN
IF conditionSet.next = NIL THEN IF conditionSet.next = NIL THEN
i := conditionSet.i; i := conditionSet.i;
@ -380,7 +380,7 @@ MODULE ulmConditions;
VAR domain: Domain) : BOOLEAN; VAR domain: Domain) : BOOLEAN;
VAR VAR
dom: Domain; dom: Domain;
i: INTEGER; i: Types.Int32;
listp: ConditionList; listp: ConditionList;
BEGIN BEGIN
dom := NIL; dom := NIL;
@ -448,7 +448,7 @@ MODULE ulmConditions;
VAR VAR
listp: ConditionList; listp: ConditionList;
i: INTEGER; i: Types.Int32;
PROCEDURE CreateList(VAR list: List); PROCEDURE CreateList(VAR list: List);
BEGIN BEGIN
@ -555,7 +555,7 @@ MODULE ulmConditions;
PROCEDURE SetupAsyncEvents(list: List) : BOOLEAN; PROCEDURE SetupAsyncEvents(list: List) : BOOLEAN;
VAR VAR
elp: Element; elp: Element;
listp: ConditionList; i: INTEGER; listp: ConditionList; i: Types.Int32;
wakeupEvent: WakeupEvent; wakeupEvent: WakeupEvent;
sendevent: SendEventProc; sendevent: SendEventProc;
anythingTrue: BOOLEAN; anythingTrue: BOOLEAN;
@ -603,7 +603,7 @@ MODULE ulmConditions;
queue: RelatedEvents.Queue; (* queue of waitErrors *) queue: RelatedEvents.Queue; (* queue of waitErrors *)
busyLoop: BOOLEAN; (* TRUE if we have to resort to a busy loop *) busyLoop: BOOLEAN; (* TRUE if we have to resort to a busy loop *)
wakeupEvent: Events.Event; (* iteration event for busy loops *) wakeupEvent: Events.Event; (* iteration event for busy loops *)
loopCnt: INTEGER; (* number of iterations *) loopCnt: Types.Int32; (* number of iterations *)
nextTime: Times.Time; nextTime: Times.Time;
minTime: Times.Time; minTime: Times.Time;
minTimeCond: Condition; minTimeCond: Condition;
@ -679,7 +679,7 @@ MODULE ulmConditions;
VAR setOfTrueConditions: ConditionSet; VAR setOfTrueConditions: ConditionSet;
errors: RelatedEvents.Object) : BOOLEAN; errors: RelatedEvents.Object) : BOOLEAN;
VAR VAR
listp: ConditionList; i: INTEGER; listp: ConditionList; i: Types.Int32;
condition: Condition; condition: Condition;
anythingTrue: BOOLEAN; anythingTrue: BOOLEAN;
BEGIN (* TestAndSelect *) BEGIN (* TestAndSelect *)
@ -728,7 +728,7 @@ MODULE ulmConditions;
PROCEDURE TestAsyncList(list: List) : BOOLEAN; PROCEDURE TestAsyncList(list: List) : BOOLEAN;
VAR VAR
element: Element; element: Element;
listp: ConditionList; i: INTEGER; listp: ConditionList; i: Types.Int32;
condition: Condition; condition: Condition;
anythingFound: BOOLEAN; anythingFound: BOOLEAN;
BEGIN BEGIN
@ -872,7 +872,7 @@ MODULE ulmConditions;
VAR setOfTrueConditions: ConditionSet; VAR setOfTrueConditions: ConditionSet;
errors: RelatedEvents.Object); errors: RelatedEvents.Object);
VAR VAR
listp: ConditionList; i: INTEGER; listp: ConditionList; i: Types.Int32;
testSet: ConditionSet; testSet: ConditionSet;
preconds: ConditionSet; preconds: ConditionSet;
domain: Domain; domain: Domain;
@ -881,7 +881,7 @@ MODULE ulmConditions;
PROCEDURE PretestClosure(testSet, preconds: ConditionSet); PROCEDURE PretestClosure(testSet, preconds: ConditionSet);
VAR VAR
listp: ConditionList; i: INTEGER; listp: ConditionList; i: Types.Int32;
domain: Domain; domain: Domain;
morePreconditions: ConditionSet; morePreconditions: ConditionSet;
evenMorePreconditions: ConditionSet; evenMorePreconditions: ConditionSet;

50
src/library/ulm/ulmConstStrings.Mod
View file

@ -49,8 +49,7 @@ MODULE ulmConstStrings;
(* WORM-device for strings *) (* WORM-device for strings *)
IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Process := ulmProcess, Services := ulmServices, Streams := ulmStreams, Strings := ulmStrings, IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Process := ulmProcess, Services := ulmServices, Streams := ulmStreams, Strings := ulmStrings, Texts := ulmTexts, Types := ulmTypes;
Texts := ulmTexts, Types := ulmTypes;
CONST CONST
tabsize = 1031; (* should be a prime number *) tabsize = 1031; (* should be a prime number *)
@ -65,7 +64,7 @@ MODULE ulmConstStrings;
BufferRec = BufferRec =
RECORD RECORD
buf: ARRAY bufsize OF CHAR; buf: ARRAY bufsize OF CHAR;
free: INTEGER; (* buf[free..bufsize-1] is unused *) free: Types.Int32; (* buf[free..bufsize-1] is unused *)
next: Buffer; next: Buffer;
END; END;
@ -74,17 +73,17 @@ MODULE ulmConstStrings;
RECORD RECORD
(Disciplines.ObjectRec) (Disciplines.ObjectRec)
(* read-only *) (* read-only *)
len-: Streams.Count; (* length of string in bytes *) len*: Streams.Count; (* length of string in bytes *)
hashval-: LONGINT; (* hash value *) hashval*: Types.Int32; (* hash value *)
(* private part *) (* private part *)
domain: Domain; domain: Domain;
length: Streams.Count; (* private copy of length *) length: Streams.Count; (* private copy of length *)
buf: Buffer; (* first buffer containing the string *) buf: Buffer; (* first buffer containing the string *)
offset: INTEGER; (* offset into buf *) offset: Types.Int32; (* offset into buf *)
next: String; (* list of strings with same hash value *) next: String; (* list of strings with same hash value *)
END; END;
TYPE TYPE
DomainRec* = DomainRec* =
RECORD RECORD
(Disciplines.ObjectRec) (Disciplines.ObjectRec)
@ -108,7 +107,7 @@ MODULE ulmConstStrings;
(Streams.StreamRec) (Streams.StreamRec)
string: String; string: String;
buf: Buffer; (* current buffer *) buf: Buffer; (* current buffer *)
offset: INTEGER; (* index in current buffer *) offset: Types.Int32; (* index in current buffer *)
pos: Streams.Count; (* current position *) pos: Streams.Count; (* current position *)
END; END;
@ -121,7 +120,7 @@ MODULE ulmConstStrings;
(* === internal procedures =========================================== *) (* === internal procedures =========================================== *)
PROCEDURE HashVal(s: Streams.Stream; len: Streams.Count; PROCEDURE HashVal(s: Streams.Stream; len: Streams.Count;
VAR hashval, orighashval: LONGINT); VAR hashval, orighashval: Types.Int32);
(* compute the hash value of the first `len' bytes of `s'; (* compute the hash value of the first `len' bytes of `s';
the hash value is returned in two variants: the hash value is returned in two variants:
hashval: hash value MOD tabsize hashval: hash value MOD tabsize
@ -130,7 +129,7 @@ MODULE ulmConstStrings;
CONST CONST
shift = 4; shift = 4;
VAR VAR
ordval: INTEGER; ordval: Types.Int32;
ch: CHAR; ch: CHAR;
index: Streams.Count; index: Streams.Count;
@ -159,7 +158,7 @@ MODULE ulmConstStrings;
*) *)
VAR VAR
ch: CHAR; ch: CHAR;
buf: Buffer; offset: INTEGER; buf: Buffer; offset: Types.Int32;
index: Streams.Count; index: Streams.Count;
BEGIN BEGIN
Streams.SetPos(s, 0); Streams.SetPos(s, 0);
@ -183,7 +182,7 @@ MODULE ulmConstStrings;
END Equal; END Equal;
PROCEDURE Allocate(domain: Domain; len: Streams.Count; PROCEDURE Allocate(domain: Domain; len: Streams.Count;
VAR buf: Buffer; VAR offset: INTEGER); VAR buf: Buffer; VAR offset: Types.Int32);
(* allocate space for `len' bytes; (* allocate space for `len' bytes;
`buf' and `offset' are returned, designating the `buf' and `offset' are returned, designating the
begin of the allocated area; note that begin of the allocated area; note that
@ -214,9 +213,9 @@ MODULE ulmConstStrings;
offset := buf.free; offset := buf.free;
WHILE len > 0 DO WHILE len > 0 DO
IF len <= bufsize - domain.tail.free THEN IF len <= bufsize - domain.tail.free THEN
INC(domain.tail.free, SHORT(len)); len := 0; INC(domain.tail.free, len); len := 0;
ELSE ELSE
DEC(len, bufsize - LONG(domain.tail.free)); DEC(len, bufsize - domain.tail.free);
domain.tail.free := bufsize; domain.tail.free := bufsize;
NewBuffer; NewBuffer;
END; END;
@ -224,7 +223,7 @@ MODULE ulmConstStrings;
END Allocate; END Allocate;
PROCEDURE CopyString(s: Streams.Stream; length: Streams.Count; PROCEDURE CopyString(s: Streams.Stream; length: Streams.Count;
buf: Buffer; offset: INTEGER); buf: Buffer; offset: Types.Int32);
(* copy `length' bytes from `s' to `buf' at the given offset (* copy `length' bytes from `s' to `buf' at the given offset
and its subsequent buffers and its subsequent buffers
*) *)
@ -254,7 +253,7 @@ MODULE ulmConstStrings;
VAR string: String); VAR string: String);
(* common part of CloseD and CreateD *) (* common part of CloseD and CreateD *)
VAR VAR
orighashval, hashval: LONGINT; orighashval, hashval: Types.Int32;
str: String; str: String;
BEGIN BEGIN
HashVal(s, length, hashval, orighashval); HashVal(s, length, hashval, orighashval);
@ -358,7 +357,7 @@ MODULE ulmConstStrings;
s := rs; s := rs;
END Open; END Open;
PROCEDURE Compare*(string1, string2: String) : INTEGER; PROCEDURE Compare*(string1, string2: String) : Types.Int32;
(* returns < 0: if string1 < string2 (* returns < 0: if string1 < string2
= 0: if string1 = string2 (see note above) = 0: if string1 = string2 (see note above)
> 0: if string1 > string2 > 0: if string1 > string2
@ -366,10 +365,10 @@ MODULE ulmConstStrings;
VAR VAR
ch1, ch2: CHAR; ch1, ch2: CHAR;
buf1, buf2: Buffer; buf1, buf2: Buffer;
offset1, offset2: INTEGER; offset1, offset2: Types.Int32;
len1, len2: Streams.Count; len1, len2: Streams.Count;
PROCEDURE Next(VAR buf: Buffer; VAR offset: INTEGER; VAR ch: CHAR); PROCEDURE Next(VAR buf: Buffer; VAR offset: Types.Int32; VAR ch: CHAR);
BEGIN BEGIN
ch := buf.buf[offset]; ch := buf.buf[offset];
INC(offset); INC(offset);
@ -409,7 +408,7 @@ MODULE ulmConstStrings;
VAR VAR
len: Streams.Count; len: Streams.Count;
buf: Buffer; buf: Buffer;
offset: INTEGER; offset: Types.Int32;
count: Streams.Count; count: Streams.Count;
bytes: Streams.Count; bytes: Streams.Count;
BEGIN BEGIN
@ -427,7 +426,7 @@ MODULE ulmConstStrings;
INC(count, s.count); INC(count, s.count);
EXIT EXIT
END; END;
INC(count, bytes); DEC(len, bytes); INC(offset, SHORT(bytes)); INC(count, bytes); DEC(len, bytes); INC(offset, bytes);
IF offset >= bufsize THEN IF offset >= bufsize THEN
buf := buf.next; buf := buf.next;
offset := 0; offset := 0;
@ -441,7 +440,7 @@ MODULE ulmConstStrings;
VAR VAR
len: Streams.Count; len: Streams.Count;
buf: Buffer; buf: Buffer;
offset: INTEGER; offset: Types.Int32;
index: Streams.Count; index: Streams.Count;
BEGIN BEGIN
len := string.length; len := string.length;
@ -480,7 +479,7 @@ MODULE ulmConstStrings;
END; END;
END ReadByte; END ReadByte;
PROCEDURE ReadBuf(s: Streams.Stream; VAR buf: ARRAY OF Types.Byte(*BYTE*); PROCEDURE ReadBuf(s: Streams.Stream; VAR buf: ARRAY OF Types.Byte;
off, cnt: Streams.Count) : Streams.Count; off, cnt: Streams.Count) : Streams.Count;
VAR VAR
bytes, max: Streams.Count; bytes, max: Streams.Count;
@ -520,7 +519,6 @@ MODULE ulmConstStrings;
| Streams.fromStart: realpos := cnt; | Streams.fromStart: realpos := cnt;
| Streams.fromPos: realpos := s.pos + cnt; | Streams.fromPos: realpos := s.pos + cnt;
| Streams.fromEnd: realpos := s.string.length + cnt; | Streams.fromEnd: realpos := s.string.length + cnt;
ELSE
END; END;
IF (realpos < 0) OR (realpos > s.string.length) THEN IF (realpos < 0) OR (realpos > s.string.length) THEN
RETURN FALSE RETURN FALSE
@ -531,10 +529,10 @@ MODULE ulmConstStrings;
END; END;
WHILE s.pos < realpos DO WHILE s.pos < realpos DO
IF realpos - s.pos < bufsize - s.offset THEN IF realpos - s.pos < bufsize - s.offset THEN
INC(s.offset, SHORT(realpos - s.pos)); INC(s.offset, realpos - s.pos);
s.pos := realpos; s.pos := realpos;
ELSE ELSE
INC(s.pos, LONG(bufsize - s.offset)); INC(s.pos, bufsize - s.offset);
s.offset := 0; s.offset := 0;
s.buf := s.buf.next; s.buf := s.buf.next;
END; END;

30
src/library/ulm/ulmEvents.Mod
View file

@ -39,7 +39,7 @@
MODULE ulmEvents; MODULE ulmEvents;
IMPORT Objects := ulmObjects, Priorities := ulmPriorities, Services := ulmServices, SYS := ulmSYSTEM; IMPORT Objects := ulmObjects, Priorities := ulmPriorities, Services := ulmServices, SYS := ulmSYSTEM, Types := ulmTypes;
TYPE TYPE
EventType* = POINTER TO EventTypeRec; EventType* = POINTER TO EventTypeRec;
@ -51,7 +51,7 @@ MODULE ulmEvents;
funcs* = 2; (* call associated event handlers *) funcs* = 2; (* call associated event handlers *)
TYPE TYPE
Reaction* = INTEGER; (* one of default, ignore, or funcs *) Reaction* = Types.Int32; (* one of default, ignore, or funcs *)
Message* = ARRAY 80 OF CHAR; Message* = ARRAY 80 OF CHAR;
Event* = POINTER TO EventRec; Event* = POINTER TO EventRec;
EventRec* = EventRec* =
@ -69,7 +69,7 @@ MODULE ulmEvents;
*) *)
EventManager = PROCEDURE (type: EventType; reaction: Reaction); EventManager = PROCEDURE (type: EventType; reaction: Reaction);
Priority = INTEGER; (* must be non-negative *) Priority = Types.Int32; (* must be non-negative *)
(* every event with reaction `funcs' has a handler list; (* every event with reaction `funcs' has a handler list;
the list is in calling order which is reverse to the list is in calling order which is reverse to
@ -104,7 +104,7 @@ MODULE ulmEvents;
Queue = POINTER TO QueueRec; Queue = POINTER TO QueueRec;
QueueRec = QueueRec =
RECORD RECORD
priority: INTEGER; (* queue for this priority *) priority: Types.Int32; (* queue for this priority *)
head, tail: Event; head, tail: Event;
next: Queue; (* queue with lower priority *) next: Queue; (* queue with lower priority *)
END; END;
@ -125,8 +125,8 @@ MODULE ulmEvents;
(* private part *) (* private part *)
currentPriority: Priority; currentPriority: Priority;
priotab: ARRAY priotabsize OF Priority; priotab: ARRAY priotabsize OF Priority;
priotop: INTEGER; priotop: Types.Int32;
overflow: INTEGER; (* of priority table *) overflow: Types.Int32; (* of priority table *)
END; END;
CONST CONST
@ -141,7 +141,7 @@ MODULE ulmEvents;
ErrorEventRec* = ErrorEventRec* =
RECORD RECORD
(EventRec) (EventRec)
errorcode*: SHORTINT; errorcode*: Types.Int8;
END; END;
VAR VAR
@ -151,7 +151,7 @@ MODULE ulmEvents;
VAR VAR
(* private part *) (* private part *)
abort, log, queueHandler: EventHandler; abort, log, queueHandler: EventHandler;
nestlevel: INTEGER; (* of Raise calls *) nestlevel: Types.Int32; (* of Raise calls *)
queue: Queue; queue: Queue;
lock: BOOLEAN; (* lock critical operations *) lock: BOOLEAN; (* lock critical operations *)
psys: PrioritySystem; (* current priority system *) psys: PrioritySystem; (* current priority system *)
@ -173,7 +173,7 @@ MODULE ulmEvents;
"negative priority given to Events.SetPriority"; "negative priority given to Events.SetPriority";
END InitErrorHandling; END InitErrorHandling;
PROCEDURE Error(code: SHORTINT); PROCEDURE Error(code: Types.Int8);
VAR event: ErrorEvent; VAR event: ErrorEvent;
BEGIN BEGIN
NEW(event); event.type := error; NEW(event); event.type := error;
@ -301,10 +301,10 @@ MODULE ulmEvents;
(* now QueueHandler will translate partly like (* now QueueHandler will translate partly like
BOOLEAN b; BOOLEAN b;
handler_EventHandler tmphandler; handler_EventHandler tmphandler;
LONGINT i, j; Types.Int32 i, j;
i = (LONGINT)handler; i = (Types.Int32)handler;
tmphandler = handler_NilHandler; tmphandler = handler_NilHandler;
j = (LONGINT)tmphandler; j = (Types.Int32)tmphandler;
b = i != j; b = i != j;
*) *)
(* changed because voc cannot compara handler and NilHandler -- noch *) (* changed because voc cannot compara handler and NilHandler -- noch *)
@ -316,12 +316,12 @@ MODULE ulmEvents;
*) *)
VAR b : BOOLEAN; (* noch *) VAR b : BOOLEAN; (* noch *)
tmphandler : EventHandler; tmphandler : EventHandler;
(*i,j : LONGINT;*) (*i,j : Types.Int32;*)
BEGIN BEGIN
(*i := SYSTEM.VAL(LONGINT, handler);*) (*i := SYSTEM.VAL(Types.Int32, handler);*)
tmphandler := NilHandler; tmphandler := NilHandler;
(*b := tmphandler = handler;*) (*b := tmphandler = handler;*)
(*j := SYSTEM.VAL(LONGINT, tmphandler); (*j := SYSTEM.VAL(Types.Int32, tmphandler);
b := i # j;*) b := i # j;*)
b := handler # tmphandler; b := handler # tmphandler;
(*ASSERT (handler # NilHandler);*) (*ASSERT (handler # NilHandler);*)

38
src/library/ulm/ulmIO.Mod
View file

@ -1,6 +1,6 @@
MODULE ulmIO; MODULE ulmIO;
IMPORT SYS := ulmSYSTEM, SYSTEM, Platform; IMPORT SYS := ulmSYSTEM, SYSTEM, Platform, Types := ulmTypes;
CONST nl = 0AX; CONST nl = 0AX;
@ -11,7 +11,7 @@ MODULE ulmIO;
dec = 1; dec = 1;
hex = 2; hex = 2;
TYPE TYPE
Basetype = SHORTINT; (* oct..hex *) Basetype = Types.Int8; (* oct..hex *)
(* basic IO *) (* basic IO *)
@ -22,7 +22,7 @@ MODULE ulmIO;
(* ==================== conversions ================================= *) (* ==================== conversions ================================= *)
PROCEDURE ConvertNumber(num, len: LONGINT; btyp: Basetype; neg: BOOLEAN; PROCEDURE ConvertNumber(num, len: Types.Int32; btyp: Basetype; neg: BOOLEAN;
VAR str: ARRAY OF CHAR); VAR str: ARRAY OF CHAR);
(* conversion of a number into a string of characters *) (* conversion of a number into a string of characters *)
@ -36,13 +36,13 @@ MODULE ulmIO;
VAR VAR
(*digits : ARRAY NumberLen+1 OF CHAR;*) (*digits : ARRAY NumberLen+1 OF CHAR;*)
digits : POINTER TO ARRAY OF CHAR; digits : POINTER TO ARRAY OF CHAR;
base : INTEGER; base : Types.Int32;
cnt, ix : INTEGER; cnt, ix : Types.Int32;
maxlen : LONGINT; maxlen : Types.Int32;
dig : LONGINT; dig : Types.Int32;
NumberLen : SHORTINT; NumberLen : Types.Int8;
BEGIN BEGIN
IF SIZE(LONGINT) = 8 THEN IF SIZE(Types.Int32) = 8 THEN
NumberLen := 21 NumberLen := 21
ELSE ELSE
NumberLen := 11 (* default value, corresponds to 32 bit *) NumberLen := 11 (* default value, corresponds to 32 bit *)
@ -107,7 +107,7 @@ MODULE ulmIO;
END; END;
END ConvertNumber; END ConvertNumber;
PROCEDURE ConvertInteger(num: LONGINT; len: INTEGER; VAR str: ARRAY OF PROCEDURE ConvertInteger(num: Types.Int32; len: Types.Int32; VAR str: ARRAY OF
CHAR); CHAR);
(* conversion of an integer decimal number to a string *) (* conversion of an integer decimal number to a string *)
BEGIN BEGIN
@ -119,8 +119,8 @@ MODULE ulmIO;
(* (*
PROCEDURE ReadChar(VAR ch: CHAR) : BOOLEAN; PROCEDURE ReadChar(VAR ch: CHAR) : BOOLEAN;
CONST read = 3; CONST read = 3;
(*VAR r0, r1: INTEGER;*) (*VAR r0, r1: Types.Int32;*)
VAR r0, r1: LONGINT; (* in ulm system INTEGER and LONGINT have the same 4 byte size; -- noch *) VAR r0, r1: Types.Int32; (* in ulm system Types.Int32 and Types.Int32 have the same 4 byte size; -- noch *)
BEGIN BEGIN
RETURN SYS.UNIXCALL(read, r0, r1, 0, SYSTEM.ADR(ch), 1) & (r0 > 0) RETURN SYS.UNIXCALL(read, r0, r1, 0, SYSTEM.ADR(ch), 1) & (r0 > 0)
END ReadChar; END ReadChar;
@ -128,7 +128,7 @@ MODULE ulmIO;
PROCEDURE ReadChar(VAR ch: CHAR) : BOOLEAN; PROCEDURE ReadChar(VAR ch: CHAR) : BOOLEAN;
(* Read one byte, returning success flag *) (* Read one byte, returning success flag *)
VAR error: Platform.ErrorCode; readcount: LONGINT; VAR error: Platform.ErrorCode; readcount: Types.Int32;
BEGIN BEGIN
error := Platform.ReadBuf(Platform.StdIn, ch, readcount); error := Platform.ReadBuf(Platform.StdIn, ch, readcount);
RETURN readcount > 0 RETURN readcount > 0
@ -137,8 +137,8 @@ MODULE ulmIO;
(* (*
PROCEDURE WriteChar(ch: CHAR) : BOOLEAN; PROCEDURE WriteChar(ch: CHAR) : BOOLEAN;
CONST write = 4; CONST write = 4;
(*VAR r0, r1: INTEGER;*) (*VAR r0, r1: Types.Int32;*)
VAR r0, r1: LONGINT; (* same here *) VAR r0, r1: Types.Int32; (* same here *)
BEGIN BEGIN
RETURN SYS.UNIXCALL(write, r0, r1, 1, SYSTEM.ADR(ch), 1) RETURN SYS.UNIXCALL(write, r0, r1, 1, SYSTEM.ADR(ch), 1)
END WriteChar; END WriteChar;
@ -186,7 +186,7 @@ MODULE ulmIO;
END WriteLn; END WriteLn;
PROCEDURE WriteString*(s: ARRAY OF CHAR); PROCEDURE WriteString*(s: ARRAY OF CHAR);
VAR i: INTEGER; VAR i: Types.Int32;
BEGIN BEGIN
i := 0; i := 0;
WHILE (i < LEN(s)) & (s[i] # 0X) DO WHILE (i < LEN(s)) & (s[i] # 0X) DO
@ -201,14 +201,14 @@ MODULE ulmIO;
Done := TRUE; Done := TRUE;
END InitIO; END InitIO;
PROCEDURE WriteInt*(arg: LONGINT); PROCEDURE WriteInt*(arg: Types.Int32);
VAR field: ARRAY 23 OF CHAR; VAR field: ARRAY 23 OF CHAR;
BEGIN (* the field size should be big enough to hold the long number. it was 12 to hold just 32 bit numbers, now it can hold 64 bit numbers; need to be more for 128bit numbers; -- noch *) BEGIN (* the field size should be big enough to hold the long number. it was 12 to hold just 32 bit numbers, now it can hold 64 bit numbers; need to be more for 128bit numbers; -- noch *)
ConvertInteger(arg, 1, field); ConvertInteger(arg, 1, field);
WriteString(field); WriteString(field);
END WriteInt; END WriteInt;
PROCEDURE ReadInt*(VAR arg: LONGINT); PROCEDURE ReadInt*(VAR arg: Types.Int32);
VAR ch: CHAR; VAR ch: CHAR;
minus: BOOLEAN; minus: BOOLEAN;
BEGIN BEGIN
@ -236,7 +236,7 @@ MODULE ulmIO;
PROCEDURE ReadLine*(VAR string: ARRAY OF CHAR); PROCEDURE ReadLine*(VAR string: ARRAY OF CHAR);
VAR VAR
index: INTEGER; index: Types.Int32;
ch: CHAR; ch: CHAR;
ok: BOOLEAN; ok: BOOLEAN;
BEGIN BEGIN

18
src/library/ulm/ulmIntOperations.Mod
View file

@ -43,16 +43,16 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
TYPE TYPE
CapabilitySet* = Operations.CapabilitySet; CapabilitySet* = Operations.CapabilitySet;
(* SET of [Operations.add..shift] *) (* Types.Set of [Operations.add..shift] *)
IsLargeEnoughForProc* = PROCEDURE (op: Operations.Operand; IsLargeEnoughForProc* = PROCEDURE (op: Operations.Operand;
n: LONGINT): BOOLEAN; n: Types.Int32): BOOLEAN;
UnsignedProc* = PROCEDURE (op: Operations.Operand): BOOLEAN; UnsignedProc* = PROCEDURE (op: Operations.Operand): BOOLEAN;
IntToOpProc* = PROCEDURE (int32: Types.Int32; VAR op: Operations.Operand); IntToOpProc* = PROCEDURE (int32: Types.Int32; VAR op: Operations.Operand);
OpToIntProc* = PROCEDURE (op: Operations.Operand; VAR int32: Types.Int32); OpToIntProc* = PROCEDURE (op: Operations.Operand; VAR int32: Types.Int32);
Log2Proc* = PROCEDURE (op: Operations.Operand): LONGINT; Log2Proc* = PROCEDURE (op: Operations.Operand): Types.Int32;
OddProc* = PROCEDURE (op: Operations.Operand): BOOLEAN; OddProc* = PROCEDURE (op: Operations.Operand): BOOLEAN;
ShiftProc* = PROCEDURE (op: Operations.Operand; ShiftProc* = PROCEDURE (op: Operations.Operand;
n: INTEGER): Operations.Operand; n: Types.Int32): Operations.Operand;
IntOperatorProc* = PROCEDURE(op: Operation; IntOperatorProc* = PROCEDURE(op: Operation;
op1, op2, op3: Operations.Operand; op1, op2, op3: Operations.Operand;
VAR result: Operations.Operand); VAR result: Operations.Operand);
@ -95,7 +95,7 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
END Capabilities; END Capabilities;
PROCEDURE IsLargeEnoughFor*(op: Operations.Operand; n: LONGINT): BOOLEAN; PROCEDURE IsLargeEnoughFor*(op: Operations.Operand; n: Types.Int32): BOOLEAN;
BEGIN BEGIN
WITH op: Operand DO WITH op: Operand DO
RETURN op.if.isLargeEnoughFor(op, n) RETURN op.if.isLargeEnoughFor(op, n)
@ -130,7 +130,7 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
END OpToInt; END OpToInt;
PROCEDURE Log2*(op: Operations.Operand): LONGINT; PROCEDURE Log2*(op: Operations.Operand): Types.Int32;
BEGIN BEGIN
WITH op: Operand DO WITH op: Operand DO
RETURN op.if.log2(op) RETURN op.if.log2(op)
@ -167,7 +167,7 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
END Op; END Op;
PROCEDURE Shift*(op1: Operations.Operand; n: INTEGER): Operations.Operand; PROCEDURE Shift*(op1: Operations.Operand; n: Types.Int32): Operations.Operand;
BEGIN BEGIN
WITH op1: Operand DO WITH op1: Operand DO
ASSERT(shift IN op1.caps); ASSERT(shift IN op1.caps);
@ -176,14 +176,14 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
END Shift; END Shift;
PROCEDURE Shift2*(VAR op1: Operations.Operand; n: INTEGER); PROCEDURE Shift2*(VAR op1: Operations.Operand; n: Types.Int32);
BEGIN BEGIN
op1 := Shift(op1, n); op1 := Shift(op1, n);
END Shift2; END Shift2;
PROCEDURE Shift3*(VAR result: Operations.Operand; op1: Operations.Operand; PROCEDURE Shift3*(VAR result: Operations.Operand; op1: Operations.Operand;
n : INTEGER); n : Types.Int32);
VAR VAR
tmpresult: Operations.Operand; tmpresult: Operations.Operand;
BEGIN BEGIN

56
src/library/ulm/ulmMC68881.Mod
View file

@ -5,7 +5,7 @@ MODULE ulmMC68881;
(* library interface to MC68881 instructions *) (* library interface to MC68881 instructions *)
IMPORT SYS := SYSTEM; IMPORT SYS := SYSTEM, Types := ulmTypes;
CONST CONST
available* = FALSE; (* TRUE if MC68881 present *) available* = FALSE; (* TRUE if MC68881 present *)
@ -36,130 +36,130 @@ MODULE ulmMC68881;
(* monadic operations *) (* monadic operations *)
PROCEDURE FACOS*(x: LONGREAL) : LONGREAL; PROCEDURE FACOS*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FACOS; END FACOS;
PROCEDURE FASIN*(x: LONGREAL) : LONGREAL; PROCEDURE FASIN*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FASIN; END FASIN;
PROCEDURE FATAN*(x: LONGREAL) : LONGREAL; PROCEDURE FATAN*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FATAN; END FATAN;
PROCEDURE FATANH*(x: LONGREAL) : LONGREAL; PROCEDURE FATANH*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FATANH; END FATANH;
PROCEDURE FCOS*(x: LONGREAL) : LONGREAL; PROCEDURE FCOS*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FCOS; END FCOS;
PROCEDURE FCOSH*(x: LONGREAL) : LONGREAL; PROCEDURE FCOSH*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FCOSH; END FCOSH;
PROCEDURE FETOX*(x: LONGREAL) : LONGREAL; PROCEDURE FETOX*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FETOX; END FETOX;
PROCEDURE FETOXM1*(x: LONGREAL) : LONGREAL; PROCEDURE FETOXM1*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FETOXM1; END FETOXM1;
PROCEDURE FGETEXP*(x: LONGREAL) : LONGREAL; PROCEDURE FGETEXP*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FGETEXP; END FGETEXP;
PROCEDURE FGETMAN*(x: LONGREAL) : LONGREAL; PROCEDURE FGETMAN*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FGETMAN; END FGETMAN;
PROCEDURE FLOG10*(x: LONGREAL) : LONGREAL; PROCEDURE FLOG10*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FLOG10; END FLOG10;
PROCEDURE FLOG2*(x: LONGREAL) : LONGREAL; PROCEDURE FLOG2*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FLOG2; END FLOG2;
PROCEDURE FLOGN*(x: LONGREAL) : LONGREAL; PROCEDURE FLOGN*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FLOGN; END FLOGN;
PROCEDURE FLOGNP1*(x: LONGREAL) : LONGREAL; PROCEDURE FLOGNP1*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FLOGNP1; END FLOGNP1;
PROCEDURE FSIN*(x: LONGREAL) : LONGREAL; PROCEDURE FSIN*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FSIN; END FSIN;
PROCEDURE FSINH*(x: LONGREAL) : LONGREAL; PROCEDURE FSINH*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FSINH; END FSINH;
PROCEDURE FSQRT*(x: LONGREAL) : LONGREAL; PROCEDURE FSQRT*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FSQRT; END FSQRT;
PROCEDURE FTAN*(x: LONGREAL) : LONGREAL; PROCEDURE FTAN*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FTAN; END FTAN;
PROCEDURE FTANH*(x: LONGREAL) : LONGREAL; PROCEDURE FTANH*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FTANH; END FTANH;
PROCEDURE FTENTOX*(x: LONGREAL) : LONGREAL; PROCEDURE FTENTOX*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FTENTOX; END FTENTOX;
PROCEDURE FTWOTOX*(x: LONGREAL) : LONGREAL; PROCEDURE FTWOTOX*(x: Types.Real64) : Types.Real64;
BEGIN BEGIN
RETURN ABS(x) RETURN ABS(x)
END FTWOTOX; END FTWOTOX;
PROCEDURE GetExceptionEnable*(VAR exceptions: SET); PROCEDURE GetExceptionEnable*(VAR exceptions: Types.Set);
BEGIN BEGIN
exceptions := {}; exceptions := {};
END GetExceptionEnable; END GetExceptionEnable;
PROCEDURE SetExceptionEnable*(exceptions: SET); PROCEDURE SetExceptionEnable*(exceptions: Types.Set);
BEGIN BEGIN
exceptions := {}; exceptions := {};
END SetExceptionEnable; END SetExceptionEnable;
PROCEDURE GetRoundingMode*(VAR precision, mode: INTEGER); PROCEDURE GetRoundingMode*(VAR precision, mode: Types.Int32);
BEGIN BEGIN
precision := 1; precision := 1;
mode := 2; mode := 2;
END GetRoundingMode; END GetRoundingMode;
PROCEDURE SetRoundingMode*(precision, mode: INTEGER); PROCEDURE SetRoundingMode*(precision, mode: Types.Int32);
BEGIN BEGIN
precision := 1; precision := 1;
mode := 2; mode := 2;
@ -170,12 +170,12 @@ MODULE ulmMC68881;
float must consist of at least floatlen bytes float must consist of at least floatlen bytes
*) *)
PROCEDURE RealToFloat*(real: LONGREAL; VAR float: ARRAY OF SYS.BYTE); PROCEDURE RealToFloat*(real: Types.Real64; VAR float: ARRAY OF SYS.BYTE);
BEGIN BEGIN
(*SYS.WMOVE(SYS.ADR(real), SYS.ADR(float), floatlen DIV 4);*) (*SYS.WMOVE(SYS.ADR(real), SYS.ADR(float), floatlen DIV 4);*)
END RealToFloat; END RealToFloat;
PROCEDURE FloatToReal*(float: ARRAY OF SYS.BYTE; VAR real: LONGREAL); PROCEDURE FloatToReal*(float: ARRAY OF SYS.BYTE; VAR real: Types.Real64);
BEGIN BEGIN
(*SYS.WMOVE(SYS.ADR(float), SYS.ADR(real), floatlen DIV 4);*) (*SYS.WMOVE(SYS.ADR(float), SYS.ADR(real), floatlen DIV 4);*)
END FloatToReal; END FloatToReal;

58
src/library/ulm/ulmNetIO.Mod
View file

@ -64,17 +64,17 @@ MODULE ulmNetIO;
ReadBooleanProc* = ReadBooleanProc* =
PROCEDURE (s: Streams.Stream; VAR boolean: BOOLEAN) : BOOLEAN; PROCEDURE (s: Streams.Stream; VAR boolean: BOOLEAN) : BOOLEAN;
ReadShortIntProc* = ReadShortIntProc* =
PROCEDURE (s: Streams.Stream; VAR shortint: SHORTINT) : BOOLEAN; PROCEDURE (s: Streams.Stream; VAR shortint: Types.Int8) : BOOLEAN;
ReadIntegerProc* = ReadIntegerProc* =
PROCEDURE (s: Streams.Stream; VAR integer: INTEGER) : BOOLEAN; PROCEDURE (s: Streams.Stream; VAR integer: Types.Int32) : BOOLEAN;
ReadLongIntProc* = ReadLongIntProc* =
PROCEDURE (s: Streams.Stream; VAR longint: LONGINT) : BOOLEAN; PROCEDURE (s: Streams.Stream; VAR longint: Types.Int32) : BOOLEAN;
ReadRealProc* = ReadRealProc* =
PROCEDURE (s: Streams.Stream; VAR real: REAL) : BOOLEAN; PROCEDURE (s: Streams.Stream; VAR real: Types.Real32) : BOOLEAN;
ReadLongRealProc* = ReadLongRealProc* =
PROCEDURE (s: Streams.Stream; VAR longreal: LONGREAL) : BOOLEAN; PROCEDURE (s: Streams.Stream; VAR longreal: Types.Real64) : BOOLEAN;
ReadSetProc* = ReadSetProc* =
PROCEDURE (s: Streams.Stream; VAR set: SET) : BOOLEAN; PROCEDURE (s: Streams.Stream; VAR set: Types.Set) : BOOLEAN;
ReadStringProc* = ReadStringProc* =
PROCEDURE (s: Streams.Stream; VAR string: ARRAY OF CHAR) : BOOLEAN; PROCEDURE (s: Streams.Stream; VAR string: ARRAY OF CHAR) : BOOLEAN;
ReadConstStringProc* = ReadConstStringProc* =
@ -88,17 +88,17 @@ MODULE ulmNetIO;
WriteBooleanProc* = WriteBooleanProc* =
PROCEDURE (s: Streams.Stream; boolean: BOOLEAN) : BOOLEAN; PROCEDURE (s: Streams.Stream; boolean: BOOLEAN) : BOOLEAN;
WriteShortIntProc* = WriteShortIntProc* =
PROCEDURE (s: Streams.Stream; shortint: SHORTINT) : BOOLEAN; PROCEDURE (s: Streams.Stream; shortint: Types.Int8) : BOOLEAN;
WriteIntegerProc* = WriteIntegerProc* =
PROCEDURE (s: Streams.Stream; integer: INTEGER) : BOOLEAN; PROCEDURE (s: Streams.Stream; integer: Types.Int32) : BOOLEAN;
WriteLongIntProc* = WriteLongIntProc* =
PROCEDURE (s: Streams.Stream; longint: LONGINT) : BOOLEAN; PROCEDURE (s: Streams.Stream; longint: Types.Int32) : BOOLEAN;
WriteRealProc* = WriteRealProc* =
PROCEDURE (s: Streams.Stream; real: REAL) : BOOLEAN; PROCEDURE (s: Streams.Stream; real: Types.Real32) : BOOLEAN;
WriteLongRealProc* = WriteLongRealProc* =
PROCEDURE (s: Streams.Stream; longreal: LONGREAL) : BOOLEAN; PROCEDURE (s: Streams.Stream; longreal: Types.Real64) : BOOLEAN;
WriteSetProc* = WriteSetProc* =
PROCEDURE (s: Streams.Stream; set: SET) : BOOLEAN; PROCEDURE (s: Streams.Stream; set: Types.Set) : BOOLEAN;
WriteStringProc* = WriteStringProc* =
PROCEDURE (s: Streams.Stream; string: ARRAY OF CHAR) : BOOLEAN; PROCEDURE (s: Streams.Stream; string: ARRAY OF CHAR) : BOOLEAN;
WriteConstStringProc* = WriteConstStringProc* =
@ -154,7 +154,7 @@ MODULE ulmNetIO;
PROCEDURE Swap (VAR a : ARRAY OF SYS.BYTE); PROCEDURE Swap (VAR a : ARRAY OF SYS.BYTE);
VAR VAR
i,j : LONGINT; i,j : Types.Int32;
tmp : SYS.BYTE; tmp : SYS.BYTE;
BEGIN BEGIN
i := 0; j := LEN (a) - 1; i := 0; j := LEN (a) - 1;
@ -166,8 +166,8 @@ MODULE ulmNetIO;
PROCEDURE BitSwap (VAR a : ARRAY OF SYS.BYTE); PROCEDURE BitSwap (VAR a : ARRAY OF SYS.BYTE);
VAR VAR
i,old, bit : LONGINT; i,old, bit : Types.Int32;
new : LONGINT; new : Types.Int32;
BEGIN BEGIN
i := 0; i := 0;
@ -266,7 +266,7 @@ MODULE ulmNetIO;
END; END;
END ReadBoolean; END ReadBoolean;
PROCEDURE ReadShortInt*(s: Streams.Stream; VAR shortint: SHORTINT) : BOOLEAN; PROCEDURE ReadShortInt*(s: Streams.Stream; VAR shortint: Types.Int8) : BOOLEAN;
VAR VAR
disc: Discipline; disc: Discipline;
BEGIN BEGIN
@ -277,7 +277,7 @@ MODULE ulmNetIO;
END; END;
END ReadShortInt; END ReadShortInt;
PROCEDURE ReadInteger*(s: Streams.Stream; VAR integer: INTEGER) : BOOLEAN; PROCEDURE ReadInteger*(s: Streams.Stream; VAR integer: Types.Int32) : BOOLEAN;
VAR VAR
disc: Discipline; disc: Discipline;
ret : BOOLEAN; ret : BOOLEAN;
@ -293,7 +293,7 @@ MODULE ulmNetIO;
END; END;
END ReadInteger; END ReadInteger;
PROCEDURE ReadLongInt*(s: Streams.Stream; VAR longint: LONGINT) : BOOLEAN; PROCEDURE ReadLongInt*(s: Streams.Stream; VAR longint: Types.Int32) : BOOLEAN;
VAR VAR
disc: Discipline; disc: Discipline;
ret : BOOLEAN; ret : BOOLEAN;
@ -309,7 +309,7 @@ MODULE ulmNetIO;
END; END;
END ReadLongInt; END ReadLongInt;
PROCEDURE ReadReal*(s: Streams.Stream; VAR real: REAL) : BOOLEAN; PROCEDURE ReadReal*(s: Streams.Stream; VAR real: Types.Real32) : BOOLEAN;
VAR VAR
disc: Discipline; disc: Discipline;
BEGIN BEGIN
@ -320,7 +320,7 @@ MODULE ulmNetIO;
END; END;
END ReadReal; END ReadReal;
PROCEDURE ReadLongReal*(s: Streams.Stream; VAR longreal: LONGREAL) : BOOLEAN; PROCEDURE ReadLongReal*(s: Streams.Stream; VAR longreal: Types.Real64) : BOOLEAN;
VAR VAR
disc: Discipline; disc: Discipline;
BEGIN BEGIN
@ -331,7 +331,7 @@ MODULE ulmNetIO;
END; END;
END ReadLongReal; END ReadLongReal;
PROCEDURE ReadSet*(s: Streams.Stream; VAR set: SET) : BOOLEAN; PROCEDURE ReadSet*(s: Streams.Stream; VAR set: Types.Set) : BOOLEAN;
VAR VAR
disc: Discipline; disc: Discipline;
ret : BOOLEAN; ret : BOOLEAN;
@ -350,7 +350,7 @@ MODULE ulmNetIO;
PROCEDURE ReadString*(s: Streams.Stream; VAR string: ARRAY OF CHAR) : BOOLEAN; PROCEDURE ReadString*(s: Streams.Stream; VAR string: ARRAY OF CHAR) : BOOLEAN;
VAR VAR
disc: Discipline; disc: Discipline;
ch: CHAR; index: LONGINT; ch: CHAR; index: Types.Int32;
BEGIN BEGIN
IF Seek(s, discID, disc) THEN IF Seek(s, discID, disc) THEN
RETURN disc.if.readString(s, string) RETURN disc.if.readString(s, string)
@ -372,7 +372,7 @@ MODULE ulmNetIO;
CONST CONST
bufsize = 512; bufsize = 512;
VAR VAR
length: LONGINT; length: Types.Int32;
buf: Streams.Stream; buf: Streams.Stream;
ch: CHAR; ch: CHAR;
disc: Discipline; disc: Discipline;
@ -442,7 +442,7 @@ MODULE ulmNetIO;
END; END;
END WriteBoolean; END WriteBoolean;
PROCEDURE WriteShortInt*(s: Streams.Stream; shortint: SHORTINT) : BOOLEAN; PROCEDURE WriteShortInt*(s: Streams.Stream; shortint: Types.Int8) : BOOLEAN;
VAR VAR
disc: Discipline; disc: Discipline;
BEGIN BEGIN
@ -453,7 +453,7 @@ MODULE ulmNetIO;
END; END;
END WriteShortInt; END WriteShortInt;
PROCEDURE WriteInteger*(s: Streams.Stream; integer: INTEGER) : BOOLEAN; PROCEDURE WriteInteger*(s: Streams.Stream; integer: Types.Int32) : BOOLEAN;
VAR VAR
disc: Discipline; disc: Discipline;
BEGIN BEGIN
@ -467,7 +467,7 @@ MODULE ulmNetIO;
END; END;
END WriteInteger; END WriteInteger;
PROCEDURE WriteLongInt*(s: Streams.Stream; longint: LONGINT) : BOOLEAN; PROCEDURE WriteLongInt*(s: Streams.Stream; longint: Types.Int32) : BOOLEAN;
VAR VAR
disc: Discipline; disc: Discipline;
BEGIN BEGIN
@ -481,7 +481,7 @@ MODULE ulmNetIO;
END; END;
END WriteLongInt; END WriteLongInt;
PROCEDURE WriteReal*(s: Streams.Stream; real: REAL) : BOOLEAN; PROCEDURE WriteReal*(s: Streams.Stream; real: Types.Real32) : BOOLEAN;
VAR VAR
disc: Discipline; disc: Discipline;
BEGIN BEGIN
@ -492,7 +492,7 @@ MODULE ulmNetIO;
END; END;
END WriteReal; END WriteReal;
PROCEDURE WriteLongReal*(s: Streams.Stream; longreal: LONGREAL) : BOOLEAN; PROCEDURE WriteLongReal*(s: Streams.Stream; longreal: Types.Real64) : BOOLEAN;
VAR VAR
disc: Discipline; disc: Discipline;
BEGIN BEGIN
@ -503,7 +503,7 @@ MODULE ulmNetIO;
END; END;
END WriteLongReal; END WriteLongReal;
PROCEDURE WriteSet*(s: Streams.Stream; set: SET) : BOOLEAN; PROCEDURE WriteSet*(s: Streams.Stream; set: Types.Set) : BOOLEAN;
VAR VAR
disc: Discipline; disc: Discipline;
BEGIN BEGIN

10
src/library/ulm/ulmOperations.Mod
View file

@ -44,22 +44,22 @@ MODULE ulmOperations;
(* generic support of arithmetic operations *) (* generic support of arithmetic operations *)
IMPORT Events := ulmEvents, Objects := ulmObjects, PersistentDisciplines := ulmPersistentDisciplines, PersistentObjects := ulmPersistentObjects, Services := ulmServices; IMPORT Events := ulmEvents, Objects := ulmObjects, PersistentDisciplines := ulmPersistentDisciplines, PersistentObjects := ulmPersistentObjects, Services := ulmServices, Types := ulmTypes;
CONST CONST
add* = 0; sub* = 1; mul* = 2; div* = 3; cmp* = 4; add* = 0; sub* = 1; mul* = 2; div* = 3; cmp* = 4;
TYPE TYPE
Operation* = SHORTINT; (* add..cmp *) Operation* = Types.Int8; (* add..cmp *)
Operand* = POINTER TO OperandRec; Operand* = POINTER TO OperandRec;
TYPE TYPE
CapabilitySet* = SET; (* SET OF [add..cmp] *) CapabilitySet* = Types.Set; (* Types.Set OF [add..cmp] *)
CreateProc* = PROCEDURE (VAR op: Operand); CreateProc* = PROCEDURE (VAR op: Operand);
(* should call Operations.Init for op *) (* should call Operations.Init for op *)
OperatorProc* = PROCEDURE (op: Operation; op1, op2: Operand; OperatorProc* = PROCEDURE (op: Operation; op1, op2: Operand;
VAR result: Operand); VAR result: Operand);
AssignProc* = PROCEDURE (VAR target: Operand; source: Operand); AssignProc* = PROCEDURE (VAR target: Operand; source: Operand);
CompareProc* = PROCEDURE (op1, op2: Operand) : INTEGER; CompareProc* = PROCEDURE (op1, op2: Operand) : Types.Int32;
Interface* = POINTER TO InterfaceRec; Interface* = POINTER TO InterfaceRec;
InterfaceRec* = InterfaceRec* =
RECORD RECORD
@ -194,7 +194,7 @@ MODULE ulmOperations;
Op(div, op1, op2, result); Op(div, op1, op2, result);
END Div3; END Div3;
PROCEDURE Compare*(op1, op2: Operand) : INTEGER; PROCEDURE Compare*(op1, op2: Operand) : Types.Int32;
BEGIN BEGIN
ASSERT(op1.if = op2.if); ASSERT(op1.if = op2.if);
ASSERT(cmp IN op1.caps); ASSERT(cmp IN op1.caps);

28
src/library/ulm/ulmPersistentObjects.Mod
View file

@ -72,7 +72,7 @@ MODULE ulmPersistentObjects;
IMPORT ASCII := ulmASCII, ConstStrings := ulmConstStrings, Disciplines := ulmDisciplines, Errors := ulmErrors, Events := ulmEvents, Forwarders := ulmForwarders, IMPORT ASCII := ulmASCII, ConstStrings := ulmConstStrings, Disciplines := ulmDisciplines, Errors := ulmErrors, Events := ulmEvents, Forwarders := ulmForwarders,
IndirectDisciplines := ulmIndirectDisciplines, Loader := ulmLoader, NetIO := ulmNetIO, Objects := ulmObjects, Priorities := ulmPriorities, IndirectDisciplines := ulmIndirectDisciplines, Loader := ulmLoader, NetIO := ulmNetIO, Objects := ulmObjects, Priorities := ulmPriorities,
RelatedEvents := ulmRelatedEvents, Services := ulmServices, StreamDisciplines := ulmStreamDisciplines, Streams := ulmStreams, Strings := ulmStrings, Texts := ulmTexts, SYS := SYSTEM; RelatedEvents := ulmRelatedEvents, Services := ulmServices, StreamDisciplines := ulmStreamDisciplines, Streams := ulmStreams, Strings := ulmStrings, Texts := ulmTexts, SYS := SYSTEM, Types := ulmTypes;
CONST CONST
maxNameLen = 128; (* max length of data type names *) maxNameLen = 128; (* max length of data type names *)
@ -123,8 +123,8 @@ MODULE ulmPersistentObjects;
maxF = 13; (* maximal valid form code *) maxF = 13; (* maximal valid form code *)
TYPE TYPE
Mode* = SHORTINT; Mode* = Types.Int8;
Form = SHORTINT; Form = Types.Int8;
Object* = POINTER TO ObjectRec; Object* = POINTER TO ObjectRec;
Type = POINTER TO TypeRec; Type = POINTER TO TypeRec;
@ -160,7 +160,7 @@ MODULE ulmPersistentObjects;
TypeEntry = POINTER TO TypeEntryRec; TypeEntry = POINTER TO TypeEntryRec;
TypeEntryRec = TypeEntryRec =
RECORD RECORD
code: LONGINT; code: Types.Int32;
type: Type; type: Type;
next: TypeEntry; next: TypeEntry;
END; END;
@ -185,7 +185,7 @@ MODULE ulmPersistentObjects;
baseType: Type; (* the next non-abstract base type *) baseType: Type; (* the next non-abstract base type *)
if: Interface; (* may be = NIL for abstract types *) if: Interface; (* may be = NIL for abstract types *)
ifs: InterfaceList; (* list of interfaces in reverse order *) ifs: InterfaceList; (* list of interfaces in reverse order *)
code: LONGINT; (* unique number *) code: Types.Int32; (* unique number *)
END; END;
(* this list is used for storing the base type list of an object during (* this list is used for storing the base type list of an object during
@ -201,7 +201,7 @@ MODULE ulmPersistentObjects;
(* each error causes an event; the error number is stored in (* each error causes an event; the error number is stored in
event.errorcode; the associated text can be taken from event.message event.errorcode; the associated text can be taken from event.message
*) *)
ErrorCode = SHORTINT; ErrorCode = Types.Int8;
Event = POINTER TO EventRec; Event = POINTER TO EventRec;
EventRec* = EventRec* =
RECORD RECORD
@ -230,7 +230,7 @@ MODULE ulmPersistentObjects;
VAR VAR
id: Disciplines.Identifier; id: Disciplines.Identifier;
nextTypeCode: LONGINT; (* for the generation of unique numbers *) nextTypeCode: Types.Int32; (* for the generation of unique numbers *)
potype: Services.Type; potype: Services.Type;
errormsg*: ARRAY errorcodes OF Events.Message; errormsg*: ARRAY errorcodes OF Events.Message;
@ -298,7 +298,7 @@ MODULE ulmPersistentObjects;
PROCEDURE WriteLn(s: Streams.Stream) : BOOLEAN; PROCEDURE WriteLn(s: Streams.Stream) : BOOLEAN;
VAR VAR
lineterm: StreamDisciplines.LineTerminator; lineterm: StreamDisciplines.LineTerminator;
width: INTEGER; width: Types.Int32;
BEGIN BEGIN
StreamDisciplines.GetLineTerm(s, lineterm); StreamDisciplines.GetLineTerm(s, lineterm);
IF ~WriteString(s, lineterm) THEN RETURN FALSE END; IF ~WriteString(s, lineterm) THEN RETURN FALSE END;
@ -383,7 +383,7 @@ MODULE ulmPersistentObjects;
(* encoding scheme: (* encoding scheme:
Object = Form Type Size ObjectInfo . Object = Form Type Size ObjectInfo .
Form = SHORTINT; Form = Types.Int8;
Type = Code (* codeF *) | Type = Code (* codeF *) |
Code TypeName (* incrF *) | Code TypeName (* incrF *) |
TypeName (* nameF *) | TypeName (* nameF *) |
@ -397,8 +397,8 @@ MODULE ulmPersistentObjects;
PROCEDURE DecodeForm(form: Form; PROCEDURE DecodeForm(form: Form;
VAR nameGiven, codeGiven, hier, size: BOOLEAN); VAR nameGiven, codeGiven, hier, size: BOOLEAN);
VAR VAR
typeform: SHORTINT; typeform: Types.Int8;
sizeform: SHORTINT; sizeform: Types.Int8;
BEGIN BEGIN
typeform := form MOD maskF; sizeform := form DIV maskF; typeform := form MOD maskF; sizeform := form DIV maskF;
nameGiven := typeform IN {incrF, nameF, hierF, incrhierF}; nameGiven := typeform IN {incrF, nameF, hierF, incrhierF};
@ -410,7 +410,7 @@ MODULE ulmPersistentObjects;
PROCEDURE GetModule(name: ARRAY OF CHAR; VAR module: ARRAY OF CHAR); PROCEDURE GetModule(name: ARRAY OF CHAR; VAR module: ARRAY OF CHAR);
(* get the name of the module where 'name' was defined *) (* get the name of the module where 'name' was defined *)
VAR VAR
index: INTEGER; index: Types.Int32;
BEGIN BEGIN
index := 0; index := 0;
WHILE (name[index] # ".") & (name[index] # 0X) & WHILE (name[index] # ".") & (name[index] # 0X) &
@ -471,7 +471,7 @@ MODULE ulmPersistentObjects;
PROCEDURE ReadType(s: Streams.Stream; VAR type: Type; PROCEDURE ReadType(s: Streams.Stream; VAR type: Type;
VAR sentinelFound, unknownTypeFound: BOOLEAN) : BOOLEAN; VAR sentinelFound, unknownTypeFound: BOOLEAN) : BOOLEAN;
VAR VAR
code: LONGINT; code: Types.Int32;
entry: TypeEntry; entry: TypeEntry;
typeName: TypeName; typeName: TypeName;
btype: Type; btype: Type;
@ -755,7 +755,7 @@ MODULE ulmPersistentObjects;
baseType: Services.Type; baseType: Services.Type;
member: InterfaceList; member: InterfaceList;
bt: Type; bt: Type;
ifval: INTEGER; ifval: Types.Int32;
BEGIN BEGIN
(* check the parameters *) (* check the parameters *)
ASSERT(name[0] # 0X); ASSERT(name[0] # 0X);

44
src/library/ulm/ulmPlotters.Mod
View file

@ -28,7 +28,7 @@
MODULE ulmPlotters; MODULE ulmPlotters;
IMPORT Events := ulmEvents, Objects := ulmObjects, Resources := ulmResources, Services := ulmServices, SYS := ulmSYSTEM; IMPORT Events := ulmEvents, Objects := ulmObjects, Resources := ulmResources, Services := ulmServices, SYS := ulmSYSTEM, Types := ulmTypes;
TYPE TYPE
Plotter* = POINTER TO PlotterRec; Plotter* = POINTER TO PlotterRec;
@ -41,7 +41,7 @@ MODULE ulmPlotters;
longdashed* = 4; longdashed* = 4;
lineModes* = 5; lineModes* = 5;
TYPE TYPE
LineMode* = SHORTINT; (* solid ... *) LineMode* = Types.Int8; (* solid ... *)
CONST CONST
setspace* = 0; setspace* = 0;
@ -50,34 +50,34 @@ MODULE ulmPlotters;
linemodes* = 3; linemodes* = 3;
linewidth* = 4; linewidth* = 4;
TYPE TYPE
CapabilitySet* = SET; (* OF setspace, erase ... *) CapabilitySet* = Types.Set; (* OF setspace, erase ... *)
TYPE TYPE
Description* = POINTER TO DescriptionRec; Description* = POINTER TO DescriptionRec;
DescriptionRec* = DescriptionRec* =
RECORD RECORD
(Objects.ObjectRec) (Objects.ObjectRec)
xmin*, ymin, xmax, ymax: INTEGER; (* maximal supported range *) xmin*, ymin, xmax, ymax: Types.Int32; (* maximal supported range *)
END; END;
TYPE TYPE
GetSpaceProc* = PROCEDURE ( GetSpaceProc* = PROCEDURE (
plotter: Plotter; plotter: Plotter;
VAR xmin, ymin, xmax, ymax: INTEGER); VAR xmin, ymin, xmax, ymax: Types.Int32);
SetSpaceProc* = PROCEDURE ( SetSpaceProc* = PROCEDURE (
plotter: Plotter; plotter: Plotter;
xmin, ymin, xmax, ymax: INTEGER); xmin, ymin, xmax, ymax: Types.Int32);
EraseProc* = PROCEDURE (plotter: Plotter); EraseProc* = PROCEDURE (plotter: Plotter);
MoveProc* = PROCEDURE (plotter: Plotter; xto, yto: INTEGER); MoveProc* = PROCEDURE (plotter: Plotter; xto, yto: Types.Int32);
LineProc* = PROCEDURE (plotter: Plotter; xfrom, yfrom, xto, yto: INTEGER); LineProc* = PROCEDURE (plotter: Plotter; xfrom, yfrom, xto, yto: Types.Int32);
ArcProc* = PROCEDURE ( ArcProc* = PROCEDURE (
plotter: Plotter; plotter: Plotter;
xcenter, ycenter, xstart, ystart, xend, yend: INTEGER); xcenter, ycenter, xstart, ystart, xend, yend: Types.Int32);
CircleProc* = PROCEDURE ( CircleProc* = PROCEDURE (
plotter: Plotter; xcenter, ycenter, radius: INTEGER); plotter: Plotter; xcenter, ycenter, radius: Types.Int32);
StringProc* = PROCEDURE (plotter: Plotter; str: ARRAY OF CHAR); StringProc* = PROCEDURE (plotter: Plotter; str: ARRAY OF CHAR);
SetLineModeProc* = PROCEDURE (plotter: Plotter; mode: LineMode); SetLineModeProc* = PROCEDURE (plotter: Plotter; mode: LineMode);
SetLineWidthProc* = PROCEDURE (plotter: Plotter; width: INTEGER); SetLineWidthProc* = PROCEDURE (plotter: Plotter; width: Types.Int32);
CloseProc* = PROCEDURE (plotter: Plotter); CloseProc* = PROCEDURE (plotter: Plotter);
TYPE TYPE
Interface* = POINTER TO InterfaceRec; Interface* = POINTER TO InterfaceRec;
@ -105,7 +105,7 @@ MODULE ulmPlotters;
if: Interface; if: Interface;
caps: CapabilitySet; caps: CapabilitySet;
desc: Description; desc: Description;
xmin, ymin, xmax, ymax: INTEGER; (* current range *) xmin, ymin, xmax, ymax: Types.Int32; (* current range *)
terminated: BOOLEAN; terminated: BOOLEAN;
END; END;
VAR VAR
@ -162,7 +162,7 @@ MODULE ulmPlotters;
PROCEDURE GetSpace*(plotter: Plotter; PROCEDURE GetSpace*(plotter: Plotter;
VAR xmin, ymin, VAR xmin, ymin,
xmax, ymax: INTEGER); xmax, ymax: Types.Int32);
BEGIN BEGIN
xmin := plotter.xmin; xmin := plotter.xmin;
xmax := plotter.xmax; xmax := plotter.xmax;
@ -172,7 +172,7 @@ MODULE ulmPlotters;
PROCEDURE GetMaxSpace*(plotter: Plotter; PROCEDURE GetMaxSpace*(plotter: Plotter;
VAR xmin, ymin, VAR xmin, ymin,
xmax, ymax: INTEGER); xmax, ymax: Types.Int32);
BEGIN BEGIN
xmin := plotter.desc.xmin; xmin := plotter.desc.xmin;
xmax := plotter.desc.xmax; xmax := plotter.desc.xmax;
@ -182,7 +182,7 @@ MODULE ulmPlotters;
PROCEDURE SetSpace*(plotter: Plotter; PROCEDURE SetSpace*(plotter: Plotter;
xmin, ymin, xmin, ymin,
xmax, ymax: INTEGER); xmax, ymax: Types.Int32);
BEGIN BEGIN
ASSERT((xmin < xmax) & (ymin < ymax)); ASSERT((xmin < xmax) & (ymin < ymax));
ASSERT((xmin >= plotter.desc.xmin) & ASSERT((xmin >= plotter.desc.xmin) &
@ -203,33 +203,33 @@ MODULE ulmPlotters;
plotter.if.erase(plotter); plotter.if.erase(plotter);
END Erase; END Erase;
PROCEDURE Move*(plotter: Plotter; xto, yto: INTEGER); PROCEDURE Move*(plotter: Plotter; xto, yto: Types.Int32);
BEGIN BEGIN
plotter.if.move(plotter, xto, yto); plotter.if.move(plotter, xto, yto);
END Move; END Move;
PROCEDURE Cont*(plotter: Plotter; xto, yto: INTEGER); PROCEDURE Cont*(plotter: Plotter; xto, yto: Types.Int32);
BEGIN BEGIN
plotter.if.cont(plotter, xto, yto); plotter.if.cont(plotter, xto, yto);
END Cont; END Cont;
PROCEDURE Point*(plotter: Plotter; xpoint, ypoint: INTEGER); PROCEDURE Point*(plotter: Plotter; xpoint, ypoint: Types.Int32);
BEGIN BEGIN
plotter.if.point(plotter, xpoint, ypoint); plotter.if.point(plotter, xpoint, ypoint);
END Point; END Point;
PROCEDURE Line*(plotter: Plotter; xfrom, yfrom, xto, yto: INTEGER); PROCEDURE Line*(plotter: Plotter; xfrom, yfrom, xto, yto: Types.Int32);
BEGIN BEGIN
plotter.if.line(plotter, xfrom, yfrom, xto, yto); plotter.if.line(plotter, xfrom, yfrom, xto, yto);
END Line; END Line;
PROCEDURE Arc*(plotter: Plotter; PROCEDURE Arc*(plotter: Plotter;
xcenter, ycenter, xstart, ystart, xend, yend: INTEGER); xcenter, ycenter, xstart, ystart, xend, yend: Types.Int32);
BEGIN BEGIN
plotter.if.arc(plotter, xcenter, ycenter, xstart, ystart, xend, yend); plotter.if.arc(plotter, xcenter, ycenter, xstart, ystart, xend, yend);
END Arc; END Arc;
PROCEDURE Circle*(plotter: Plotter; xcenter, ycenter, radius: INTEGER); PROCEDURE Circle*(plotter: Plotter; xcenter, ycenter, radius: Types.Int32);
BEGIN BEGIN
plotter.if.circle(plotter, xcenter, ycenter, radius); plotter.if.circle(plotter, xcenter, ycenter, radius);
END Circle; END Circle;
@ -246,7 +246,7 @@ MODULE ulmPlotters;
plotter.if.setLineMode(plotter, mode); plotter.if.setLineMode(plotter, mode);
END SetLineMode; END SetLineMode;
PROCEDURE SetLineWidth*(plotter: Plotter; width: INTEGER); PROCEDURE SetLineWidth*(plotter: Plotter; width: Types.Int32);
BEGIN BEGIN
ASSERT((linewidth IN plotter.caps) & (width > 0)); ASSERT((linewidth IN plotter.caps) & (width > 0));
plotter.if.setLineWidth(plotter, width); plotter.if.setLineWidth(plotter, width);

292
src/library/ulm/ulmPrint.Mod
View file

@ -35,7 +35,7 @@
---------------------------------------------------------------------------- ----------------------------------------------------------------------------
*) *)
MODULE Print; MODULE ulmPrint;
(* formatted printing; (* formatted printing;
Print.F[0-9] prints to Streams.stdout Print.F[0-9] prints to Streams.stdout
@ -44,7 +44,7 @@ MODULE Print;
*) *)
IMPORT Events := ulmEvents, IEEE := ulmIEEE, Priorities := ulmPriorities, Reals := ulmReals, RelatedEvents := ulmRelatedEvents, StreamDisciplines := ulmStreamDisciplines, IMPORT Events := ulmEvents, IEEE := ulmIEEE, Priorities := ulmPriorities, Reals := ulmReals, RelatedEvents := ulmRelatedEvents, StreamDisciplines := ulmStreamDisciplines,
Streams := ulmStreams, SYS := SYSTEM; Streams := ulmStreams, SYS := SYSTEM, Types := ulmTypes;
CONST CONST
tooManyArgs* = 0; (* too many arguments given *) tooManyArgs* = 0; (* too many arguments given *)
@ -54,15 +54,15 @@ MODULE Print;
errors* = 4; errors* = 4;
TYPE TYPE
FormatString* = ARRAY 128 OF CHAR; FormatString* = ARRAY 128 OF CHAR;
ErrorCode* = SHORTINT; ErrorCode* = Types.Int8;
ErrorEvent* = POINTER TO ErrorEventRec; ErrorEvent* = POINTER TO ErrorEventRec;
ErrorEventRec* = ErrorEventRec* =
RECORD RECORD
(Events.EventRec) (Events.EventRec)
errorcode*: ErrorCode; errorcode*: ErrorCode;
format*: FormatString; format*: FormatString;
errpos*: LONGINT; errpos*: Types.Int32;
nargs*: INTEGER; nargs*: Types.Int32;
END; END;
VAR VAR
error*: Events.EventType; error*: Events.EventType;
@ -80,20 +80,20 @@ MODULE Print;
"size of argument doesn't conform to the corresponding format element"; "size of argument doesn't conform to the corresponding format element";
END InitErrorHandling; END InitErrorHandling;
PROCEDURE Out(out: Streams.Stream; VAR fmt: ARRAY OF CHAR; nargs: INTEGER; PROCEDURE Out(out: Streams.Stream; VAR fmt: ARRAY OF CHAR; nargs: Types.Int32;
VAR p1,p2,p3,p4,p5,p6,p7,p8,p9: ARRAY OF BYTE; VAR p1,p2,p3,p4,p5,p6,p7,p8,p9: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object); errors: RelatedEvents.Object);
CONST CONST
maxargs = 9; (* maximal number of arguments *) maxargs = 9; (* maximal number of arguments *)
maxargsize = SIZE(LONGREAL); (* maximal arg size (except strings) *) maxargsize = SIZE(Types.Real64); (* maximal arg size (except strings) *)
fmtcmd = "%"; fmtcmd = "%";
escape = "\"; escape = "\";
VAR VAR
arglen: ARRAY maxargs OF LONGINT; arglen: ARRAY maxargs OF Types.Int32;
nextarg: INTEGER; nextarg: Types.Int32;
fmtindex: LONGINT; fmtindex: Types.Int32;
fmtchar: CHAR; fmtchar: CHAR;
hexcharval: LONGINT; hexcharval: Types.Int32;
PROCEDURE Error(errorcode: ErrorCode); PROCEDURE Error(errorcode: ErrorCode);
VAR VAR
@ -133,7 +133,7 @@ MODULE Print;
END; END;
END Unget; END Unget;
PROCEDURE Write(byte: BYTE); PROCEDURE Write(byte: SYS.BYTE);
BEGIN BEGIN
IF Streams.WriteByte(out, byte) THEN IF Streams.WriteByte(out, byte) THEN
INC(out.count); INC(out.count);
@ -143,7 +143,7 @@ MODULE Print;
PROCEDURE WriteLn; PROCEDURE WriteLn;
VAR VAR
lineterm: StreamDisciplines.LineTerminator; lineterm: StreamDisciplines.LineTerminator;
i: INTEGER; i: Types.Int32;
BEGIN BEGIN
StreamDisciplines.GetLineTerm(out, lineterm); StreamDisciplines.GetLineTerm(out, lineterm);
Write(lineterm[0]); Write(lineterm[0]);
@ -153,7 +153,7 @@ MODULE Print;
END; END;
END WriteLn; END WriteLn;
PROCEDURE Int(VAR int: LONGINT; base: INTEGER) : BOOLEAN; PROCEDURE Int(VAR int: Types.Int32; base: Types.Int32) : BOOLEAN;
PROCEDURE ValidDigit(ch: CHAR) : BOOLEAN; PROCEDURE ValidDigit(ch: CHAR) : BOOLEAN;
BEGIN BEGIN
@ -179,7 +179,7 @@ MODULE Print;
PROCEDURE SetSize; PROCEDURE SetSize;
VAR VAR
index: INTEGER; index: Types.Int32;
BEGIN BEGIN
index := 0; index := 0;
WHILE index < nargs DO WHILE index < nargs DO
@ -193,12 +193,13 @@ MODULE Print;
| 6: arglen[index] := LEN(p7); | 6: arglen[index] := LEN(p7);
| 7: arglen[index] := LEN(p8); | 7: arglen[index] := LEN(p8);
| 8: arglen[index] := LEN(p9); | 8: arglen[index] := LEN(p9);
ELSE
END; END;
INC(index); INC(index);
END; END;
END SetSize; END SetSize;
PROCEDURE Access(par: INTEGER; at: LONGINT) : BYTE; PROCEDURE Access(par: Types.Int32; at: Types.Int32) : SYS.BYTE;
BEGIN BEGIN
CASE par OF CASE par OF
| 0: RETURN p1[at] | 0: RETURN p1[at]
@ -210,11 +211,12 @@ MODULE Print;
| 6: RETURN p7[at] | 6: RETURN p7[at]
| 7: RETURN p8[at] | 7: RETURN p8[at]
| 8: RETURN p9[at] | 8: RETURN p9[at]
ELSE
END; END;
END Access; END Access;
PROCEDURE Convert(from: INTEGER; VAR to: ARRAY OF BYTE); PROCEDURE Convert(from: Types.Int32; VAR to: ARRAY OF SYS.BYTE);
VAR i: INTEGER; VAR i: Types.Int32;
BEGIN BEGIN
i := 0; i := 0;
WHILE i < arglen[from] DO WHILE i < arglen[from] DO
@ -222,23 +224,23 @@ MODULE Print;
END; END;
END Convert; END Convert;
PROCEDURE GetInt(index: INTEGER; VAR long: LONGINT) : BOOLEAN; PROCEDURE GetInt(index: Types.Int32; VAR long: Types.Int32) : BOOLEAN;
(* access index-th parameter (counted from 0); (* access index-th parameter (counted from 0);
fails if arglen[index] > SYS.SIZE(LONGINT) fails if arglen[index] > SYS.SIZE(Types.Int32)
*) *)
VAR VAR
short: SHORTINT; short: Types.Int8;
int16: SYS.INT16; int16: SYS.INT16;
int: INTEGER; int: Types.Int32;
BEGIN BEGIN
IF arglen[index] = SIZE(SHORTINT) THEN IF arglen[index] = SIZE(Types.Int8) THEN
Convert(index, short); long := short; Convert(index, short); long := short;
ELSIF arglen[index] = SIZE(SYS.INT16) THEN ELSIF arglen[index] = SIZE(SYS.INT16) THEN
Convert(index, int16); long := int16; Convert(index, int16); long := int16;
ELSIF arglen[index] = SIZE(INTEGER) THEN ELSIF arglen[index] = SIZE(Types.Int32) THEN
Convert(index, int); long := int; Convert(index, int); long := int;
ELSIF arglen[index] = SIZE(LONGINT) THEN ELSIF arglen[index] = SIZE(Types.Int32) THEN
Convert(index, long); Convert(index, long);
ELSE ELSE
Error(badArgumentSize); Error(badArgumentSize);
@ -254,9 +256,9 @@ MODULE Print;
insert: BOOLEAN; (* insert between sign and 1st digit *) insert: BOOLEAN; (* insert between sign and 1st digit *)
sign: BOOLEAN; (* sign even positive values *) sign: BOOLEAN; (* sign even positive values *)
leftaligned: BOOLEAN; (* output left aligned *) leftaligned: BOOLEAN; (* output left aligned *)
width, scale: LONGINT; width, scale: Types.Int32;
PROCEDURE NextArg(VAR index: INTEGER) : BOOLEAN; PROCEDURE NextArg(VAR index: Types.Int32) : BOOLEAN;
BEGIN BEGIN
IF nextarg < nargs THEN IF nextarg < nargs THEN
index := nextarg; INC(nextarg); RETURN TRUE index := nextarg; INC(nextarg); RETURN TRUE
@ -284,9 +286,9 @@ MODULE Print;
RETURN FALSE (* unexpected end *) RETURN FALSE (* unexpected end *)
END Flags; END Flags;
PROCEDURE FetchInt(VAR int: LONGINT) : BOOLEAN; PROCEDURE FetchInt(VAR int: Types.Int32) : BOOLEAN;
VAR VAR
index: INTEGER; index: Types.Int32;
BEGIN BEGIN
RETURN (fmtchar = "*") & Next() & RETURN (fmtchar = "*") & Next() &
NextArg(index) & GetInt(index, int) OR NextArg(index) & GetInt(index, int) OR
@ -321,9 +323,9 @@ MODULE Print;
PROCEDURE Conversion() : BOOLEAN; PROCEDURE Conversion() : BOOLEAN;
PROCEDURE Fill(cnt: LONGINT); PROCEDURE Fill(cnt: Types.Int32);
(* cnt: space used by normal output *) (* cnt: space used by normal output *)
VAR i: LONGINT; VAR i: Types.Int32;
BEGIN BEGIN
IF cnt < width THEN IF cnt < width THEN
i := width - cnt; i := width - cnt;
@ -334,14 +336,14 @@ MODULE Print;
END; END;
END Fill; END Fill;
PROCEDURE FillLeft(cnt: LONGINT); PROCEDURE FillLeft(cnt: Types.Int32);
BEGIN BEGIN
IF ~leftaligned THEN IF ~leftaligned THEN
Fill(cnt); Fill(cnt);
END; END;
END FillLeft; END FillLeft;
PROCEDURE FillRight(cnt: LONGINT); PROCEDURE FillRight(cnt: Types.Int32);
BEGIN BEGIN
IF leftaligned THEN IF leftaligned THEN
Fill(cnt); Fill(cnt);
@ -349,10 +351,10 @@ MODULE Print;
END FillRight; END FillRight;
PROCEDURE WriteBool(true, false: ARRAY OF CHAR) : BOOLEAN; PROCEDURE WriteBool(true, false: ARRAY OF CHAR) : BOOLEAN;
VAR index: INTEGER; val: LONGINT; VAR index: Types.Int32; val: Types.Int32;
PROCEDURE WriteString(VAR s: ARRAY OF CHAR); PROCEDURE WriteString(VAR s: ARRAY OF CHAR);
VAR i, len: INTEGER; VAR i, len: Types.Int32;
BEGIN BEGIN
len := 0; len := 0;
WHILE (len < LEN(s)) & (s[len] # 0X) DO WHILE (len < LEN(s)) & (s[len] # 0X) DO
@ -379,8 +381,8 @@ MODULE Print;
PROCEDURE WriteChar() : BOOLEAN; PROCEDURE WriteChar() : BOOLEAN;
VAR VAR
val: LONGINT; val: Types.Int32;
index: INTEGER; index: Types.Int32;
BEGIN BEGIN
IF NextArg(index) & GetInt(index, val) & IF NextArg(index) & GetInt(index, val) &
(val >= 0) & (val <= ORD(MAX(CHAR))) THEN (val >= 0) & (val <= ORD(MAX(CHAR))) THEN
@ -392,21 +394,21 @@ MODULE Print;
RETURN FALSE RETURN FALSE
END WriteChar; END WriteChar;
PROCEDURE WriteInt(base: INTEGER) : BOOLEAN; PROCEDURE WriteInt(base: Types.Int32) : BOOLEAN;
VAR VAR
index: INTEGER; index: Types.Int32;
val: LONGINT; val: Types.Int32;
neg: BOOLEAN; (* set by Convert *) neg: BOOLEAN; (* set by Convert *)
buf: ARRAY 12 OF CHAR; (* filled by Convert *) buf: ARRAY 12 OF CHAR; (* filled by Convert *)
i: INTEGER; i: Types.Int32;
len: INTEGER; (* space needed for val *) len: Types.Int32; (* space needed for val *)
signcnt: INTEGER; (* =1 if sign printed; else 0 *) signcnt: Types.Int32; (* =1 if sign printed; else 0 *)
signch: CHAR; signch: CHAR;
PROCEDURE Convert; PROCEDURE Convert;
VAR VAR
index: INTEGER; index: Types.Int32;
digit: LONGINT; digit: Types.Int32;
BEGIN BEGIN
neg := val < 0; neg := val < 0;
index := 0; index := 0;
@ -462,36 +464,36 @@ MODULE Print;
CONST CONST
defaultscale = 6; defaultscale = 6;
VAR VAR
index: INTEGER; index: Types.Int32;
lr: LONGREAL; lr: Types.Real64;
r: REAL; r: Types.Real32;
shortint: SHORTINT; int: INTEGER; longint: LONGINT; shortint: Types.Int8; int: Types.Int32; longint: Types.Int32;
int16: SYS.INT16; int16: SYS.INT16;
long: BOOLEAN; long: BOOLEAN;
exponent: INTEGER; exponent: Types.Int32;
mantissa: LONGREAL; mantissa: Types.Real64;
digits: ARRAY Reals.maxlongdignum OF CHAR; digits: ARRAY Reals.maxlongdignum OF CHAR;
neg: BOOLEAN; neg: BOOLEAN;
ndigits: INTEGER; ndigits: Types.Int32;
decpt: INTEGER; decpt: Types.Int32;
PROCEDURE Print(decpt: INTEGER; withexp: BOOLEAN; exp: INTEGER); PROCEDURE Print(decpt: Types.Int32; withexp: BOOLEAN; exp: Types.Int32);
(* decpt: position of decimal point (* decpt: position of decimal point
= 0: just before the digits = 0: just before the digits
> 0: after decpt digits > 0: after decpt digits
< 0: ABS(decpt) zeroes before digits needed < 0: ABS(decpt) zeroes before digits needed
*) *)
VAR VAR
needed: INTEGER; (* space needed *) needed: Types.Int32; (* space needed *)
index: INTEGER; index: Types.Int32;
count: LONGINT; count: Types.Int32;
PROCEDURE WriteExp(exp: INTEGER); PROCEDURE WriteExp(exp: Types.Int32);
CONST CONST
base = 10; base = 10;
VAR VAR
power: INTEGER; power: Types.Int32;
digit: INTEGER; digit: Types.Int32;
BEGIN BEGIN
IF long THEN IF long THEN
Write("D"); Write("D");
@ -581,18 +583,18 @@ MODULE Print;
BEGIN (* WriteReal *) BEGIN (* WriteReal *)
IF NextArg(index) THEN IF NextArg(index) THEN
IF arglen[index] = SIZE(LONGREAL) THEN IF arglen[index] = SIZE(Types.Real64) THEN
long := TRUE; long := TRUE;
Convert(index, lr); Convert(index, lr);
ELSIF arglen[index] = SIZE(REAL) THEN ELSIF arglen[index] = SIZE(Types.Real32) THEN
long := FALSE; long := FALSE;
Convert(index, r); Convert(index, r);
lr := r; lr := r;
ELSIF arglen[index] = SIZE(LONGINT) THEN ELSIF arglen[index] = SIZE(Types.Int32) THEN
long := FALSE; long := FALSE;
Convert(index, longint); Convert(index, longint);
lr := longint; lr := longint;
ELSIF arglen[index] = SIZE(INTEGER) THEN ELSIF arglen[index] = SIZE(Types.Int32) THEN
long := FALSE; long := FALSE;
Convert(index, int); Convert(index, int);
lr := int; lr := int;
@ -600,7 +602,7 @@ MODULE Print;
long := FALSE; long := FALSE;
Convert(index, int16); Convert(index, int16);
lr := int16; lr := int16;
ELSIF arglen[index] = SIZE(SHORTINT) THEN ELSIF arglen[index] = SIZE(Types.Int8) THEN
long := FALSE; long := FALSE;
Convert(index, shortint); Convert(index, shortint);
lr := shortint; lr := shortint;
@ -634,6 +636,7 @@ MODULE Print;
ndigits := 1; ndigits := 1;
END; END;
| "g": ndigits := SHORT(scale); | "g": ndigits := SHORT(scale);
ELSE
END; END;
Reals.Digits(mantissa, 10, digits, neg, Reals.Digits(mantissa, 10, digits, neg,
(* force = *) format # "g", ndigits); (* force = *) format # "g", ndigits);
@ -654,6 +657,7 @@ MODULE Print;
END; END;
Print(decpt, (* withexp = *) FALSE, 0); Print(decpt, (* withexp = *) FALSE, 0);
END; END;
ELSE
END; END;
RETURN TRUE RETURN TRUE
ELSE ELSE
@ -663,16 +667,16 @@ MODULE Print;
PROCEDURE WriteString() : BOOLEAN; PROCEDURE WriteString() : BOOLEAN;
VAR VAR
index: INTEGER; index: Types.Int32;
i: LONGINT; i: Types.Int32;
byte: BYTE; byte: SYS.BYTE;
len: LONGINT; len: Types.Int32;
BEGIN BEGIN
IF NextArg(index) THEN IF NextArg(index) THEN
len := 0; len := 0;
WHILE (len < arglen[index]) & WHILE (len < arglen[index]) &
((scale = -1) OR (len < scale)) & ((scale = -1) OR (len < scale)) &
(CHR(Access(index, len)) # 0X) DO ((*CHR*)SYS.VAL(CHAR, Access(index, len)) # 0X) DO
INC(len); INC(len);
END; END;
FillLeft(len); FillLeft(len);
@ -755,205 +759,205 @@ MODULE Print;
(* === public part ============================================== *) (* === public part ============================================== *)
PROCEDURE F(fmt: ARRAY OF CHAR); PROCEDURE F*(fmt: ARRAY OF CHAR);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(Streams.stdout, fmt, 0, x,x,x,x,x,x,x,x,x, NIL); Out(Streams.stdout, fmt, 0, x,x,x,x,x,x,x,x,x, NIL);
END F; END F;
PROCEDURE F1(fmt: ARRAY OF CHAR; p1: ARRAY OF BYTE); PROCEDURE F1*(fmt: ARRAY OF CHAR; p1: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(Streams.stdout, fmt, 1, p1, x,x,x,x,x,x,x,x, NIL); Out(Streams.stdout, fmt, 1, p1, x,x,x,x,x,x,x,x, NIL);
END F1; END F1;
PROCEDURE F2(fmt: ARRAY OF CHAR; p1, p2: ARRAY OF BYTE); PROCEDURE F2*(fmt: ARRAY OF CHAR; p1, p2: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(Streams.stdout, fmt, 2, p1,p2, x,x,x,x,x,x,x, NIL); Out(Streams.stdout, fmt, 2, p1,p2, x,x,x,x,x,x,x, NIL);
END F2; END F2;
PROCEDURE F3(fmt: ARRAY OF CHAR; p1, p2, p3: ARRAY OF BYTE); PROCEDURE F3*(fmt: ARRAY OF CHAR; p1, p2, p3: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(Streams.stdout, fmt, 3, p1,p2,p3, x,x,x,x,x,x, NIL); Out(Streams.stdout, fmt, 3, p1,p2,p3, x,x,x,x,x,x, NIL);
END F3; END F3;
PROCEDURE F4(fmt: ARRAY OF CHAR; p1, p2, p3, p4: ARRAY OF BYTE); PROCEDURE F4*(fmt: ARRAY OF CHAR; p1, p2, p3, p4: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(Streams.stdout, fmt, 4, p1,p2,p3,p4, x,x,x,x,x, NIL); Out(Streams.stdout, fmt, 4, p1,p2,p3,p4, x,x,x,x,x, NIL);
END F4; END F4;
PROCEDURE F5(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5: ARRAY OF BYTE); PROCEDURE F5*(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(Streams.stdout, fmt, 5, p1,p2,p3,p4,p5, x,x,x,x, NIL); Out(Streams.stdout, fmt, 5, p1,p2,p3,p4,p5, x,x,x,x, NIL);
END F5; END F5;
PROCEDURE F6(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5, p6: ARRAY OF BYTE); PROCEDURE F6*(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5, p6: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(Streams.stdout, fmt, 6, p1,p2,p3,p4,p5,p6, x,x,x, NIL); Out(Streams.stdout, fmt, 6, p1,p2,p3,p4,p5,p6, x,x,x, NIL);
END F6; END F6;
PROCEDURE F7(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5, p6, p7: ARRAY OF BYTE); PROCEDURE F7*(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5, p6, p7: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(Streams.stdout, fmt, 7, p1,p2,p3,p4,p5,p6,p7, x,x, NIL); Out(Streams.stdout, fmt, 7, p1,p2,p3,p4,p5,p6,p7, x,x, NIL);
END F7; END F7;
PROCEDURE F8(fmt: ARRAY OF CHAR; PROCEDURE F8*(fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF BYTE); p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(Streams.stdout, fmt, 8, p1,p2,p3,p4,p5,p6,p7,p8, x, NIL); Out(Streams.stdout, fmt, 8, p1,p2,p3,p4,p5,p6,p7,p8, x, NIL);
END F8; END F8;
PROCEDURE F9(fmt: ARRAY OF CHAR; PROCEDURE F9*(fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF BYTE); p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF SYS.BYTE);
BEGIN BEGIN
Out(Streams.stdout, fmt, 9, p1,p2,p3,p4,p5,p6,p7,p8,p9, NIL); Out(Streams.stdout, fmt, 9, p1,p2,p3,p4,p5,p6,p7,p8,p9, NIL);
END F9; END F9;
PROCEDURE S(out: Streams.Stream; fmt: ARRAY OF CHAR); PROCEDURE S*(out: Streams.Stream; fmt: ARRAY OF CHAR);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 0, x,x,x,x,x,x,x,x,x, NIL); Out(out, fmt, 0, x,x,x,x,x,x,x,x,x, NIL);
END S; END S;
PROCEDURE S1(out: Streams.Stream; fmt: ARRAY OF CHAR; p1: ARRAY OF BYTE); PROCEDURE S1*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 1, p1, x,x,x,x,x,x,x,x, NIL); Out(out, fmt, 1, p1, x,x,x,x,x,x,x,x, NIL);
END S1; END S1;
PROCEDURE S2(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2: ARRAY OF BYTE); PROCEDURE S2*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 2, p1,p2, x,x,x,x,x,x,x, NIL); Out(out, fmt, 2, p1,p2, x,x,x,x,x,x,x, NIL);
END S2; END S2;
PROCEDURE S3(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2, p3: ARRAY OF BYTE); PROCEDURE S3*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2, p3: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 3, p1,p2,p3, x,x,x,x,x,x, NIL); Out(out, fmt, 3, p1,p2,p3, x,x,x,x,x,x, NIL);
END S3; END S3;
PROCEDURE S4(out: Streams.Stream; fmt: ARRAY OF CHAR; PROCEDURE S4*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4: ARRAY OF BYTE); p1, p2, p3, p4: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 4, p1,p2,p3,p4, x,x,x,x,x, NIL); Out(out, fmt, 4, p1,p2,p3,p4, x,x,x,x,x, NIL);
END S4; END S4;
PROCEDURE S5(out: Streams.Stream; fmt: ARRAY OF CHAR; PROCEDURE S5*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5: ARRAY OF BYTE); p1, p2, p3, p4, p5: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 5, p1,p2,p3,p4,p5, x,x,x,x, NIL); Out(out, fmt, 5, p1,p2,p3,p4,p5, x,x,x,x, NIL);
END S5; END S5;
PROCEDURE S6(out: Streams.Stream; fmt: ARRAY OF CHAR; PROCEDURE S6*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6: ARRAY OF BYTE); p1, p2, p3, p4, p5, p6: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 6, p1,p2,p3,p4,p5,p6, x,x,x, NIL); Out(out, fmt, 6, p1,p2,p3,p4,p5,p6, x,x,x, NIL);
END S6; END S6;
PROCEDURE S7(out: Streams.Stream; fmt: ARRAY OF CHAR; PROCEDURE S7*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7: ARRAY OF BYTE); p1, p2, p3, p4, p5, p6, p7: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 7, p1,p2,p3,p4,p5,p6,p7, x,x, NIL); Out(out, fmt, 7, p1,p2,p3,p4,p5,p6,p7, x,x, NIL);
END S7; END S7;
PROCEDURE S8(out: Streams.Stream; fmt: ARRAY OF CHAR; PROCEDURE S8*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF BYTE); p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF SYS.BYTE);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 8, p1,p2,p3,p4,p5,p6,p7,p8, x, NIL); Out(out, fmt, 8, p1,p2,p3,p4,p5,p6,p7,p8, x, NIL);
END S8; END S8;
PROCEDURE S9(out: Streams.Stream; fmt: ARRAY OF CHAR; PROCEDURE S9*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF BYTE); p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF SYS.BYTE);
BEGIN BEGIN
Out(out, fmt, 9, p1,p2,p3,p4,p5,p6,p7,p8,p9, NIL); Out(out, fmt, 9, p1,p2,p3,p4,p5,p6,p7,p8,p9, NIL);
END S9; END S9;
PROCEDURE SE(out: Streams.Stream; fmt: ARRAY OF CHAR; PROCEDURE SE*(out: Streams.Stream; fmt: ARRAY OF CHAR;
errors: RelatedEvents.Object); errors: RelatedEvents.Object);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 0, x,x,x,x,x,x,x,x,x, NIL); Out(out, fmt, 0, x,x,x,x,x,x,x,x,x, NIL);
END SE; END SE;
PROCEDURE SE1(out: Streams.Stream; fmt: ARRAY OF CHAR; p1: ARRAY OF BYTE; PROCEDURE SE1*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object); errors: RelatedEvents.Object);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 1, p1, x,x,x,x,x,x,x,x, errors); Out(out, fmt, 1, p1, x,x,x,x,x,x,x,x, errors);
END SE1; END SE1;
PROCEDURE SE2(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2: ARRAY OF BYTE; PROCEDURE SE2*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object); errors: RelatedEvents.Object);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 2, p1,p2, x,x,x,x,x,x,x, errors); Out(out, fmt, 2, p1,p2, x,x,x,x,x,x,x, errors);
END SE2; END SE2;
PROCEDURE SE3(out: Streams.Stream; fmt: ARRAY OF CHAR; PROCEDURE SE3*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3: ARRAY OF BYTE; p1, p2, p3: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object); errors: RelatedEvents.Object);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 3, p1,p2,p3, x,x,x,x,x,x, errors); Out(out, fmt, 3, p1,p2,p3, x,x,x,x,x,x, errors);
END SE3; END SE3;
PROCEDURE SE4(out: Streams.Stream; fmt: ARRAY OF CHAR; PROCEDURE SE4*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4: ARRAY OF BYTE; p1, p2, p3, p4: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object); errors: RelatedEvents.Object);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 4, p1,p2,p3,p4, x,x,x,x,x, errors); Out(out, fmt, 4, p1,p2,p3,p4, x,x,x,x,x, errors);
END SE4; END SE4;
PROCEDURE SE5(out: Streams.Stream; fmt: ARRAY OF CHAR; PROCEDURE SE5*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5: ARRAY OF BYTE; p1, p2, p3, p4, p5: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object); errors: RelatedEvents.Object);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 5, p1,p2,p3,p4,p5, x,x,x,x, errors); Out(out, fmt, 5, p1,p2,p3,p4,p5, x,x,x,x, errors);
END SE5; END SE5;
PROCEDURE SE6(out: Streams.Stream; fmt: ARRAY OF CHAR; PROCEDURE SE6*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6: ARRAY OF BYTE; p1, p2, p3, p4, p5, p6: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object); errors: RelatedEvents.Object);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 6, p1,p2,p3,p4,p5,p6, x,x,x, errors); Out(out, fmt, 6, p1,p2,p3,p4,p5,p6, x,x,x, errors);
END SE6; END SE6;
PROCEDURE SE7(out: Streams.Stream; fmt: ARRAY OF CHAR; PROCEDURE SE7*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7: ARRAY OF BYTE; p1, p2, p3, p4, p5, p6, p7: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object); errors: RelatedEvents.Object);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 7, p1,p2,p3,p4,p5,p6,p7, x,x, errors); Out(out, fmt, 7, p1,p2,p3,p4,p5,p6,p7, x,x, errors);
END SE7; END SE7;
PROCEDURE SE8(out: Streams.Stream; fmt: ARRAY OF CHAR; PROCEDURE SE8*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF BYTE; p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object); errors: RelatedEvents.Object);
VAR x: INTEGER; VAR x: Types.Int32;
BEGIN BEGIN
Out(out, fmt, 8, p1,p2,p3,p4,p5,p6,p7,p8, x, errors); Out(out, fmt, 8, p1,p2,p3,p4,p5,p6,p7,p8, x, errors);
END SE8; END SE8;
PROCEDURE SE9(out: Streams.Stream; fmt: ARRAY OF CHAR; PROCEDURE SE9*(out: Streams.Stream; fmt: ARRAY OF CHAR;
p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF BYTE; p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object); errors: RelatedEvents.Object);
BEGIN BEGIN
Out(out, fmt, 9, p1,p2,p3,p4,p5,p6,p7,p8,p9, errors); Out(out, fmt, 9, p1,p2,p3,p4,p5,p6,p7,p8,p9, errors);
@ -961,4 +965,4 @@ MODULE Print;
BEGIN BEGIN
InitErrorHandling; InitErrorHandling;
END Print. END ulmPrint.

4
src/library/ulm/ulmPriorities.Mod
View file

@ -49,7 +49,7 @@ MODULE ulmPriorities;
- gap defines the minimum distance between two priority regions - gap defines the minimum distance between two priority regions
defined in this module defined in this module
*) *)
IMPORT Types := ulmTypes;
CONST CONST
region* = 10; region* = 10;
gap* = 10; gap* = 10;
@ -59,7 +59,7 @@ MODULE ulmPriorities;
*) *)
TYPE TYPE
Priority* = INTEGER; Priority* = Types.Int32;
VAR VAR
(* current priority at begin of execution (after init of Events); (* current priority at begin of execution (after init of Events);

6
src/library/ulm/ulmProcess.Mod
View file

@ -36,7 +36,7 @@
MODULE ulmProcess; MODULE ulmProcess;
IMPORT Events := ulmEvents, Priorities := ulmPriorities; IMPORT Events := ulmEvents, Priorities := ulmPriorities, Types := ulmTypes;
(* user readable name of our process *) (* user readable name of our process *)
TYPE TYPE
@ -48,7 +48,7 @@ MODULE ulmProcess;
(* exit codes *) (* exit codes *)
TYPE TYPE
ExitCode* = INTEGER; ExitCode* = Types.Int32;
VAR VAR
indicateSuccess*: ExitCode; indicateSuccess*: ExitCode;
indicateFailure*: ExitCode; indicateFailure*: ExitCode;
@ -83,7 +83,7 @@ MODULE ulmProcess;
(* private declarations *) (* private declarations *)
VAR VAR
handlers: Interface; handlers: Interface;
nestlevel: INTEGER; nestlevel: Types.Int32;
PROCEDURE SetHandlers*(if: Interface); PROCEDURE SetHandlers*(if: Interface);
BEGIN BEGIN

40
src/library/ulm/ulmRandomGenerators.Mod
View file

@ -74,7 +74,7 @@ MODULE ulmRandomGenerators;
Sequence* = POINTER TO SequenceRec; Sequence* = POINTER TO SequenceRec;
Int32ValSProc* = PROCEDURE (sequence: Sequence): Types.Int32; Int32ValSProc* = PROCEDURE (sequence: Sequence): Types.Int32;
LongRealValSProc* = PROCEDURE (sequence: Sequence): LONGREAL; LongRealValSProc* = PROCEDURE (sequence: Sequence): Types.Real64;
RewindSequenceProc* = PROCEDURE (sequence: Sequence); RewindSequenceProc* = PROCEDURE (sequence: Sequence);
RestartSequenceProc* = PROCEDURE (sequence, seed: Sequence); RestartSequenceProc* = PROCEDURE (sequence, seed: Sequence);
SetValSProc* = PROCEDURE (sequence: Sequence; value: Operations.Operand); SetValSProc* = PROCEDURE (sequence: Sequence; value: Operations.Operand);
@ -83,7 +83,7 @@ MODULE ulmRandomGenerators;
int32ValS* = 0; longRealValS* = 1; rewindSequence* = 2; restartSequence* = 3; int32ValS* = 0; longRealValS* = 1; rewindSequence* = 2; restartSequence* = 3;
TYPE TYPE
CapabilitySet* = SET; (* of [int32ValS..restartSequence] *) CapabilitySet* = Types.Set; (* of [int32ValS..restartSequence] *)
Interface* = POINTER TO InterfaceRec; Interface* = POINTER TO InterfaceRec;
InterfaceRec* = InterfaceRec* =
RECORD RECORD
@ -127,8 +127,8 @@ MODULE ulmRandomGenerators;
DefaultSequenceRec = DefaultSequenceRec =
RECORD RECORD
(SequenceRec) (SequenceRec)
seed1, seed2: LONGINT; seed1, seed2: Types.Int32;
value1, value2: LONGINT; value1, value2: Types.Int32;
END; END;
ServiceDiscipline = POINTER TO ServiceDisciplineRec; ServiceDiscipline = POINTER TO ServiceDisciplineRec;
@ -146,9 +146,9 @@ MODULE ulmRandomGenerators;
(* ----- bug workaround ----- *) (* ----- bug workaround ----- *)
PROCEDURE Entier(value: LONGREAL): LONGINT; PROCEDURE Entier(value: Types.Real64): Types.Int32;
VAR VAR
result: LONGINT; result: Types.Int32;
BEGIN BEGIN
result := ENTIER(value); result := ENTIER(value);
IF result > value THEN IF result > value THEN
@ -193,12 +193,12 @@ MODULE ulmRandomGenerators;
sequence.if.restartSequence(sequence, seed); sequence.if.restartSequence(sequence, seed);
END RestartSequence; END RestartSequence;
PROCEDURE ^ LongRealValS*(sequence: Sequence): LONGREAL; PROCEDURE ^ LongRealValS*(sequence: Sequence): Types.Real64;
PROCEDURE Int32ValS*(sequence: Sequence): Types.Int32; PROCEDURE Int32ValS*(sequence: Sequence): Types.Int32;
(* get random 32-bit value from sequence *) (* get random 32-bit value from sequence *)
VAR VAR
real: LONGREAL; real: Types.Real64;
BEGIN BEGIN
IF int32ValS IN sequence.caps THEN IF int32ValS IN sequence.caps THEN
RETURN sequence.if.int32ValS(sequence) RETURN sequence.if.int32ValS(sequence)
@ -214,7 +214,7 @@ MODULE ulmRandomGenerators;
RETURN Int32ValS(std); RETURN Int32ValS(std);
END Int32Val; END Int32Val;
PROCEDURE LongRealValS*(sequence: Sequence): LONGREAL; PROCEDURE LongRealValS*(sequence: Sequence): Types.Real64;
(* get a uniformly distributed longreal value in [0..1) *) (* get a uniformly distributed longreal value in [0..1) *)
BEGIN BEGIN
IF longRealValS IN sequence.caps THEN IF longRealValS IN sequence.caps THEN
@ -225,32 +225,32 @@ MODULE ulmRandomGenerators;
END; END;
END LongRealValS; END LongRealValS;
PROCEDURE LongRealVal*(): LONGREAL; PROCEDURE LongRealVal*(): Types.Real64;
(* get a uniformly distributed longreal value in [0..1) *) (* get a uniformly distributed longreal value in [0..1) *)
BEGIN BEGIN
RETURN LongRealValS(std) RETURN LongRealValS(std)
END LongRealVal; END LongRealVal;
PROCEDURE RealValS*(sequence: Sequence): REAL; PROCEDURE RealValS*(sequence: Sequence): Types.Real32;
(* get a uniformly distributed real value in [0..1) *) (* get a uniformly distributed real value in [0..1) *)
BEGIN BEGIN
RETURN SHORT(LongRealValS(sequence)) RETURN SHORT(LongRealValS(sequence))
END RealValS; END RealValS;
PROCEDURE RealVal*(): REAL; PROCEDURE RealVal*(): Types.Real32;
(* get a uniformly distributed real value in [0..1) *) (* get a uniformly distributed real value in [0..1) *)
BEGIN BEGIN
RETURN SHORT(LongRealValS(std)) RETURN SHORT(LongRealValS(std))
END RealVal; END RealVal;
PROCEDURE ValS*(sequence: Sequence; low, high: LONGINT): LONGINT; PROCEDURE ValS*(sequence: Sequence; low, high: Types.Int32): Types.Int32;
(* get a uniformly distributed integer in [low..high] *) (* get a uniformly distributed integer in [low..high] *)
BEGIN BEGIN
ASSERT(low <= high); ASSERT(low <= high);
RETURN Entier( low + LongRealValS(sequence) * (1. + high - low) ) RETURN Entier( low + LongRealValS(sequence) * (1. + high - low) )
END ValS; END ValS;
PROCEDURE Val*(low, high: LONGINT): LONGINT; PROCEDURE Val*(low, high: Types.Int32): Types.Int32;
(* get a uniformly distributed integer in [low..high] *) (* get a uniformly distributed integer in [low..high] *)
BEGIN BEGIN
RETURN ValS(std, low, high) RETURN ValS(std, low, high)
@ -305,7 +305,7 @@ MODULE ulmRandomGenerators;
(* ----- DefaultSequence ----- *) (* ----- DefaultSequence ----- *)
PROCEDURE CongruentialStep(VAR value1, value2: LONGINT); PROCEDURE CongruentialStep(VAR value1, value2: Types.Int32);
BEGIN BEGIN
value1 := value1 :=
factor1 * (value1 MOD quotient1) - remainder1 * (value1 DIV quotient1); factor1 * (value1 MOD quotient1) - remainder1 * (value1 DIV quotient1);
@ -319,9 +319,9 @@ MODULE ulmRandomGenerators;
END; END;
END CongruentialStep; END CongruentialStep;
PROCEDURE DefaultSequenceValue(sequence: Sequence): LONGREAL; PROCEDURE DefaultSequenceValue(sequence: Sequence): Types.Real64;
VAR VAR
value: LONGINT; value: Types.Int32;
BEGIN BEGIN
WITH sequence: DefaultSequence DO WITH sequence: DefaultSequence DO
CongruentialStep(sequence.value1, sequence.value2); CongruentialStep(sequence.value1, sequence.value2);
@ -357,12 +357,12 @@ MODULE ulmRandomGenerators;
if: Interface; if: Interface;
daytime: Times.Time; daytime: Times.Time;
timeval: Times.TimeValueRec; timeval: Times.TimeValueRec;
count: LONGINT; count: Types.Int32;
PROCEDURE Hash(str: ARRAY OF CHAR): LONGINT; PROCEDURE Hash(str: ARRAY OF CHAR): Types.Int32;
VAR VAR
index, index,
val: LONGINT; val: Types.Int32;
BEGIN BEGIN
val := 27567352; val := 27567352;
index := 0; index := 0;

52
src/library/ulm/ulmReals.Mod
View file

@ -33,14 +33,14 @@
MODULE ulmReals; MODULE ulmReals;
IMPORT IEEE := ulmIEEE, MC68881 := ulmMC68881; IMPORT IEEE := ulmIEEE, MC68881 := ulmMC68881, Types := ulmTypes;
CONST CONST
(* for REAL *) (* for Types.Real32 *)
maxexp* = 309; maxexp* = 309;
minexp* = -323; minexp* = -323;
maxdignum* = 16; maxdignum* = 16;
(* for LONGREAL *) (* for Types.Real64 *)
(* (*
maxlongexp = 4932; maxlongexp = 4932;
minlongexp = -4951; minlongexp = -4951;
@ -55,30 +55,30 @@ MODULE ulmReals;
TYPE TYPE
PowerRec = PowerRec =
RECORD RECORD
p10: LONGREAL; p10: Types.Real64;
n: INTEGER; n: Types.Int32;
END; END;
VAR VAR
powtab: ARRAY powers OF PowerRec; powtab: ARRAY powers OF PowerRec;
sigdigits: ARRAY maxbase+1 OF INTEGER; (* valid range: [2..maxbase] *) sigdigits: ARRAY maxbase+1 OF Types.Int32; (* valid range: [2..maxbase] *)
PROCEDURE ExpAndMan*(r: LONGREAL; long: BOOLEAN; base: INTEGER; PROCEDURE ExpAndMan*(r: Types.Real64; long: BOOLEAN; base: Types.Int32;
VAR exponent: INTEGER; VAR mantissa: LONGREAL); VAR exponent: Types.Int32; VAR mantissa: Types.Real64);
(* get exponent and mantissa from `r': (* get exponent and mantissa from `r':
(1.0 >= ABS(mantissa)) & (ABS(mantissa) < base) (1.0 >= ABS(mantissa)) & (ABS(mantissa) < base)
r = mantissa * base^exponent r = mantissa * base^exponent
long should be false if a REAL-value is passed to `r' long should be false if a Types.Real32-value is passed to `r'
valid values of base: 2, 8, 10, and 16 valid values of base: 2, 8, 10, and 16
*) *)
VAR VAR
neg: BOOLEAN; neg: BOOLEAN;
index: INTEGER; index: Types.Int32;
roundoff: LONGREAL; roundoff: Types.Real64;
i: INTEGER; i: Types.Int32;
ndigits: INTEGER; ndigits: Types.Int32;
BEGIN BEGIN
IF r = 0.0 THEN IF r = 0.0 THEN
exponent := 0; mantissa := 0; RETURN exponent := 0; mantissa := 0; RETURN
@ -164,10 +164,10 @@ MODULE ulmReals;
END; END;
END ExpAndMan; END ExpAndMan;
PROCEDURE Power*(base: LONGREAL; exp: INTEGER) : LONGREAL; PROCEDURE Power*(base: Types.Real64; exp: Types.Int32) : Types.Real64;
(* efficient calculation of base^exp *) (* efficient calculation of base^exp *)
VAR VAR
r, res: LONGREAL; r, res: Types.Real64;
neg: BOOLEAN; (* negative exponent? *) neg: BOOLEAN; (* negative exponent? *)
BEGIN BEGIN
IF MC68881.available & (base = 10) THEN IF MC68881.available & (base = 10) THEN
@ -197,10 +197,10 @@ MODULE ulmReals;
END; END;
END Power; END Power;
PROCEDURE Digits*(mantissa: LONGREAL; base: INTEGER; PROCEDURE Digits*(mantissa: Types.Real64; base: Types.Int32;
VAR buf: ARRAY OF CHAR; VAR buf: ARRAY OF CHAR;
VAR neg: BOOLEAN; VAR neg: BOOLEAN;
force: BOOLEAN; VAR ndigits: INTEGER); force: BOOLEAN; VAR ndigits: Types.Int32);
(* PRE: (* PRE:
mantissa holds the post-condition of ExpAndMan; mantissa holds the post-condition of ExpAndMan;
valid values for base are 2, 8, 10, and 16 valid values for base are 2, 8, 10, and 16
@ -216,11 +216,11 @@ MODULE ulmReals;
ndigits is unchanged ndigits is unchanged
*) *)
VAR VAR
index: INTEGER; (* of buf *) index: Types.Int32; (* of buf *)
i: INTEGER; roundoff: LONGREAL; i: Types.Int32; roundoff: Types.Real64;
lastnz: INTEGER; (* last index with buf[index] # "0" *) lastnz: Types.Int32; (* last index with buf[index] # "0" *)
ch: CHAR; ch: CHAR;
digit: LONGINT; digit: Types.Int32;
maxdig: CHAR; (* base-1 converted *) maxdig: CHAR; (* base-1 converted *)
BEGIN BEGIN
@ -269,14 +269,14 @@ MODULE ulmReals;
buf[index] := 0X; ndigits := index; buf[index] := 0X; ndigits := index;
END Digits; END Digits;
PROCEDURE Convert*(digits: ARRAY OF CHAR; base: INTEGER; neg: BOOLEAN; PROCEDURE Convert*(digits: ARRAY OF CHAR; base: Types.Int32; neg: BOOLEAN;
VAR mantissa: LONGREAL); VAR mantissa: Types.Real64);
(* convert normalized `digits' (decimal point after 1st digit) (* convert normalized `digits' (decimal point after 1st digit)
into `mantissa' into `mantissa'
*) *)
VAR VAR
index: INTEGER; index: Types.Int32;
factor: LONGREAL; factor: Types.Real64;
BEGIN BEGIN
IF digits = "0" THEN IF digits = "0" THEN
mantissa := 0; mantissa := 0;
@ -304,7 +304,7 @@ BEGIN
powtab[4].p10 := 1.0D2; powtab[4].n := 2; powtab[4].p10 := 1.0D2; powtab[4].n := 2;
powtab[5].p10 := 1.0D1; powtab[5].n := 1; powtab[5].p10 := 1.0D1; powtab[5].n := 1;
(* for LONGREAL *) (* for Types.Real64 *)
sigdigits[2] := 64; sigdigits[3] := 40; sigdigits[4] := 32; sigdigits[2] := 64; sigdigits[3] := 40; sigdigits[4] := 32;
sigdigits[5] := 27; sigdigits[6] := 24; sigdigits[7] := 22; sigdigits[5] := 27; sigdigits[6] := 24; sigdigits[7] := 22;
sigdigits[8] := 21; sigdigits[9] := 20; sigdigits[10] := 19; sigdigits[8] := 21; sigdigits[9] := 20; sigdigits[10] := 19;

20
src/library/ulm/ulmScales.Mod
View file

@ -39,7 +39,7 @@
MODULE ulmScales; MODULE ulmScales;
IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Operations := ulmOperations, PersistentObjects := ulmPersistentObjects, IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Operations := ulmOperations, PersistentObjects := ulmPersistentObjects,
RelatedEvents := ulmRelatedEvents, Services := ulmServices, SYS := SYSTEM; RelatedEvents := ulmRelatedEvents, Services := ulmServices, SYS := SYSTEM, Types := ulmTypes;
TYPE TYPE
Scale* = POINTER TO ScaleRec; Scale* = POINTER TO ScaleRec;
@ -88,25 +88,25 @@ MODULE ulmScales;
RECORD RECORD
(Operations.OperandRec) (Operations.OperandRec)
scale: Scale; scale: Scale;
type: SHORTINT; (* absolute or relative? *) type: Types.Int8; (* absolute or relative? *)
END; END;
VAR VAR
measureType: Services.Type; measureType: Services.Type;
TYPE TYPE
Value* = LONGINT; Value* = Types.Int32;
CONST CONST
add* = Operations.add; sub* = Operations.sub; add* = Operations.add; sub* = Operations.sub;
TYPE TYPE
Operation* = SHORTINT; (* add or sub *) Operation* = Types.Int8; (* add or sub *)
TYPE TYPE
CreateProc* = PROCEDURE (scale: Scale; VAR measure: Measure; abs: BOOLEAN); CreateProc* = PROCEDURE (scale: Scale; VAR measure: Measure; abs: BOOLEAN);
GetValueProc* = PROCEDURE (measure: Measure; unit: Unit; VAR value: Value); GetValueProc* = PROCEDURE (measure: Measure; unit: Unit; VAR value: Value);
SetValueProc* = PROCEDURE (measure: Measure; unit: Unit; value: Value); SetValueProc* = PROCEDURE (measure: Measure; unit: Unit; value: Value);
AssignProc* = PROCEDURE (target: Measure; source: Measure); AssignProc* = PROCEDURE (target: Measure; source: Measure);
OperatorProc* = PROCEDURE (op: Operation; op1, op2, result: Measure); OperatorProc* = PROCEDURE (op: Operation; op1, op2, result: Measure);
CompareProc* = PROCEDURE (op1, op2: Measure) : INTEGER; CompareProc* = PROCEDURE (op1, op2: Measure) : Types.Int32;
ConvertProc* = PROCEDURE (from, to: Measure); ConvertProc* = PROCEDURE (from, to: Measure);
InterfaceRec* = InterfaceRec* =
@ -183,7 +183,7 @@ MODULE ulmScales;
scale.tail := listp; scale.tail := listp;
END InitUnit; END InitUnit;
PROCEDURE CreateMeasure*(scale: Scale; VAR measure: Measure; type: SHORTINT); PROCEDURE CreateMeasure*(scale: Scale; VAR measure: Measure; type: Types.Int8);
BEGIN BEGIN
scale.if.create(scale, measure, type = absolute); scale.if.create(scale, measure, type = absolute);
Operations.Init(measure, opif, opcaps); Operations.Init(measure, opif, opcaps);
@ -295,7 +295,7 @@ MODULE ulmScales;
RETURN measure.type = relative RETURN measure.type = relative
END IsRelative; END IsRelative;
PROCEDURE MeasureType*(measure: Measure) : SHORTINT; PROCEDURE MeasureType*(measure: Measure) : Types.Int8;
BEGIN BEGIN
RETURN measure.type RETURN measure.type
END MeasureType; END MeasureType;
@ -372,10 +372,10 @@ MODULE ulmScales;
PROCEDURE Op(op: Operations.Operation; op1, op2: Operations.Operand; PROCEDURE Op(op: Operations.Operation; op1, op2: Operations.Operand;
VAR result: Operations.Operand); VAR result: Operations.Operand);
VAR VAR
restype: SHORTINT; (* type of result -- set by CheckTypes *) restype: Types.Int8; (* type of result -- set by CheckTypes *)
m1, m2: Measure; m1, m2: Measure;
PROCEDURE CheckTypes(VAR restype: SHORTINT); PROCEDURE CheckTypes(VAR restype: Types.Int8);
(* check operands for correct typing; (* check operands for correct typing;
sets restype to the correct result type; sets restype to the correct result type;
*) *)
@ -419,7 +419,7 @@ MODULE ulmScales;
END; END;
END Op; END Op;
PROCEDURE Compare(op1, op2: Operations.Operand) : INTEGER; PROCEDURE Compare(op1, op2: Operations.Operand) : Types.Int32;
VAR VAR
m1, m2: Measure; m1, m2: Measure;
BEGIN BEGIN

34
src/library/ulm/ulmServices.Mod
View file

@ -31,7 +31,7 @@
MODULE ulmServices; MODULE ulmServices;
IMPORT Disciplines := ulmDisciplines, Objects := ulmObjects; IMPORT Disciplines := ulmDisciplines, Objects := ulmObjects, Types := ulmTypes;
TYPE TYPE
Type* = POINTER TO TypeRec; Type* = POINTER TO TypeRec;
@ -84,9 +84,9 @@ MODULE ulmServices;
bufsize = 512; (* length of a name buffer in bytes *) bufsize = 512; (* length of a name buffer in bytes *)
tabsize = 1171; tabsize = 1171;
TYPE TYPE
BufferPosition = INTEGER; BufferPosition = Types.Int32;
Length = LONGINT; Length = Types.Int32;
HashValue = INTEGER; HashValue = Types.Int32;
Buffer = ARRAY bufsize OF CHAR; Buffer = ARRAY bufsize OF CHAR;
NameList = POINTER TO NameListRec; NameList = POINTER TO NameListRec;
NameListRec = NameListRec =
@ -116,14 +116,14 @@ MODULE ulmServices;
(* ==== name table management ======================================== *) (* ==== name table management ======================================== *)
PROCEDURE Hash(name: ARRAY OF CHAR; length: LONGINT) : HashValue; PROCEDURE Hash(name: ARRAY OF CHAR; length: Types.Int32) : HashValue;
CONST CONST
shift = 4; shift = 4;
VAR VAR
index: LONGINT; index: Types.Int32;
val: LONGINT; val: Types.Int32;
ch: CHAR; ch: CHAR;
ordval: INTEGER; ordval: Types.Int32;
BEGIN BEGIN
index := 0; val := length; index := 0; val := length;
WHILE index < length DO WHILE index < length DO
@ -150,9 +150,9 @@ MODULE ulmServices;
currentPos := 0; currentPos := 0;
END CreateBuf; END CreateBuf;
PROCEDURE StringLength(string: ARRAY OF CHAR) : LONGINT; PROCEDURE StringLength(string: ARRAY OF CHAR) : Types.Int32;
VAR VAR
index: LONGINT; index: Types.Int32;
BEGIN BEGIN
index := 0; index := 0;
WHILE (index < LEN(string)) & (string[index] # 0X) DO WHILE (index < LEN(string)) & (string[index] # 0X) DO
@ -163,7 +163,7 @@ MODULE ulmServices;
PROCEDURE InitName(name: Type; string: ARRAY OF CHAR); PROCEDURE InitName(name: Type; string: ARRAY OF CHAR);
VAR VAR
index, length: LONGINT; index, length: Types.Int32;
firstbuf, buf: NameList; firstbuf, buf: NameList;
startpos: BufferPosition; startpos: BufferPosition;
BEGIN BEGIN
@ -195,9 +195,9 @@ MODULE ulmServices;
PROCEDURE EqualName(name: Type; string: ARRAY OF CHAR) : BOOLEAN; PROCEDURE EqualName(name: Type; string: ARRAY OF CHAR) : BOOLEAN;
(* precondition: both have the same length *) (* precondition: both have the same length *)
VAR VAR
index: LONGINT; index: Types.Int32;
buf: NameList; buf: NameList;
pos: INTEGER; pos: Types.Int32;
BEGIN BEGIN
buf := name.begin; pos := name.pos; buf := name.begin; pos := name.pos;
index := 0; index := 0;
@ -216,7 +216,7 @@ MODULE ulmServices;
PROCEDURE SeekName(string: ARRAY OF CHAR; VAR name: Type) : BOOLEAN; PROCEDURE SeekName(string: ARRAY OF CHAR; VAR name: Type) : BOOLEAN;
VAR VAR
length: LONGINT; length: Types.Int32;
hashval: HashValue; hashval: HashValue;
p: Type; p: Type;
BEGIN BEGIN
@ -232,9 +232,9 @@ MODULE ulmServices;
PROCEDURE ExtractName(name: Type; VAR string: ARRAY OF CHAR); PROCEDURE ExtractName(name: Type; VAR string: ARRAY OF CHAR);
VAR VAR
index: LONGINT; index: Types.Int32;
buf: NameList; buf: NameList;
pos: INTEGER; pos: Types.Int32;
BEGIN BEGIN
buf := name.begin; pos := name.pos; buf := name.begin; pos := name.pos;
index := 0; index := 0;
@ -331,7 +331,7 @@ MODULE ulmServices;
PROCEDURE GetModule(name: ARRAY OF CHAR; VAR module: ARRAY OF CHAR); PROCEDURE GetModule(name: ARRAY OF CHAR; VAR module: ARRAY OF CHAR);
(* get the name of the module where 'name' was defined *) (* get the name of the module where 'name' was defined *)
VAR VAR
index: INTEGER; index: Types.Int32;
BEGIN BEGIN
index := 0; index := 0;
WHILE (name[index] # ".") & (name[index] # 0X) & WHILE (name[index] # ".") & (name[index] # 0X) &

53
src/library/ulm/ulmSets.Mod
View file

@ -35,15 +35,16 @@
*) *)
MODULE ulmSets; MODULE ulmSets;
IMPORT Types := ulmTypes;
CONST CONST
setsize* = MAX(SET) + 1; setsize* = MAX(Types.Set) + 1;
TYPE TYPE
CharSet* = ARRAY (ORD(MAX(CHAR)) + 1) DIV setsize OF SET; CharSet* = ARRAY (ORD(MAX(CHAR)) + 1) DIV setsize OF Types.Set;
PROCEDURE InitSet*(VAR set: ARRAY OF SET); PROCEDURE InitSet*(VAR set: ARRAY OF Types.Set);
VAR i: LONGINT; VAR i: Types.Int32;
BEGIN BEGIN
i := 0; i := 0;
WHILE i < LEN(set) DO WHILE i < LEN(set) DO
@ -51,8 +52,8 @@ MODULE ulmSets;
END; END;
END InitSet; END InitSet;
PROCEDURE Complement*(VAR set: ARRAY OF SET); PROCEDURE Complement*(VAR set: ARRAY OF Types.Set);
VAR i: LONGINT; VAR i: Types.Int32;
BEGIN BEGIN
i := 0; i := 0;
WHILE i < LEN(set) DO WHILE i < LEN(set) DO
@ -60,17 +61,17 @@ MODULE ulmSets;
END; END;
END Complement; END Complement;
PROCEDURE In*(VAR set: ARRAY OF SET; i: LONGINT) : BOOLEAN; PROCEDURE In*(VAR set: ARRAY OF Types.Set; i: Types.Int32) : BOOLEAN;
BEGIN BEGIN
RETURN (i MOD setsize) IN set[i DIV setsize] RETURN (i MOD setsize) IN set[i DIV setsize]
END In; END In;
PROCEDURE Incl*(VAR set: ARRAY OF SET; i: LONGINT); PROCEDURE Incl*(VAR set: ARRAY OF Types.Set; i: Types.Int32);
BEGIN BEGIN
INCL(set[i DIV setsize], i MOD setsize); INCL(set[i DIV setsize], i MOD setsize);
END Incl; END Incl;
PROCEDURE Excl*(VAR set: ARRAY OF SET; i: LONGINT); PROCEDURE Excl*(VAR set: ARRAY OF Types.Set; i: Types.Int32);
BEGIN BEGIN
EXCL(set[i DIV setsize], i MOD setsize); EXCL(set[i DIV setsize], i MOD setsize);
END Excl; END Excl;
@ -90,9 +91,9 @@ MODULE ulmSets;
EXCL(charset[ORD(ch) DIV setsize], ORD(ch) MOD setsize); EXCL(charset[ORD(ch) DIV setsize], ORD(ch) MOD setsize);
END ExclChar; END ExclChar;
PROCEDURE Intersection*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET); PROCEDURE Intersection*(set1, set2: ARRAY OF Types.Set; VAR result: ARRAY OF Types.Set);
VAR VAR
index: INTEGER; index: Types.Int32;
BEGIN BEGIN
ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2))); ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2)));
index := 0; index := 0;
@ -102,9 +103,9 @@ MODULE ulmSets;
END; END;
END Intersection; END Intersection;
PROCEDURE SymDifference*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET); PROCEDURE SymDifference*(set1, set2: ARRAY OF Types.Set; VAR result: ARRAY OF Types.Set);
VAR VAR
index: INTEGER; index: Types.Int32;
BEGIN BEGIN
ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2))); ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2)));
index := 0; index := 0;
@ -114,9 +115,9 @@ MODULE ulmSets;
END; END;
END SymDifference; END SymDifference;
PROCEDURE Union*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET); PROCEDURE Union*(set1, set2: ARRAY OF Types.Set; VAR result: ARRAY OF Types.Set);
VAR VAR
index: INTEGER; index: Types.Int32;
BEGIN BEGIN
ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2))); ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2)));
index := 0; index := 0;
@ -126,9 +127,9 @@ MODULE ulmSets;
END; END;
END Union; END Union;
PROCEDURE Difference*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET); PROCEDURE Difference*(set1, set2: ARRAY OF Types.Set; VAR result: ARRAY OF Types.Set);
VAR VAR
index: INTEGER; index: Types.Int32;
BEGIN BEGIN
ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2))); ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2)));
index := 0; index := 0;
@ -138,9 +139,9 @@ MODULE ulmSets;
END; END;
END Difference; END Difference;
PROCEDURE Equal*(set1, set2: ARRAY OF SET) : BOOLEAN; PROCEDURE Equal*(set1, set2: ARRAY OF Types.Set) : BOOLEAN;
VAR VAR
index: INTEGER; index: Types.Int32;
BEGIN BEGIN
index := 0; index := 0;
WHILE (index < LEN(set1)) & (index < LEN(set2)) DO WHILE (index < LEN(set1)) & (index < LEN(set2)) DO
@ -164,9 +165,9 @@ MODULE ulmSets;
RETURN TRUE RETURN TRUE
END Equal; END Equal;
PROCEDURE Subset*(set1, set2: ARRAY OF SET) : BOOLEAN; PROCEDURE Subset*(set1, set2: ARRAY OF Types.Set) : BOOLEAN;
VAR VAR
index: INTEGER; index: Types.Int32;
BEGIN BEGIN
index := 0; index := 0;
WHILE (index < LEN(set1)) & (index < LEN(set2)) DO WHILE (index < LEN(set1)) & (index < LEN(set2)) DO
@ -184,17 +185,17 @@ MODULE ulmSets;
RETURN TRUE RETURN TRUE
END Subset; END Subset;
PROCEDURE Card*(set: ARRAY OF SET) : INTEGER; PROCEDURE Card*(set: ARRAY OF Types.Set) : Types.Int32;
VAR VAR
index: INTEGER; index: Types.Int32;
i: INTEGER; i: Types.Int32;
card: INTEGER; card: Types.Int32;
BEGIN BEGIN
card := 0; card := 0;
index := 0; index := 0;
WHILE index < LEN(set) DO WHILE index < LEN(set) DO
i := 0; i := 0;
WHILE i <= MAX(SET) DO WHILE i <= MAX(Types.Set) DO
IF i IN set[index] THEN IF i IN set[index] THEN
INC(card); INC(card);
END; END;

12
src/library/ulm/ulmStreamDisciplines.Mod
View file

@ -35,7 +35,7 @@ MODULE ulmStreamDisciplines;
(* definition of general-purpose disciplines for streams *) (* definition of general-purpose disciplines for streams *)
IMPORT ASCII := ulmASCII, Disciplines := ulmIndirectDisciplines, Events := ulmEvents, Sets := ulmSets, Streams := ulmStreams, SYSTEM; IMPORT ASCII := ulmASCII, Disciplines := ulmIndirectDisciplines, Events := ulmEvents, Sets := ulmSets, Streams := ulmStreams, SYSTEM, Types := ulmTypes;
TYPE TYPE
LineTerminator* = ARRAY 4 OF CHAR; LineTerminator* = ARRAY 4 OF CHAR;
@ -51,7 +51,7 @@ MODULE ulmStreamDisciplines;
fieldseps: Sets.CharSet; fieldseps: Sets.CharSet;
fieldsep: CHAR; (* one of them *) fieldsep: CHAR; (* one of them *)
whitespace: Sets.CharSet; whitespace: Sets.CharSet;
indentwidth: INTEGER; indentwidth: Types.Int32;
END; END;
VAR VAR
@ -61,7 +61,7 @@ MODULE ulmStreamDisciplines;
defaultFieldSep: CHAR; defaultFieldSep: CHAR;
defaultLineTerm: LineTerminator; defaultLineTerm: LineTerminator;
defaultWhiteSpace: Sets.CharSet; defaultWhiteSpace: Sets.CharSet;
defaultIndentWidth: INTEGER; defaultIndentWidth: Types.Int32;
PROCEDURE InitDiscipline(VAR disc: Disciplines.Discipline); PROCEDURE InitDiscipline(VAR disc: Disciplines.Discipline);
VAR VAR
@ -194,7 +194,7 @@ MODULE ulmStreamDisciplines;
Disciplines.Add(s, disc); Disciplines.Add(s, disc);
END SetWhiteSpace; END SetWhiteSpace;
PROCEDURE SetIndentationWidth*(s: Streams.Stream; indentwidth: INTEGER); PROCEDURE SetIndentationWidth*(s: Streams.Stream; indentwidth: Types.Int32);
VAR VAR
disc: Disciplines.Discipline; disc: Disciplines.Discipline;
BEGIN BEGIN
@ -207,7 +207,7 @@ MODULE ulmStreamDisciplines;
END; END;
END SetIndentationWidth; END SetIndentationWidth;
PROCEDURE GetIndentationWidth*(s: Streams.Stream; VAR indentwidth: INTEGER); PROCEDURE GetIndentationWidth*(s: Streams.Stream; VAR indentwidth: Types.Int32);
VAR VAR
disc: Disciplines.Discipline; disc: Disciplines.Discipline;
BEGIN BEGIN
@ -218,7 +218,7 @@ MODULE ulmStreamDisciplines;
END; END;
END GetIndentationWidth; END GetIndentationWidth;
PROCEDURE IncrIndentationWidth*(s: Streams.Stream; incr: INTEGER); PROCEDURE IncrIndentationWidth*(s: Streams.Stream; incr: Types.Int32);
VAR VAR
disc: Disciplines.Discipline; disc: Disciplines.Discipline;
BEGIN BEGIN

28
src/library/ulm/ulmStreams.Mod
View file

@ -144,10 +144,10 @@ MODULE ulmStreams;
Address* = Types.Address; Address* = Types.Address;
Count* = Types.Count; Count* = Types.Count;
Byte* = Types.Byte; Byte* = Types.Byte;
Whence* = SHORTINT; (* Whence = (fromStart, fromPos, fromEnd); *) Whence* = Types.Int8; (* Whence = (fromStart, fromPos, fromEnd); *)
CapabilitySet* = SET; (* OF Capability; *) CapabilitySet* = Types.Set; (* OF Capability; *)
BufMode* = SHORTINT; BufMode* = Types.Int8;
ErrorCode* = SHORTINT; ErrorCode* = Types.Int8;
Stream* = POINTER TO StreamRec; Stream* = POINTER TO StreamRec;
Message* = RECORD (Objects.ObjectRec) END; Message* = RECORD (Objects.ObjectRec) END;
@ -185,8 +185,8 @@ MODULE ulmStreams;
BufferPool = POINTER TO BufferPoolRec; BufferPool = POINTER TO BufferPoolRec;
BufferPoolRec = BufferPoolRec =
RECORD RECORD
maxbuf: INTEGER; (* maximal number of buffers to be used *) maxbuf: Types.Int32; (* maximal number of buffers to be used *)
nbuf: INTEGER; (* number of buffers in use *) nbuf: Types.Int32; (* number of buffers in use *)
bucket: BucketTable; bucket: BucketTable;
(* list of all buffers sorted after the last access time; (* list of all buffers sorted after the last access time;
tail points to the buffer most recently accessed tail points to the buffer most recently accessed
@ -230,7 +230,7 @@ MODULE ulmStreams;
(Services.ObjectRec) (Services.ObjectRec)
(* following components are set after i/o-operations *) (* following components are set after i/o-operations *)
count*: Count; (* resulting count of last operation *) count*: Count; (* resulting count of last operation *)
errors*: INTEGER; (* incremented for each error; may be set to 0 *) errors*: Types.Int32; (* incremented for each error; may be set to 0 *)
error*: BOOLEAN; (* last operation successful? *) error*: BOOLEAN; (* last operation successful? *)
lasterror*: ErrorCode; (* error code of last error *) lasterror*: ErrorCode; (* error code of last error *)
eof*: BOOLEAN; (* last read-operation with count=0 returned *) eof*: BOOLEAN; (* last read-operation with count=0 returned *)
@ -367,7 +367,7 @@ MODULE ulmStreams;
PROCEDURE InitBufPool(s: Stream); PROCEDURE InitBufPool(s: Stream);
VAR VAR
index: INTEGER; index: Types.Int32;
BEGIN BEGIN
s.bufpool.maxbuf := 16; (* default size *) s.bufpool.maxbuf := 16; (* default size *)
s.bufpool.nbuf := 0; (* currently, no buffers are allocated *) s.bufpool.nbuf := 0; (* currently, no buffers are allocated *)
@ -379,7 +379,7 @@ MODULE ulmStreams;
END; END;
END InitBufPool; END InitBufPool;
PROCEDURE HashValue(pos: Count) : INTEGER; PROCEDURE HashValue(pos: Count) : Types.Int32;
(* HashValue returns a hash value for pos *) (* HashValue returns a hash value for pos *)
BEGIN BEGIN
RETURN SHORT(pos DIV bufsize) MOD hashtabsize RETURN SHORT(pos DIV bufsize) MOD hashtabsize
@ -387,7 +387,7 @@ MODULE ulmStreams;
PROCEDURE FindBuffer(s: Stream; pos: Count; VAR buf: Buffer) : BOOLEAN; PROCEDURE FindBuffer(s: Stream; pos: Count; VAR buf: Buffer) : BOOLEAN;
VAR VAR
index: INTEGER; index: Types.Int32;
bp: Buffer; bp: Buffer;
BEGIN BEGIN
index := HashValue(pos); index := HashValue(pos);
@ -410,11 +410,11 @@ MODULE ulmStreams;
buf: Buffer; buf: Buffer;
pos: Count; (* buffer boundary for s.pos *) pos: Count; (* buffer boundary for s.pos *)
posindex: Count; (* buf[posindex] corresponds to s.pos *) posindex: Count; (* buf[posindex] corresponds to s.pos *)
index: INTEGER; (* index into bucket table of the buffer pool *) index: Types.Int32; (* index into bucket table of the buffer pool *)
PROCEDURE InitBuf(buf: Buffer); PROCEDURE InitBuf(buf: Buffer);
VAR VAR
index: INTEGER; (* of bucket table *) index: Types.Int32; (* of bucket table *)
BEGIN BEGIN
buf.ok := TRUE; buf.ok := TRUE;
buf.pos := pos; buf.pos := pos;
@ -612,7 +612,7 @@ MODULE ulmStreams;
in.tiedStream := out; in.tiedStream := out;
END Tie; END Tie;
PROCEDURE SetBufferPoolSize*(s: Stream; nbuf: INTEGER); PROCEDURE SetBufferPoolSize*(s: Stream; nbuf: Types.Int32);
BEGIN BEGIN
s.error := FALSE; s.error := FALSE;
IF SYS.TAS(s.lock) THEN IF SYS.TAS(s.lock) THEN
@ -624,7 +624,7 @@ MODULE ulmStreams;
s.lock := FALSE; s.lock := FALSE;
END SetBufferPoolSize; END SetBufferPoolSize;
PROCEDURE GetBufferPoolSize*(s: Stream; VAR nbuf: INTEGER); PROCEDURE GetBufferPoolSize*(s: Stream; VAR nbuf: Types.Int32);
BEGIN BEGIN
s.error := FALSE; s.error := FALSE;
CASE s.bufmode OF CASE s.bufmode OF

26
src/library/ulm/ulmStrings.Mod
View file

@ -64,7 +64,7 @@ MODULE ulmStrings;
posOutside* = 3; (* trunc failure: position beyond trunc pos *) posOutside* = 3; (* trunc failure: position beyond trunc pos *)
errorcodes* = 4; errorcodes* = 4;
TYPE TYPE
ErrorCode* = SHORTINT; ErrorCode* = Types.Int8;
Event* = POINTER TO EventRec; Event* = POINTER TO EventRec;
EventRec* = EventRec* =
RECORD RECORD
@ -91,13 +91,13 @@ MODULE ulmStrings;
(* ======= string to stream operations =========================== *) (* ======= string to stream operations =========================== *)
PROCEDURE WritePart*(stream: Streams.Stream; string: ARRAY OF CHAR; PROCEDURE WritePart*(stream: Streams.Stream; string: ARRAY OF CHAR;
sourceIndex: LONGINT); sourceIndex: Types.Int32);
(* seek to position 0 of `stream' and (* seek to position 0 of `stream' and
copy string[sourceIndex..] to it; copy string[sourceIndex..] to it;
the file pointer of `stream' is left on position 0 the file pointer of `stream' is left on position 0
*) *)
VAR VAR
index: LONGINT; index: Types.Int32;
BEGIN BEGIN
IF ~Streams.Seek(stream, 0, Streams.fromStart) OR IF ~Streams.Seek(stream, 0, Streams.fromStart) OR
~Streams.Trunc(stream, 0) THEN ~Streams.Trunc(stream, 0) THEN
@ -122,12 +122,12 @@ MODULE ulmStrings;
(* ======= stream to string operations =========================== *) (* ======= stream to string operations =========================== *)
PROCEDURE ReadPart*(VAR string: ARRAY OF CHAR; destIndex: LONGINT; PROCEDURE ReadPart*(VAR string: ARRAY OF CHAR; destIndex: Types.Int32;
stream: Streams.Stream); stream: Streams.Stream);
(* like `Read' but fill string[destIndex..] *) (* like `Read' but fill string[destIndex..] *)
VAR VAR
len: LONGINT; len: Types.Int32;
endIndex: LONGINT; endIndex: Types.Int32;
BEGIN BEGIN
len := LEN(string); len := LEN(string);
IF Streams.Seek(stream, 0, Streams.fromStart) & (destIndex < len) THEN IF Streams.Seek(stream, 0, Streams.fromStart) & (destIndex < len) THEN
@ -160,8 +160,8 @@ MODULE ulmStrings;
PROCEDURE Copy*(VAR destination: ARRAY OF CHAR; PROCEDURE Copy*(VAR destination: ARRAY OF CHAR;
source: ARRAY OF CHAR); source: ARRAY OF CHAR);
VAR VAR
index: LONGINT; index: Types.Int32;
minlen: LONGINT; minlen: Types.Int32;
BEGIN BEGIN
minlen := LEN(destination); minlen := LEN(destination);
IF minlen > LEN(source) THEN IF minlen > LEN(source) THEN
@ -180,8 +180,8 @@ MODULE ulmStrings;
destination[index] := 0X; destination[index] := 0X;
END Copy; END Copy;
PROCEDURE PartCopy*(VAR destination: ARRAY OF CHAR; destIndex: LONGINT; PROCEDURE PartCopy*(VAR destination: ARRAY OF CHAR; destIndex: Types.Int32;
source: ARRAY OF CHAR; sourceIndex: LONGINT); source: ARRAY OF CHAR; sourceIndex: Types.Int32);
(* copy source[sourceIndex..] to destination[destIndex..] *) (* copy source[sourceIndex..] to destination[destIndex..] *)
BEGIN BEGIN
WHILE (destIndex+1 < LEN(destination)) & WHILE (destIndex+1 < LEN(destination)) &
@ -195,10 +195,10 @@ MODULE ulmStrings;
END; END;
END PartCopy; END PartCopy;
PROCEDURE Len*(string: ARRAY OF CHAR) : LONGINT; PROCEDURE Len*(string: ARRAY OF CHAR) : Types.Int32;
(* returns the number of characters (without terminating 0X) *) (* returns the number of characters (without terminating 0X) *)
VAR VAR
len: LONGINT; len: Types.Int32;
BEGIN BEGIN
len := 0; len := 0;
WHILE (len < LEN(string)) & (string[len] # 0X) DO WHILE (len < LEN(string)) & (string[len] # 0X) DO
@ -316,7 +316,7 @@ MODULE ulmStrings;
PROCEDURE Flush(s: Streams.Stream) : BOOLEAN; PROCEDURE Flush(s: Streams.Stream) : BOOLEAN;
VAR VAR
len: LONGINT; len: Types.Int32;
ch: CHAR; ch: CHAR;
BEGIN BEGIN
WITH s: Stream DO WITH s: Stream DO

74
src/library/ulm/ulmSysConversions.Mod
View file

@ -38,7 +38,7 @@ MODULE ulmSysConversions;
(* convert Oberon records to/from C structures *) (* convert Oberon records to/from C structures *)
IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Streams := ulmStreams, Strings := ulmStrings, IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Streams := ulmStreams, Strings := ulmStrings,
SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts; SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts, Types := ulmTypes;
TYPE TYPE
Address* = SysTypes.Address; Address* = SysTypes.Address;
@ -66,10 +66,10 @@ MODULE ulmSysConversions;
b: SYS.BYTE b: SYS.BYTE
B: BOOLEAN B: BOOLEAN
c: CHAR c: CHAR
s: SHORTINT s: Types.Int8
i: INTEGER i: Types.Int32
l: LONGINT l: Types.Int32
S: SET S: Types.Set
C data types: C data types:
@ -90,10 +90,10 @@ MODULE ulmSysConversions;
Rec = Rec =
RECORD RECORD
a, b: INTEGER; a, b: Types.Int32;
c: CHAR; c: CHAR;
s: SET; s: Types.Set;
f: ARRAY 3 OF INTEGER; f: ARRAY 3 OF Types.Int32;
END; END;
to to
@ -118,7 +118,7 @@ MODULE ulmSysConversions;
unsigned = 0; (* suppress sign extension *) unsigned = 0; (* suppress sign extension *)
boolean = 1; (* convert anything # 0 to 1 *) boolean = 1; (* convert anything # 0 to 1 *)
TYPE TYPE
Flags = SET; Flags = Types.Set;
Event* = POINTER TO EventRec; Event* = POINTER TO EventRec;
EventRec* = EventRec* =
RECORD RECORD
@ -134,9 +134,9 @@ MODULE ulmSysConversions;
(* 1: Oberon type (* 1: Oberon type
2: C type 2: C type
*) *)
type1, type2: CHAR; length: INTEGER; left: INTEGER; type1, type2: CHAR; length: Types.Int32; left: Types.Int32;
offset1, offset2: Address; offset1, offset2: Address;
size1, size2: Address; elementsleft: INTEGER; flags: Flags; size1, size2: Address; elementsleft: Types.Int32; flags: Flags;
END; END;
Format* = POINTER TO FormatRec; Format* = POINTER TO FormatRec;
@ -192,7 +192,7 @@ MODULE ulmSysConversions;
RETURN (ch >= "0") & (ch <= "9") RETURN (ch >= "0") & (ch <= "9")
END IsDigit; END IsDigit;
PROCEDURE ReadInt(cv: ConvStream; VAR i: INTEGER); PROCEDURE ReadInt(cv: ConvStream; VAR i: Types.Int32);
BEGIN BEGIN
i := 0; i := 0;
REPEAT REPEAT
@ -219,10 +219,10 @@ MODULE ulmSysConversions;
PROCEDURE ScanConv(cv: ConvStream; PROCEDURE ScanConv(cv: ConvStream;
VAR type1, type2: CHAR; VAR type1, type2: CHAR;
VAR length: INTEGER) : BOOLEAN; VAR length: Types.Int32) : BOOLEAN;
VAR VAR
i: INTEGER; i: Types.Int32;
factor: INTEGER; factor: Types.Int32;
BEGIN BEGIN
IF cv.left > 0 THEN IF cv.left > 0 THEN
type1 := cv.type1; type1 := cv.type1;
@ -274,8 +274,8 @@ MODULE ulmSysConversions;
PROCEDURE Align(VAR offset: Address; boundary: Address); PROCEDURE Align(VAR offset: Address; boundary: Address);
BEGIN BEGIN
IF SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary) # 0 THEN IF SYS.VAL (Types.Int32, offset) MOD SYS.VAL (Types.Int32, boundary) # 0 THEN
offset := SYS.VAL (INTEGER, offset) + (SYS.VAL (INTEGER, boundary) - SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary)); offset := SYS.VAL (Types.Int32, offset) + (SYS.VAL (Types.Int32, boundary) - SYS.VAL (Types.Int32, offset) MOD SYS.VAL (Types.Int32, boundary));
END; END;
END Align; END Align;
@ -285,28 +285,28 @@ MODULE ulmSysConversions;
VAR flags: Flags) : BOOLEAN; VAR flags: Flags) : BOOLEAN;
VAR VAR
type1, type2: CHAR; type1, type2: CHAR;
length: INTEGER; length: Types.Int32;
align: BOOLEAN; align: BOOLEAN;
boundary: INTEGER; boundary: Types.Int32;
BEGIN BEGIN
IF cv.elementsleft > 0 THEN IF cv.elementsleft > 0 THEN
DEC(cv.elementsleft); DEC(cv.elementsleft);
(* Oberon type *) (* Oberon type *)
IF size1 > SIZE(SYS.BYTE) THEN IF size1 > SIZE(SYS.BYTE) THEN
Align(cv.offset1, SIZE(INTEGER)); Align(cv.offset1, SIZE(Types.Int32));
END; END;
offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; offset1 := cv.offset1; cv.offset1 := SYS.VAL (Types.Int32, cv.offset1) + size1;
size1 := cv.size1; size2 := cv.size2; flags := cv.flags; size1 := cv.size1; size2 := cv.size2; flags := cv.flags;
IF (size1 > 0) & (cv.elementsleft = 0) THEN IF (size1 > 0) & (cv.elementsleft = 0) THEN
Align(cv.offset1, SIZE(INTEGER)); Align(cv.offset1, SIZE(Types.Int32));
END; END;
(* C type *) (* C type *)
IF size2 > 1 THEN IF size2 > 1 THEN
Align(cv.offset2, 2); Align(cv.offset2, 2);
END; END;
offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); offset2 := cv.offset2; cv.offset2 := SYS.VAL (Types.Int32, cv.offset2) + SYS.VAL (Types.Int32, size2);
RETURN TRUE RETURN TRUE
END; END;
@ -318,21 +318,21 @@ MODULE ulmSysConversions;
| "b": size1 := SIZE(SYS.BYTE); INCL(flags, unsigned); | "b": size1 := SIZE(SYS.BYTE); INCL(flags, unsigned);
| "B": size1 := SIZE(BOOLEAN); INCL(flags, boolean); | "B": size1 := SIZE(BOOLEAN); INCL(flags, boolean);
| "c": size1 := SIZE(CHAR); INCL(flags, unsigned); | "c": size1 := SIZE(CHAR); INCL(flags, unsigned);
| "s": size1 := SIZE(SHORTINT); | "s": size1 := SIZE(Types.Int8);
| "i": size1 := SIZE(INTEGER); | "i": size1 := SIZE(Types.Int32);
| "l": size1 := SIZE(LONGINT); | "l": size1 := SIZE(Types.Int32);
| "S": size1 := SIZE(SET); INCL(flags, unsigned); | "S": size1 := SIZE(Types.Set); INCL(flags, unsigned);
| "-": size1 := 0; | "-": size1 := 0;
ELSE Error(cv, "bad Oberon type specifier"); RETURN FALSE ELSE Error(cv, "bad Oberon type specifier"); RETURN FALSE
END; END;
IF size1 > 0 THEN IF size1 > 0 THEN
IF length > 0 THEN IF length > 0 THEN
Align(cv.offset1, SIZE(INTEGER)); Align(cv.offset1, SIZE(Types.Int32));
ELSIF size1 > SIZE(SYS.BYTE) THEN ELSIF size1 > SIZE(SYS.BYTE) THEN
Align(cv.offset1, SIZE(INTEGER)); Align(cv.offset1, SIZE(Types.Int32));
END; END;
END; END;
offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; offset1 := cv.offset1; cv.offset1 := SYS.VAL (Types.Int32, cv.offset1) + size1;
(* C type *) (* C type *)
CASE type2 OF CASE type2 OF
@ -352,7 +352,7 @@ MODULE ulmSysConversions;
IF size2 > 1 THEN IF size2 > 1 THEN
Align(cv.offset2, size2); Align(cv.offset2, size2);
END; END;
offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); offset2 := cv.offset2; cv.offset2 := SYS.VAL (Types.Int32, cv.offset2) + SYS.VAL (Types.Int32, size2);
cv.size1 := size1; cv.size2 := size2; cv.size1 := size1; cv.size2 := size2;
IF length > 0 THEN IF length > 0 THEN
@ -371,7 +371,7 @@ MODULE ulmSysConversions;
Pointer = POINTER TO Bytes; Pointer = POINTER TO Bytes;
VAR VAR
dest, source: Pointer; dest, source: Pointer;
dindex, sindex: INTEGER; dindex, sindex: Types.Int32;
nonzero: BOOLEAN; nonzero: BOOLEAN;
fill : CHAR; fill : CHAR;
BEGIN BEGIN
@ -383,7 +383,7 @@ MODULE ulmSysConversions;
nonzero := FALSE; nonzero := FALSE;
WHILE ssize > 0 DO WHILE ssize > 0 DO
nonzero := nonzero OR (source[sindex] # 0X); nonzero := nonzero OR (source[sindex] # 0X);
INC(sindex); ssize := SYS.VAL (INTEGER, ssize) - 1; INC(sindex); ssize := SYS.VAL (Types.Int32, ssize) - 1;
END; END;
IF dsize > 0 THEN IF dsize > 0 THEN
IF nonzero THEN IF nonzero THEN
@ -395,12 +395,12 @@ MODULE ulmSysConversions;
END; END;
WHILE dsize > 0 DO WHILE dsize > 0 DO
dest[dindex] := 0X; dest[dindex] := 0X;
dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); dsize := SYS.VAL (Types.Int32, dsize) - 1; INC(dindex);
END; END;
ELSE ELSE
WHILE (dsize > 0) & (ssize > 0) DO WHILE (dsize > 0) & (ssize > 0) DO
dest[dindex] := source[sindex]; dest[dindex] := source[sindex];
ssize := SYS.VAL (INTEGER, ssize) - 1; ssize := SYS.VAL (Types.Int32, ssize) - 1;
dsize := dsize - 1; dsize := dsize - 1;
INC(dindex); INC(sindex); INC(dindex); INC(sindex);
END; END;
@ -415,7 +415,7 @@ MODULE ulmSysConversions;
END; END;
WHILE dsize > 0 DO WHILE dsize > 0 DO
dest[dindex] := fill; dest[dindex] := fill;
dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); dsize := SYS.VAL (Types.Int32, dsize) - 1; INC(dindex);
END; END;
END; END;
END; END;
@ -475,7 +475,7 @@ MODULE ulmSysConversions;
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END; WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END;
Close(cv); Close(cv);
size := offset1 + size1; size := offset1 + size1;
Align(size, SIZE(INTEGER)); Align(size, SIZE(Types.Int32));
RETURN size RETURN size
END OberonSize; END OberonSize;

18
src/library/ulm/ulmSysErrors.Mod
View file

@ -1,6 +1,6 @@
MODULE ulmSysErrors; MODULE ulmSysErrors;
IMPORT Errors := ulmErrors, Events := ulmEvents, Priorities := ulmPriorities, RelatedEvents := ulmRelatedEvents, Streams := ulmStreams, Strings := ulmStrings, Sys := ulmSys; IMPORT Errors := ulmErrors, Events := ulmEvents, Priorities := ulmPriorities, RelatedEvents := ulmRelatedEvents, Streams := ulmStreams, Strings := ulmStrings, Sys := ulmSys, Types := ulmTypes;
CONST CONST
perm* = 1; perm* = 1;
@ -138,8 +138,8 @@ MODULE ulmSysErrors;
EventRec* = EventRec* =
RECORD RECORD
(Events.EventRec) (Events.EventRec)
errno*: (*INTEGER*)LONGINT; errno*: (*Types.Int32*)Types.Int32;
syscall*: (*INTEGER*)LONGINT; (* number of system call *) syscall*: (*Types.Int32*)Types.Int32; (* number of system call *)
text*: ARRAY textlen OF CHAR; text*: ARRAY textlen OF CHAR;
END; END;
@ -150,7 +150,7 @@ MODULE ulmSysErrors;
syserror*: ARRAY ncodes OF Events.EventType; syserror*: ARRAY ncodes OF Events.EventType;
PROCEDURE Raise*(errors: RelatedEvents.Object; PROCEDURE Raise*(errors: RelatedEvents.Object;
errno, syscall: (*INTEGER*)LONGINT; text: ARRAY OF CHAR); (* in ulm's system INTEGER and LONGINT have the same size *) errno, syscall: (*Types.Int32*)Types.Int32; text: ARRAY OF CHAR); (* in ulm's system Types.Int32 and Types.Int32 have the same size *)
(* raises the events syserrors and syserrors[syscall]; (* raises the events syserrors and syserrors[syscall];
`text' contains additional information (e.g. filenames); `text' contains additional information (e.g. filenames);
further, the syserrors[syscall] event is passed to further, the syserrors[syscall] event is passed to
@ -192,9 +192,9 @@ MODULE ulmSysErrors;
IF ~Streams.WriteByte(s, ch) THEN END; IF ~Streams.WriteByte(s, ch) THEN END;
END Write; END Write;
PROCEDURE WriteInt(intval: LONGINT); PROCEDURE WriteInt(intval: Types.Int32);
VAR VAR
rest: LONGINT; rest: Types.Int32;
BEGIN BEGIN
rest := intval DIV 10; rest := intval DIV 10;
IF rest > 0 THEN IF rest > 0 THEN
@ -231,7 +231,7 @@ MODULE ulmSysErrors;
PROCEDURE InitEvents; PROCEDURE InitEvents;
VAR VAR
errno: INTEGER; errno: Types.Int32;
BEGIN BEGIN
syserror[0] := NIL; syserror[0] := NIL;
errno := 1; errno := 1;
@ -447,11 +447,11 @@ BEGIN
message[netdown] := "Network is down"; message[netdown] := "Network is down";
name[netunreach] := "ENETUNREACH"; name[netunreach] := "ENETUNREACH";
message[netunreach] := "Network is unreachable"; message[netunreach] := "Network is unreachable";
name[netreset] := "ENETRESET"; name[netreset] := "ENETRETypes.Set";
message[netreset] := "Network dropped connection because of reset"; message[netreset] := "Network dropped connection because of reset";
name[connaborted] := "ECONNABORTED"; name[connaborted] := "ECONNABORTED";
message[connaborted] := "Software caused connection abort"; message[connaborted] := "Software caused connection abort";
name[connreset] := "ECONNRESET"; name[connreset] := "ECONNRETypes.Set";
message[connreset] := "Connection reset by peer"; message[connreset] := "Connection reset by peer";
name[nobufs] := "ENOBUFS"; name[nobufs] := "ENOBUFS";
message[nobufs] := "No buffer space available"; message[nobufs] := "No buffer space available";

44
src/library/ulm/ulmSysIO.Mod
View file

@ -33,7 +33,7 @@ MODULE ulmSysIO;
IMPORT RelatedEvents := ulmRelatedEvents, IMPORT RelatedEvents := ulmRelatedEvents,
Sys := ulmSys, SYS := SYSTEM, ulmSYSTEM, Sys := ulmSys, SYS := SYSTEM, ulmSYSTEM,
SysErrors := ulmSysErrors, SysTypes := ulmSysTypes, SysErrors := ulmSysErrors, SysTypes := ulmSysTypes,
Platform; Platform, Types := ulmTypes;
CONST CONST
(* file control options: arguments of Fcntl and Open *) (* file control options: arguments of Fcntl and Open *)
@ -79,11 +79,11 @@ MODULE ulmSysIO;
File* = SysTypes.File; (* file descriptor *) File* = SysTypes.File; (* file descriptor *)
Address* = SysTypes.Address; Address* = SysTypes.Address;
Count* = SysTypes.Count; Count* = SysTypes.Count;
Protection* = LONGINT; Protection* = Types.Int32;
Whence* = LONGINT; Whence* = Types.Int32;
PROCEDURE OpenCreat*(VAR fd: File; PROCEDURE OpenCreat*(VAR fd: File;
filename: ARRAY OF CHAR; options: SET; filename: ARRAY OF CHAR; options: Types.Set;
protection: Protection; protection: Protection;
errors: RelatedEvents.Object; errors: RelatedEvents.Object;
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN; retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
@ -110,7 +110,7 @@ MODULE ulmSysIO;
END OpenCreat; END OpenCreat;
PROCEDURE Open*(VAR fd: File; PROCEDURE Open*(VAR fd: File;
filename: ARRAY OF CHAR; options: SET; filename: ARRAY OF CHAR; options: Types.Set;
errors: RelatedEvents.Object; errors: RelatedEvents.Object;
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN; retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
(* the filename must be 0X-terminated *) (* the filename must be 0X-terminated *)
@ -196,7 +196,7 @@ MODULE ulmSysIO;
PROCEDURE Seek*(fd: File; offset: Count; whence: Whence; PROCEDURE Seek*(fd: File; offset: Count; whence: Whence;
errors: RelatedEvents.Object) : BOOLEAN; errors: RelatedEvents.Object) : BOOLEAN;
VAR VAR
error: Platform.ErrorCode; relativity: INTEGER; error: Platform.ErrorCode; relativity: Types.Int16;
BEGIN BEGIN
CASE whence OF CASE whence OF
|fromPos: relativity := Platform.SeekCur |fromPos: relativity := Platform.SeekCur
@ -216,7 +216,7 @@ MODULE ulmSysIO;
PROCEDURE Tell*(fd: File; VAR offset: Count; PROCEDURE Tell*(fd: File; VAR offset: Count;
errors: RelatedEvents.Object) : BOOLEAN; errors: RelatedEvents.Object) : BOOLEAN;
VAR VAR
d0, d1: LONGINT; d0, d1: Types.Int32;
BEGIN BEGIN
IF ulmSYSTEM.UNIXCALL(Sys.lseek, d0, d1, fd, 0, fromPos) THEN IF ulmSYSTEM.UNIXCALL(Sys.lseek, d0, d1, fd, 0, fromPos) THEN
offset := d0; offset := d0;
@ -232,17 +232,17 @@ MODULE ulmSysIO;
sizeofStructTermIO = 18; sizeofStructTermIO = 18;
tcgeta = 00005405H; tcgeta = 00005405H;
VAR VAR
d0, d1: LONGINT; d0, d1: Types.Int32;
buf: ARRAY 32 OF SYS.BYTE; (* Should be more than sufficient *) buf: ARRAY 32 OF SYS.BYTE; (* Should be more than sufficient *)
BEGIN BEGIN
(* following system call fails for non-tty's *) (* following system call fails for non-tty's *)
RETURN ulmSYSTEM.UNIXCALL(Sys.ioctl, d0, d1, fd, tcgeta, SYS.ADR(buf)) RETURN ulmSYSTEM.UNIXCALL(Sys.ioctl, d0, d1, fd, tcgeta, SYS.ADR(buf))
END Isatty; END Isatty;
PROCEDURE Fcntl*(fd: File; request: INTEGER; VAR arg: LONGINT; PROCEDURE Fcntl*(fd: File; request: Types.Int32; VAR arg: Types.Int32;
errors: RelatedEvents.Object; errors: RelatedEvents.Object;
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN; retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
VAR VAR
d0, d1: LONGINT; d0, d1: Types.Int32;
BEGIN BEGIN
interrupted := FALSE; interrupted := FALSE;
LOOP LOOP
@ -261,15 +261,15 @@ MODULE ulmSysIO;
END; END;
END Fcntl; END Fcntl;
PROCEDURE FcntlSet*(fd: File; request: INTEGER; flags: SET; PROCEDURE FcntlSet*(fd: File; request: Types.Int32; flags: Types.Set;
errors: RelatedEvents.Object; errors: RelatedEvents.Object;
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN; retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
VAR VAR
d0, d1: LONGINT; d0, d1: Types.Int32;
BEGIN BEGIN
interrupted := FALSE; interrupted := FALSE;
LOOP LOOP
IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, SYS.VAL(LONGINT, flags)) THEN IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, SYS.VAL(Types.Int32, flags)) THEN
RETURN TRUE RETURN TRUE
ELSE ELSE
IF d0 = SysErrors.intr THEN IF d0 = SysErrors.intr THEN
@ -283,10 +283,10 @@ MODULE ulmSysIO;
END; END;
END FcntlSet; END FcntlSet;
PROCEDURE FcntlGet*(fd: File; request: INTEGER; VAR flags: SET; PROCEDURE FcntlGet*(fd: File; request: Types.Int32; VAR flags: Types.Set;
errors: RelatedEvents.Object) : BOOLEAN; errors: RelatedEvents.Object) : BOOLEAN;
VAR VAR
d0, d1: LONGINT; d0, d1: Types.Int32;
BEGIN BEGIN
IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, 0) THEN IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, 0) THEN
ulmSYSTEM.WMOVE(SYS.ADR(d0), SYS.ADR(flags), 1); ulmSYSTEM.WMOVE(SYS.ADR(d0), SYS.ADR(flags), 1);
@ -300,8 +300,8 @@ MODULE ulmSysIO;
PROCEDURE Dup*(fd: File; VAR newfd: File; PROCEDURE Dup*(fd: File; VAR newfd: File;
errors: RelatedEvents.Object) : BOOLEAN; errors: RelatedEvents.Object) : BOOLEAN;
VAR VAR
d0, d1: LONGINT; d0, d1: Types.Int32;
a0, a1: LONGINT; a0, a1: Types.Int32;
BEGIN BEGIN
a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *) a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
IF ulmSYSTEM.UNIXCALL(Sys.dup, d0, d1, fd, a0, a1) THEN IF ulmSYSTEM.UNIXCALL(Sys.dup, d0, d1, fd, a0, a1) THEN
@ -315,8 +315,8 @@ MODULE ulmSysIO;
PROCEDURE Dup2*(fd, newfd: File; errors: RelatedEvents.Object) : BOOLEAN; PROCEDURE Dup2*(fd, newfd: File; errors: RelatedEvents.Object) : BOOLEAN;
VAR VAR
d0, d1: LONGINT; d0, d1: Types.Int32;
a0, a1: LONGINT; a0, a1: Types.Int32;
fd2: File; fd2: File;
interrupted: BOOLEAN; interrupted: BOOLEAN;
BEGIN BEGIN
@ -338,9 +338,9 @@ MODULE ulmSysIO;
PROCEDURE Pipe*(VAR readfd, writefd: File; PROCEDURE Pipe*(VAR readfd, writefd: File;
errors: RelatedEvents.Object) : BOOLEAN; errors: RelatedEvents.Object) : BOOLEAN;
VAR VAR
d0, d1: LONGINT; d0, d1: Types.Int32;
a0, a1: LONGINT; a0, a1: Types.Int32;
fds : ARRAY 2 OF (*File*)INTEGER; (* it needs int pipefd[2], and int is 4 bytes long on x86_64 -- noch *) fds : ARRAY 2 OF (*File*)Types.Int32; (* it needs int pipefd[2], and int is 4 bytes long on x86_64 -- noch *)
BEGIN BEGIN
a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *) a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
IF ulmSYSTEM.UNIXCALL(Sys.pipe, d0, d1, SYS.ADR (fds), a0, a1) THEN IF ulmSYSTEM.UNIXCALL(Sys.pipe, d0, d1, SYS.ADR (fds), a0, a1) THEN

52
src/library/ulm/ulmSysStat.Mod
View file

@ -40,7 +40,7 @@ MODULE ulmSysStat;
(* examine inode: stat(2) and fstat(2) *) (* examine inode: stat(2) and fstat(2) *)
IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, uSYS := ulmSYSTEM, SysConversions := ulmSysConversions, SysErrors := ulmSysErrors, IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, uSYS := ulmSYSTEM, SysConversions := ulmSysConversions, SysErrors := ulmSysErrors,
SysTypes := ulmSysTypes; SysTypes := ulmSysTypes, Types := ulmTypes;
CONST CONST
(* file mode: (* file mode:
@ -96,17 +96,17 @@ MODULE ulmSysStat;
device*: SysTypes.Device; (* ID of device containing a directory entry device*: SysTypes.Device; (* ID of device containing a directory entry
for this file *) for this file *)
inode*: SysTypes.Inode; (* inode number *) inode*: SysTypes.Inode; (* inode number *)
mode*: SET; (* file mode; see mknod(2) *) mode*: Types.Set; (* file mode; see mknod(2) *)
nlinks*: LONGINT; (* number of links *) nlinks*: Types.Int32; (* number of links *)
uid*: LONGINT; (* user id of the file's owner *) uid*: Types.Int32; (* user id of the file's owner *)
gid*: LONGINT; (* group id of the file's group *) gid*: Types.Int32; (* group id of the file's group *)
rdev*: SysTypes.Device; (* ID of device. this entry is defined only for rdev*: SysTypes.Device; (* ID of device. this entry is defined only for
character special or block special files *) character special or block special files *)
size*: SysTypes.Offset; (* file size in bytes *) size*: SysTypes.Offset; (* file size in bytes *)
(* Blocks and blksize are not available on all platforms. (* Blocks and blksize are not available on all platforms.
blksize*: LONGINT; (* preferred blocksize *) blksize*: Types.Int32; (* preferred blocksize *)
blocks*: LONGINT; (* # of blocks allocated *) blocks*: Types.Int32; (* # of blocks allocated *)
*) *)
atime*: SysTypes.Time; (* time of last access *) atime*: SysTypes.Time; (* time of last access *)
@ -119,27 +119,27 @@ MODULE ulmSysStat;
PROCEDURE -Aerrno '#include <errno.h>'; PROCEDURE -Aerrno '#include <errno.h>';
PROCEDURE -structstats "struct stat s"; PROCEDURE -structstats "struct stat s";
PROCEDURE -statdev(): LONGINT "(LONGINT)s.st_dev"; PROCEDURE -statdev(): Types.Int32 "(INT32)s.st_dev";
PROCEDURE -statino(): LONGINT "(LONGINT)s.st_ino"; PROCEDURE -statino(): Types.Int32 "(INT32)s.st_ino";
PROCEDURE -statmode(): LONGINT "(LONGINT)s.st_mode"; PROCEDURE -statmode(): Types.Int32 "(INT32)s.st_mode";
PROCEDURE -statnlink(): LONGINT "(LONGINT)s.st_nlink"; PROCEDURE -statnlink(): Types.Int32 "(INT32)s.st_nlink";
PROCEDURE -statuid(): LONGINT "(LONGINT)s.st_uid"; PROCEDURE -statuid(): Types.Int32 "(INT32)s.st_uid";
PROCEDURE -statgid(): LONGINT "(LONGINT)s.st_gid"; PROCEDURE -statgid(): Types.Int32 "(INT32)s.st_gid";
PROCEDURE -statrdev(): LONGINT "(LONGINT)s.st_rdev"; PROCEDURE -statrdev(): Types.Int32 "(INT32)s.st_rdev";
PROCEDURE -statsize(): LONGINT "(LONGINT)s.st_size"; PROCEDURE -statsize(): Types.Int32 "(INT32)s.st_size";
PROCEDURE -statatime(): LONGINT "(LONGINT)s.st_atime"; PROCEDURE -statatime(): Types.Int32 "(INT32)s.st_atime";
PROCEDURE -statmtime(): LONGINT "(LONGINT)s.st_mtime"; PROCEDURE -statmtime(): Types.Int32 "(INT32)s.st_mtime";
PROCEDURE -statctime(): LONGINT "(LONGINT)s.st_ctime"; PROCEDURE -statctime(): Types.Int32 "(INT32)s.st_ctime";
(* Blocks and blksize are not available on all platforms. (* Blocks and blksize are not available on all platforms.
PROCEDURE -statblksize(): LONGINT "(LONGINT)s.st_blksize"; PROCEDURE -statblksize(): Types.Int32 "(Types.Int32)s.st_blksize";
PROCEDURE -statblocks(): LONGINT "(LONGINT)s.st_blocks"; PROCEDURE -statblocks(): Types.Int32 "(Types.Int32)s.st_blocks";
*) *)
PROCEDURE -fstat(fd: LONGINT): INTEGER "fstat(fd, &s)"; PROCEDURE -fstat(fd: Types.Int32): Types.Int32 "fstat(fd, &s)";
PROCEDURE -stat (n: ARRAY OF CHAR): INTEGER "stat((char*)n, &s)"; PROCEDURE -stat (n: ARRAY OF CHAR): Types.Int32 "stat((char*)n, &s)";
PROCEDURE -err(): INTEGER "errno"; PROCEDURE -err(): Types.Int32 "errno";
PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec; errors: RelatedEvents.Object): BOOLEAN; PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec; errors: RelatedEvents.Object): BOOLEAN;
BEGIN BEGIN
@ -147,7 +147,7 @@ MODULE ulmSysStat;
IF stat(path) < 0 THEN SysErrors.Raise(errors, err(), Sys.newstat, path); RETURN FALSE END; IF stat(path) < 0 THEN SysErrors.Raise(errors, err(), Sys.newstat, path); RETURN FALSE END;
buf.device := SYS.VAL(SysTypes.Device, statdev()); buf.device := SYS.VAL(SysTypes.Device, statdev());
buf.inode := SYS.VAL(SysTypes.Inode, statino()); buf.inode := SYS.VAL(SysTypes.Inode, statino());
buf.mode := SYS.VAL(SET, statmode()); buf.mode := SYS.VAL(Types.Set, statmode());
buf.nlinks := statnlink(); buf.nlinks := statnlink();
buf.uid := statuid(); buf.uid := statuid();
buf.gid := statgid(); buf.gid := statgid();
@ -166,10 +166,10 @@ MODULE ulmSysStat;
PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec; errors: RelatedEvents.Object): BOOLEAN; PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec; errors: RelatedEvents.Object): BOOLEAN;
BEGIN BEGIN
structstats; structstats;
IF fstat(SYS.VAL(LONGINT, fd)) < 0 THEN SysErrors.Raise(errors, err(), Sys.newfstat, ""); RETURN FALSE END; IF fstat(SYS.VAL(Types.Int32, fd)) < 0 THEN SysErrors.Raise(errors, err(), Sys.newfstat, ""); RETURN FALSE END;
buf.device := SYS.VAL(SysTypes.Device, statdev()); buf.device := SYS.VAL(SysTypes.Device, statdev());
buf.inode := SYS.VAL(SysTypes.Inode, statino()); buf.inode := SYS.VAL(SysTypes.Inode, statino());
buf.mode := SYS.VAL(SET, statmode()); buf.mode := SYS.VAL(Types.Set, statmode());
buf.nlinks := statnlink(); buf.nlinks := statnlink();
buf.uid := statuid(); buf.uid := statuid();
buf.gid := statgid(); buf.gid := statgid();

12
src/library/ulm/ulmSysTypes.Mod
View file

@ -40,12 +40,12 @@ MODULE ulmSysTypes;
Byte* = Types.Byte; Byte* = Types.Byte;
File* = Platform.FileHandle; File* = Platform.FileHandle;
Offset* = LONGINT; Offset* = Types.Int32;
Device* = LONGINT; Device* = Types.Int32;
Inode* = LONGINT; Inode* = Types.Int32;
Time* = LONGINT; Time* = Types.Int32;
Word* = INTEGER; (* must have the size of C's int-type *) Word* = Types.Int32; (* must have the size of C's int-type *)
(* Note: linux supports wait4 but not waitid, i.e. these (* Note: linux supports wait4 but not waitid, i.e. these
* constants aren't needed. *) * constants aren't needed. *)
@ -64,7 +64,7 @@ MODULE ulmSysTypes;
idAll = 7; (* all processes *) idAll = 7; (* all processes *)
idLwpid = 8; (* an LWP identifier *) idLwpid = 8; (* an LWP identifier *)
TYPE TYPE
IdType = INTEGER; (* idPid .. idLwpid *) IdType = Types.Int32; (* idPid .. idLwpid *)
*) *)
END ulmSysTypes. END ulmSysTypes.

123
src/library/ulm/ulmTCrypt.Mod
View file

@ -36,7 +36,8 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
Events := ulmEvents, NetIO := ulmNetIO, Events := ulmEvents, NetIO := ulmNetIO,
PersistentObjects := ulmPersistentObjects, Random := ulmRandomGenerators, PersistentObjects := ulmPersistentObjects, Random := ulmRandomGenerators,
RelatedEvents := ulmRelatedEvents, Services := ulmServices, RelatedEvents := ulmRelatedEvents, Services := ulmServices,
Streams := ulmStreams, SYS := SYSTEM; Streams := ulmStreams, SYS := SYSTEM,
Types := ulmTypes;
CONST CONST
M = 16; (* size of an element of CC(M) [ring of Circular Convolution] *) M = 16; (* size of an element of CC(M) [ring of Circular Convolution] *)
@ -59,8 +60,8 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
TYPE TYPE
(* an element out of CC(M) *) (* an element out of CC(M) *)
CCMElement = SET; CCMElement = Types.Set;
Exponent = ARRAY MaxVar OF SHORTINT; Exponent = ARRAY MaxVar OF Types.Int8;
TYPE TYPE
(* a polynomial with coefficients out of CC(M) *) (* a polynomial with coefficients out of CC(M) *)
@ -161,7 +162,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
ErrorEvent = POINTER TO ErrorEventRec; ErrorEvent = POINTER TO ErrorEventRec;
ErrorEventRec = RECORD ErrorEventRec = RECORD
(Events.EventRec) (Events.EventRec)
errorcode : SHORTINT; errorcode : Types.Int8;
END; END;
VAR VAR
@ -176,7 +177,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PolFeld : ARRAY MaxTerms OF Polynom; (* used for sorting purposes *) PolFeld : ARRAY MaxTerms OF Polynom; (* used for sorting purposes *)
PreEvalArg : ARRAY M OF TCryptInput; (* precomputed values to speed PreEvalArg : ARRAY M OF TCryptInput; (* precomputed values to speed
up evaluation of a polynomial *) up evaluation of a polynomial *)
k : SHORTINT; (* simple counter during initialisation *) k : Types.Int8; (* simple counter during initialisation *)
error : Events.EventType; error : Events.EventType;
errormsg : ARRAY errorcodes OF Events.Message; errormsg : ARRAY errorcodes OF Events.Message;
@ -191,7 +192,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
errormsg[notRegular] := "element isn't regular"; errormsg[notRegular] := "element isn't regular";
END InitErrorHandling; END InitErrorHandling;
PROCEDURE Error(s: Streams.Stream; errorcode: SHORTINT); PROCEDURE Error(s: Streams.Stream; errorcode: Types.Int8);
VAR VAR
event: ErrorEvent; event: ErrorEvent;
BEGIN BEGIN
@ -208,7 +209,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
(* tests x for regularity [a regular CCMElement contains an odd number of (* tests x for regularity [a regular CCMElement contains an odd number of
set bits]; returns TRUE when x is regular, FALSE otherwise *) set bits]; returns TRUE when x is regular, FALSE otherwise *)
VAR VAR
res, i : SHORTINT; res, i : Types.Int8;
BEGIN BEGIN
i := 0; i := 0;
res := 0; res := 0;
@ -225,7 +226,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
(* compares x and y for equality; if x and y are equal TRUE is returned, (* compares x and y for equality; if x and y are equal TRUE is returned,
FALSE otherwise *) FALSE otherwise *)
VAR VAR
i : SHORTINT; i : Types.Int8;
BEGIN BEGIN
i := 0; i := 0;
WHILE i < M DO WHILE i < M DO
@ -240,7 +241,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PROCEDURE AddCCM (x, y: CCMElement; VAR z: CCMElement); PROCEDURE AddCCM (x, y: CCMElement; VAR z: CCMElement);
(* add x and y in CC(M) *) (* add x and y in CC(M) *)
VAR VAR
i : SHORTINT; i : Types.Int8;
BEGIN BEGIN
z := NullCCM; z := NullCCM;
i := 0; i := 0;
@ -255,8 +256,8 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PROCEDURE MulCCM (x, y: CCMElement; VAR z: CCMElement); PROCEDURE MulCCM (x, y: CCMElement; VAR z: CCMElement);
(* multiply x and y in CC(M) *) (* multiply x and y in CC(M) *)
VAR VAR
i, j, diff : SHORTINT; i, j, diff : Types.Int8;
tmp : INTEGER; tmp : Types.Int32;
BEGIN BEGIN
z := NullCCM; z := NullCCM;
i := 0; i := 0;
@ -283,7 +284,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
UNTIL i>=M; UNTIL i>=M;
END MulCCM; END MulCCM;
PROCEDURE PowerCCM (x: CCMElement; exp: INTEGER; VAR z: CCMElement); PROCEDURE PowerCCM (x: CCMElement; exp: Types.Int32; VAR z: CCMElement);
(* raises x to the power exp in CC(M) *) (* raises x to the power exp in CC(M) *)
VAR VAR
tmp : CCMElement; tmp : CCMElement;
@ -320,12 +321,12 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
UNTIL exp < 1; UNTIL exp < 1;
END PowerCCM; END PowerCCM;
PROCEDURE CreateCCM (VAR x: CCMElement; mode: SHORTINT); PROCEDURE CreateCCM (VAR x: CCMElement; mode: Types.Int8);
(* creates a random element out of CC(M) depending on mode which (* creates a random element out of CC(M) depending on mode which
can be reg, sing or random; can be reg, sing or random;
the result is in any case different from the zero *) the result is in any case different from the zero *)
VAR VAR
i, SetBits: SHORTINT; i, SetBits: Types.Int8;
BEGIN BEGIN
x := NullCCM; x := NullCCM;
REPEAT REPEAT
@ -361,10 +362,10 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
(* ***** arithmetic functions for polynomials over CC(M) ***** *) (* ***** arithmetic functions for polynomials over CC(M) ***** *)
PROCEDURE LengthPolynom(p: Polynom) : INTEGER; PROCEDURE LengthPolynom(p: Polynom) : Types.Int32;
(* returns the number of terms which make up the polynomial p *) (* returns the number of terms which make up the polynomial p *)
VAR VAR
i : INTEGER; i : Types.Int32;
BEGIN BEGIN
i := 0; i := 0;
WHILE p # NIL DO WHILE p # NIL DO
@ -378,7 +379,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
(* tests the regularity of a polynomial [a polynomial is regular (* tests the regularity of a polynomial [a polynomial is regular
iff the # of regular coefficients is odd] *) iff the # of regular coefficients is odd] *)
VAR VAR
regkoeffs : SHORTINT; regkoeffs : Types.Int8;
BEGIN BEGIN
regkoeffs := 0; regkoeffs := 0;
WHILE p # NIL DO WHILE p # NIL DO
@ -391,16 +392,16 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
RETURN (regkoeffs MOD 2) = 1; RETURN (regkoeffs MOD 2) = 1;
END RegulaerPolynom; END RegulaerPolynom;
PROCEDURE CmpExp (exp1, exp2: Exponent) : SHORTINT; PROCEDURE CmpExp (exp1, exp2: Exponent) : Types.Int8;
(* compares two exponent vectors and returns 0 on equality, a (* compares two exponent vectors and returns 0 on equality, a
positive value if exp1>exp2 and a negative value if exp1<exp2; positive value if exp1>exp2 and a negative value if exp1<exp2;
the absolute value can be 1 or 2 : 2 if the sums of the the absolute value can be 1 or 2 : 2 if the sums of the
vectors differ, 1 otherwise; this distinction isn't used, but vectors differ, 1 otherwise; this distinction isn't used, but
it could be useful for later versions *) it could be useful for later versions *)
VAR VAR
i : SHORTINT; i : Types.Int8;
e1, e2: INTEGER; diff: BOOLEAN; cmp: SHORTINT; e1, e2: Types.Int32; diff: BOOLEAN; cmp: Types.Int8;
sum1, sum2 : INTEGER; sum1, sum2 : Types.Int32;
BEGIN BEGIN
i := 0; i := 0;
sum1 := 0; sum2 := 0; diff := FALSE; cmp := 0; sum1 := 0; sum2 := 0; diff := FALSE; cmp := 0;
@ -431,19 +432,19 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
(* arrange a polynomial according to the order given by CmpExp *) (* arrange a polynomial according to the order given by CmpExp *)
VAR VAR
r : Polynom; r : Polynom;
cnt : INTEGER; cnt : Types.Int32;
PROCEDURE SortPolynom(left, right: INTEGER); PROCEDURE SortPolynom(left, right: Types.Int32);
(* sort the global field PolFeld with the quicksort algorithm *) (* sort the global field PolFeld with the quicksort algorithm *)
VAR VAR
mid : INTEGER; mid : Types.Int32;
PROCEDURE Partition(l, r: INTEGER) : INTEGER; PROCEDURE Partition(l, r: Types.Int32) : Types.Int32;
VAR VAR
koeff : CCMElement; koeff : CCMElement;
exp : Exponent; exp : Exponent;
cmp : Exponent; cmp : Exponent;
i, j : INTEGER; i, j : Types.Int32;
BEGIN BEGIN
cmp := PolFeld[(l+r) DIV 2].exp; cmp := PolFeld[(l+r) DIV 2].exp;
i := l-1; i := l-1;
@ -528,7 +529,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
term1, term2 : Polynom; term1, term2 : Polynom;
last : Polynom; (* the last term of the result *) last : Polynom; (* the last term of the result *)
tmp : Polynom; tmp : Polynom;
cmpres : SHORTINT; cmpres : Types.Int8;
BEGIN BEGIN
IF (p = NIL) & (q = NIL) THEN IF (p = NIL) & (q = NIL) THEN
r := NIL; r := NIL;
@ -606,7 +607,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
(* add two exponent vetors; addition is modulo M *) (* add two exponent vetors; addition is modulo M *)
PROCEDURE AddExp (exp1, exp2 : Exponent; VAR res: Exponent); PROCEDURE AddExp (exp1, exp2 : Exponent; VAR res: Exponent);
VAR VAR
i : SHORTINT; i : Types.Int8;
BEGIN BEGIN
i := 0; i := 0;
WHILE i<MaxVar DO WHILE i<MaxVar DO
@ -681,7 +682,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
(* inverts a regular polynomial; if p is illegal (NIL) or singular the (* inverts a regular polynomial; if p is illegal (NIL) or singular the
result is NIL *) result is NIL *)
VAR VAR
exp : SHORTINT; exp : Types.Int8;
tmp : Polynom; tmp : Polynom;
BEGIN BEGIN
IF (p = NIL) OR ~RegulaerPolynom(p) THEN IF (p = NIL) OR ~RegulaerPolynom(p) THEN
@ -706,7 +707,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
(* evaluate p; a precomputed list of all the powers of the argument can (* evaluate p; a precomputed list of all the powers of the argument can
be found in the global variable PreEvalArg *) be found in the global variable PreEvalArg *)
VAR VAR
i : SHORTINT; i : Types.Int8;
pow, prod : CCMElement; pow, prod : CCMElement;
BEGIN BEGIN
res := NullCCM; res := NullCCM;
@ -730,7 +731,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PROCEDURE CreateExp (VAR exp: Exponent); PROCEDURE CreateExp (VAR exp: Exponent);
(* creates a random vector of exponents *) (* creates a random vector of exponents *)
VAR VAR
i : SHORTINT; i : Types.Int8;
BEGIN BEGIN
i := 0; i := 0;
WHILE i<MaxVar DO WHILE i<MaxVar DO
@ -742,7 +743,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PROCEDURE CreateExpList (VAR explist : ListExp); PROCEDURE CreateExpList (VAR explist : ListExp);
(* create a list of MaxNrExp different exponents *) (* create a list of MaxNrExp different exponents *)
VAR VAR
i : SHORTINT; i : Types.Int8;
BEGIN BEGIN
i := 0; i := 0;
WHILE i < MaxNrExp DO WHILE i < MaxNrExp DO
@ -751,7 +752,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
END; END;
END CreateExpList; END CreateExpList;
PROCEDURE CreatePolynom (VAR p: Polynom; terms: SHORTINT; mode: SHORTINT; PROCEDURE CreatePolynom (VAR p: Polynom; terms: Types.Int8; mode: Types.Int8;
UseList: BOOLEAN; explist: ListExp); UseList: BOOLEAN; explist: ListExp);
(* creates a random polynomial depending on mode (can be reg, (* creates a random polynomial depending on mode (can be reg,
sing or random); sing or random);
@ -760,8 +761,8 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
created entirely randomly but will be chosen form a list of created entirely randomly but will be chosen form a list of
precomputed exponents *) precomputed exponents *)
VAR VAR
regkoeffs, i : SHORTINT; regkoeffs, i : Types.Int8;
expindex : SHORTINT; expindex : Types.Int8;
proot, tmp : Polynom; proot, tmp : Polynom;
doubleexp : BOOLEAN; doubleexp : BOOLEAN;
@ -851,11 +852,11 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
AddPolynom(mul1, mul2, res); AddPolynom(mul1, mul2, res);
END DetMatrix; END DetMatrix;
PROCEDURE ChangeCol (mat: MatPolynom; vek: VektorPolynom; col: INTEGER; PROCEDURE ChangeCol (mat: MatPolynom; vek: VektorPolynom; col: Types.Int32;
VAR res: MatPolynom); VAR res: MatPolynom);
(* replaces the column #col in mat with vek *) (* replaces the column #col in mat with vek *)
VAR VAR
dx, dy : INTEGER; dx, dy : Types.Int32;
BEGIN BEGIN
dx := 0; dx := 0;
WHILE dx < Dim DO WHILE dx < Dim DO
@ -875,7 +876,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PROCEDURE ChooseInitialMatrix(VAR mat: MatPolynom); PROCEDURE ChooseInitialMatrix(VAR mat: MatPolynom);
(* choose an initial matrix for the recursion *) (* choose an initial matrix for the recursion *)
VAR VAR
dx, dy : SHORTINT; dx, dy : Types.Int8;
BEGIN BEGIN
(* the starting matrix consists only of regular components *) (* the starting matrix consists only of regular components *)
dy := 0; dy := 0;
@ -911,7 +912,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PROCEDURE MulMatrix (mat: MatCCM; col: VektorCCM; VAR res: VektorCCM); PROCEDURE MulMatrix (mat: MatCCM; col: VektorCCM; VAR res: VektorCCM);
(* multiplies the matrix mat with the vector col *) (* multiplies the matrix mat with the vector col *)
VAR VAR
x, y : SHORTINT; x, y : Types.Int8;
addres, mulres : CCMElement; addres, mulres : CCMElement;
BEGIN BEGIN
x := 0; x := 0;
@ -945,9 +946,9 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
(* create random but suiting maps phi, psi and eta for a pair of (* create random but suiting maps phi, psi and eta for a pair of
public and private keys *) public and private keys *)
VAR VAR
r, d, idx : SHORTINT; r, d, idx : Types.Int8;
regindex, singindex : SHORTINT; regindex, singindex : Types.Int8;
dx, dy : SHORTINT; dx, dy : Types.Int8;
A : ChainPolynom; A : ChainPolynom;
E : ARRAY Rounds OF MatPolynom; E : ARRAY Rounds OF MatPolynom;
num : ChainPolynom; num : ChainPolynom;
@ -1070,7 +1071,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PROCEDURE PreComputeArgs(arg: TCryptInput); PROCEDURE PreComputeArgs(arg: TCryptInput);
(* used for preevaluation of a polynomial argument *) (* used for preevaluation of a polynomial argument *)
VAR VAR
k, i, kk, ii : INTEGER; k, i, kk, ii : Types.Int32;
tmp : CCMElement; tmp : CCMElement;
BEGIN BEGIN
i := 0; i := 0;
@ -1111,7 +1112,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
argument arg *) argument arg *)
VAR VAR
res : TCryptTmp; res : TCryptTmp;
r, d : SHORTINT; r, d : Types.Int8;
BEGIN BEGIN
NEW(res); NEW(res);
PreComputeArgs(arg); PreComputeArgs(arg);
@ -1136,7 +1137,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
num, denom, inv : CCMElement; num, denom, inv : CCMElement;
vek : VektorCCM; vek : VektorCCM;
A : ChainCCM; A : ChainCCM;
r, d : SHORTINT; r, d : Types.Int8;
BEGIN BEGIN
(* first correct the input with the correlating inverts *) (* first correct the input with the correlating inverts *)
MulCCM(arg.denominator[0], data.korrDenom[0], denom); MulCCM(arg.denominator[0], data.korrDenom[0], denom);
@ -1178,7 +1179,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PROCEDURE EvaluateEta (arg: TCryptInput; data: Eta) : TCryptRes; PROCEDURE EvaluateEta (arg: TCryptInput; data: Eta) : TCryptRes;
(* evaluate the public function eta (composition of phi and psi) *) (* evaluate the public function eta (composition of phi and psi) *)
VAR VAR
l, d : SHORTINT; l, d : Types.Int8;
res : TCryptRes; res : TCryptRes;
BEGIN BEGIN
NEW(res); NEW(res);
@ -1204,10 +1205,10 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
END Eof; END Eof;
PROCEDURE Encrypt (msg: Streams.Stream; key: Ciphers.Cipher; PROCEDURE Encrypt (msg: Streams.Stream; key: Ciphers.Cipher;
length: INTEGER; s: Streams.Stream) : BOOLEAN; length: Types.Int32; s: Streams.Stream) : BOOLEAN;
(* interface procedure for Ciphers.Encrypt *) (* interface procedure for Ciphers.Encrypt *)
VAR VAR
i, j : SHORTINT; i, j : Types.Int8;
ccmarg : TCryptInput; ccmarg : TCryptInput;
ccmres : TCryptTmp; ccmres : TCryptTmp;
wholeStream : BOOLEAN; wholeStream : BOOLEAN;
@ -1260,10 +1261,10 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
END Encrypt; END Encrypt;
PROCEDURE Decrypt (msg: Streams.Stream; key: Ciphers.Cipher; PROCEDURE Decrypt (msg: Streams.Stream; key: Ciphers.Cipher;
length: INTEGER; s: Streams.Stream) : BOOLEAN; length: Types.Int32; s: Streams.Stream) : BOOLEAN;
(* interface procedure for Ciphers.Decrypt *) (* interface procedure for Ciphers.Decrypt *)
VAR VAR
i, j : SHORTINT; i, j : Types.Int8;
inNum, inDenom, out : ARRAY (M DIV 8) OF SYS.BYTE; inNum, inDenom, out : ARRAY (M DIV 8) OF SYS.BYTE;
ccmarg : TCryptTmp; ccmarg : TCryptTmp;
ccmres : TCryptRes; ccmres : TCryptRes;
@ -1313,10 +1314,10 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
END Decrypt; END Decrypt;
PROCEDURE ComposedEncrypt (msg: Streams.Stream; key: Ciphers.Cipher; PROCEDURE ComposedEncrypt (msg: Streams.Stream; key: Ciphers.Cipher;
length: INTEGER; s: Streams.Stream) : BOOLEAN; length: Types.Int32; s: Streams.Stream) : BOOLEAN;
(* interface procedure for AsymmetricCiphers.ComposedEncrypt *) (* interface procedure for AsymmetricCiphers.ComposedEncrypt *)
VAR VAR
i, j : SHORTINT; i, j : Types.Int8;
ccmarg : TCryptInput; ccmarg : TCryptInput;
ccmres : TCryptRes; ccmres : TCryptRes;
in, out : ARRAY (M DIV 8) OF SYS.BYTE; in, out : ARRAY (M DIV 8) OF SYS.BYTE;
@ -1365,7 +1366,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
VAR VAR
ccm : CCMElement; ccm : CCMElement;
bytes : ARRAY M DIV 8 OF SYS.BYTE; bytes : ARRAY M DIV 8 OF SYS.BYTE;
i : INTEGER; i : Types.Int32;
BEGIN BEGIN
i := 0; i := 0;
WHILE i < MaxVar DO WHILE i < MaxVar DO
@ -1445,7 +1446,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
CONST CONST
index = M DIV 8; index = M DIV 8;
VAR VAR
nrOfTerms, i : INTEGER; nrOfTerms, i : Types.Int32;
bytes : ARRAY index OF SYS.BYTE; bytes : ARRAY index OF SYS.BYTE;
BEGIN BEGIN
nrOfTerms := LengthPolynom(p); nrOfTerms := LengthPolynom(p);
@ -1474,7 +1475,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
CONST CONST
index = M DIV 8; index = M DIV 8;
VAR VAR
nrOfTerms, i : INTEGER; nrOfTerms, i : Types.Int32;
pol : Polynom; pol : Polynom;
bytes : ARRAY index OF SYS.BYTE; bytes : ARRAY index OF SYS.BYTE;
BEGIN BEGIN
@ -1506,7 +1507,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PROCEDURE PhiWrite (s: Streams.Stream; data: Phi) : BOOLEAN; PROCEDURE PhiWrite (s: Streams.Stream; data: Phi) : BOOLEAN;
(* writes the data structure for the public function phi onto a stream *) (* writes the data structure for the public function phi onto a stream *)
VAR VAR
r, d, k : INTEGER; r, d, k : Types.Int32;
BEGIN BEGIN
r := 0; r := 0;
WHILE r < Rounds DO WHILE r < Rounds DO
@ -1528,7 +1529,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PROCEDURE PhiRead (s: Streams.Stream; VAR data: Phi) : BOOLEAN; PROCEDURE PhiRead (s: Streams.Stream; VAR data: Phi) : BOOLEAN;
(* reads the data structure for the public function phi from a stream *) (* reads the data structure for the public function phi from a stream *)
VAR VAR
r, d, k : INTEGER; r, d, k : Types.Int32;
BEGIN BEGIN
NEW(data); NEW(data);
r := 0; r := 0;
@ -1553,7 +1554,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
CONST CONST
index = M DIV 8; index = M DIV 8;
VAR VAR
dx, dy, r, d : INTEGER; dx, dy, r, d : Types.Int32;
bytes : ARRAY index OF SYS.BYTE; bytes : ARRAY index OF SYS.BYTE;
BEGIN BEGIN
dy := 0; dy := 0;
@ -1589,7 +1590,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
CONST CONST
index = M DIV 8; index = M DIV 8;
VAR VAR
dy, dx, r, d : INTEGER; dy, dx, r, d : Types.Int32;
bytes : ARRAY index OF SYS.BYTE; bytes : ARRAY index OF SYS.BYTE;
BEGIN BEGIN
dy := 0; dy := 0;
@ -1623,7 +1624,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PROCEDURE EtaWrite (s: Streams.Stream; data: Eta) : BOOLEAN; PROCEDURE EtaWrite (s: Streams.Stream; data: Eta) : BOOLEAN;
(* writes the data structure for the public function eta onto a stream *) (* writes the data structure for the public function eta onto a stream *)
VAR VAR
l, d : INTEGER; l, d : Types.Int32;
BEGIN BEGIN
l := 0; l := 0;
WHILE l < LastRounds DO WHILE l < LastRounds DO
@ -1642,7 +1643,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PROCEDURE EtaRead (s: Streams.Stream; VAR data: Eta) : BOOLEAN; PROCEDURE EtaRead (s: Streams.Stream; VAR data: Eta) : BOOLEAN;
(* reads the data structure for the public function eta from a stream *) (* reads the data structure for the public function eta from a stream *)
VAR VAR
l, d : INTEGER; l, d : Types.Int32;
BEGIN BEGIN
NEW(data); NEW(data);
l := 0; l := 0;

6
src/library/ulm/ulmTimers.Mod
View file

@ -38,7 +38,7 @@
MODULE ulmTimers; MODULE ulmTimers;
IMPORT Clocks := ulmClocks, Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Op := ulmOperations, Priorities := ulmPriorities, IMPORT Clocks := ulmClocks, Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Op := ulmOperations, Priorities := ulmPriorities,
SYS := ulmSYSTEM, RelatedEvents := ulmRelatedEvents, Scales := ulmScales, Times := ulmTimes; SYS := ulmSYSTEM, RelatedEvents := ulmRelatedEvents, Scales := ulmScales, Times := ulmTimes, Types := ulmTypes;
TYPE TYPE
Queue = POINTER TO QueueRec; Queue = POINTER TO QueueRec;
@ -88,7 +88,7 @@ MODULE ulmTimers;
ErrorEventRec* = ErrorEventRec* =
RECORD RECORD
(Events.EventRec) (Events.EventRec)
errorcode*: SHORTINT; errorcode*: Types.Int8;
END; END;
VAR VAR
errormsg*: ARRAY errorcodes OF Events.Message; errormsg*: ARRAY errorcodes OF Events.Message;
@ -102,7 +102,7 @@ MODULE ulmTimers;
Events.Define(error); Events.SetPriority(error, Priorities.liberrors); Events.Define(error); Events.SetPriority(error, Priorities.liberrors);
END InitErrorHandling; END InitErrorHandling;
PROCEDURE Error(errors: RelatedEvents.Object; code: SHORTINT); PROCEDURE Error(errors: RelatedEvents.Object; code: Types.Int8);
VAR VAR
event: ErrorEvent; event: ErrorEvent;
BEGIN BEGIN

14
src/library/ulm/ulmTimes.Mod
View file

@ -38,7 +38,7 @@
MODULE ulmTimes; MODULE ulmTimes;
IMPORT NetIO := ulmNetIO, Objects := ulmObjects, Operations := ulmOperations, PersistentObjects := ulmPersistentObjects, Scales := ulmScales, IMPORT NetIO := ulmNetIO, Objects := ulmObjects, Operations := ulmOperations, PersistentObjects := ulmPersistentObjects, Scales := ulmScales,
Services := ulmServices, Streams := ulmStreams; Services := ulmServices, Streams := ulmStreams, Types := ulmTypes;
CONST CONST
relative* = Scales.relative; relative* = Scales.relative;
@ -86,7 +86,7 @@ MODULE ulmTimes;
UnitRec = UnitRec =
RECORD RECORD
(Scales.UnitRec) (Scales.UnitRec)
index: SHORTINT; (* epochUnit..usecUnit *) index: Types.Int8; (* epochUnit..usecUnit *)
END; END;
VAR VAR
@ -94,7 +94,7 @@ MODULE ulmTimes;
family*: Scales.Family; (* family of time scales *) family*: Scales.Family; (* family of time scales *)
if: Scales.Interface; if: Scales.Interface;
PROCEDURE Create*(VAR time: Time; type: SHORTINT); PROCEDURE Create*(VAR time: Time; type: Types.Int8);
(* type = absolute or relative *) (* type = absolute or relative *)
VAR VAR
m: Scales.Measure; m: Scales.Measure;
@ -157,7 +157,7 @@ MODULE ulmTimes;
END; END;
END SetValue; END SetValue;
PROCEDURE CreateAndSet*(VAR time: Time; type: SHORTINT; PROCEDURE CreateAndSet*(VAR time: Time; type: Types.Int8;
epoch, second, usec: Scales.Value); epoch, second, usec: Scales.Value);
VAR VAR
timeval: TimeValueRec; timeval: TimeValueRec;
@ -285,9 +285,9 @@ MODULE ulmTimes;
END; END; END; END;
END Op; END Op;
PROCEDURE Compare(op1, op2: Scales.Measure) : INTEGER; PROCEDURE Compare(op1, op2: Scales.Measure) : Types.Int32;
PROCEDURE ReturnVal(val1, val2: Scales.Value) : INTEGER; PROCEDURE ReturnVal(val1, val2: Scales.Value) : Types.Int32;
BEGIN BEGIN
IF val1 < val2 THEN IF val1 < val2 THEN
RETURN -1 RETURN -1
@ -370,7 +370,7 @@ MODULE ulmTimes;
VAR VAR
poif: PersistentObjects.Interface; poif: PersistentObjects.Interface;
PROCEDURE InitUnit(unitIndex: SHORTINT; name: Scales.UnitName); PROCEDURE InitUnit(unitIndex: Types.Int8; name: Scales.UnitName);
VAR VAR
unit: Unit; unit: Unit;
BEGIN BEGIN

62
src/library/ulm/ulmTypes.Mod
View file

@ -24,7 +24,7 @@
SetInt type used in msb constant SetInt type used in msb constant
Revision 1.4 2000/12/13 09:51:57 borchert Revision 1.4 2000/12/13 09:51:57 borchert
constants and types for the relationship of INTEGER and SET added constants and types for the relationship of Types.Int32 and Types.Set added
Revision 1.3 1998/09/25 15:23:09 borchert Revision 1.3 1998/09/25 15:23:09 borchert
Real32..Real128 added Real32..Real128 added
@ -40,7 +40,7 @@
---------------------------------------------------------------------------- ----------------------------------------------------------------------------
*) *)
MODULE Types; MODULE ulmTypes;
(* compiler-dependent type definitions; (* compiler-dependent type definitions;
this version works for Ulm's Oberon Compilers on this version works for Ulm's Oberon Compilers on
@ -63,62 +63,68 @@ MODULE Types;
Int32* = SYS.INT32; Int32* = SYS.INT32;
Real32* = LONGREAL; Real32* = LONGREAL;
Real64* = LONGREAL; Real64* = LONGREAL;
Set* = SYS.SET32;
CONST CONST
bigEndian* = 0; (* SPARC, M68K etc *) bigEndian* = 0; (* SPARC, M68K etc *)
littleEndian* = 1; (* Intel 80x86, VAX etc *) littleEndian* = 1; (* Intel 80x86, VAX etc *)
byteorder* = littleEndian; (* machine-dependent constant *) byteorder* = littleEndian; (* machine-dependent constant *)
TYPE TYPE
ByteOrder* = SHORTINT; (* bigEndian or littleEndian *) ByteOrder* = SYS.INT8; (* bigEndian or littleEndian *)
(* following constants and type definitions try to make (* following constants and type definitions try to make
conversions from INTEGER to SET and vice versa more portable conversions from Types.Int32 to Types.Set and vice versa more portable
to allow for bit operations on INTEGER values to allow for bit operations on Types.Int32 values
*) *)
TYPE TYPE
SetInt* = INTEGER; (* INTEGER type that corresponds to SET *) SetInt* = SYS.INT32; (* Types.Int32 type that corresponds to Types.Set *)
CONST VAR
msb* = SYS.VAL(SET, MIN(SetInt)); msb*: SYS.SET32;
(* most significant bit, converted to a SET *) msbIsMax*, msbIs0*: SYS.INT8;
(* we expect msbIsMax XOR msbIs0 to be 1; msbindex*, lsbindex*, nofbits*: SYS.INT32;
this is checked for by an assertion
*)
msbIsMax* = SYS.VAL(SHORTINT, (msb = {MAX(SET)}));
(* is 1, if msb equals {MAX(SET)} *)
msbIs0* = SYS.VAL(SHORTINT, (msb = {0}));
(* is 0, if msb equals {0} *)
msbindex* = msbIsMax * MAX(SET);
(* set element that corresponds to the most-significant-bit *)
lsbindex* = MAX(SET) - msbindex;
(* set element that corresponds to the lowest-significant-bit *)
nofbits* = MAX(SET) + 1;
(* number of elements in SETs *)
PROCEDURE ToInt8*(int: LONGINT) : Int8; PROCEDURE ToInt8*(int: Int32) : Int8;
BEGIN BEGIN
RETURN SHORT(SHORT(int)) RETURN SHORT(SHORT(int))
END ToInt8; END ToInt8;
PROCEDURE ToInt16*(int: LONGINT) : Int16; PROCEDURE ToInt16*(int: Int32) : Int16;
BEGIN BEGIN
RETURN SYS.VAL(Int16, int) RETURN SYS.VAL(Int16, int)
END ToInt16; END ToInt16;
PROCEDURE ToInt32*(int: LONGINT) : Int32; PROCEDURE ToInt32*(int: Int32) : Int32;
BEGIN BEGIN
RETURN int RETURN int
END ToInt32; END ToInt32;
PROCEDURE ToReal32*(real: LONGREAL) : Real32; PROCEDURE ToReal32*(real: Real64) : Real32;
BEGIN BEGIN
RETURN SHORT(real) RETURN SHORT(real)
END ToReal32; END ToReal32;
PROCEDURE ToReal64*(real: LONGREAL) : Real64; PROCEDURE ToReal64*(real: Real64) : Real64;
BEGIN BEGIN
RETURN SHORT(real) RETURN SHORT(real)
END ToReal64; END ToReal64;
BEGIN BEGIN
msb := SYS.VAL(SYS.SET32, MIN(SetInt));
(* most significant bit, converted to a Types.Set *)
(* we expect msbIsMax XOR msbIs0 to be 1;
this is checked for by an assertion
*)
msbIsMax := SYS.VAL(SYS.INT8, (msb = {MAX(Set)}));
(* is 1, if msb equals {MAX(Set)} *)
msbIs0 := SYS.VAL(SYS.INT8, (msb = {0}));
(* is 0, if msb equals {0} *)
msbindex := msbIsMax * MAX(Set);
(* set element that corresponds to the most-significant-bit *)
lsbindex := MAX(Set) - msbindex;
(* set element that corresponds to the lowest-significant-bit *)
nofbits := MAX(Set) + 1;
(* number of elements in Sets *)
ASSERT((msbIs0 = 1) & (msbIsMax = 0) OR (msbIs0 = 0) & (msbIsMax = 1)); ASSERT((msbIs0 = 1) & (msbIsMax = 0) OR (msbIs0 = 0) & (msbIsMax = 1));
END Types. END ulmTypes.

38
src/library/ulm/ulmWrite.Mod
View file

@ -33,31 +33,31 @@
MODULE ulmWrite; MODULE ulmWrite;
IMPORT ASCII := ulmASCII, Print := ulmPrint, StreamDisciplines := ulmStreamDisciplines, Streams := ulmStreams, SYSTEM, SYS := ulmSYSTEM; IMPORT ASCII := ulmASCII, Print := ulmPrint, StreamDisciplines := ulmStreamDisciplines, Streams := ulmStreams, SYSTEM, SYS := ulmSYSTEM, Types := ulmTypes;
(* (*
TYPE barr = ARRAY SIZE(LONGINT) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *) TYPE barr = ARRAY SIZE(Types.Int32) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly Types.Int32 to ARRAY OF BYTE; -- noch *)
pbarr = POINTER TO barr; pbarr = POINTER TO barr;
TYPE lrarr = ARRAY SIZE(LONGREAL) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *) TYPE lrarr = ARRAY SIZE(Types.Real64) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly Types.Int32 to ARRAY OF BYTE; -- noch *)
plrarr = POINTER TO barr; plrarr = POINTER TO barr;
PROCEDURE LongToByteArr ( l : LONGINT; VAR bar : barr); (* noch *) PROCEDURE LongToByteArr ( l : Types.Int32; VAR bar : barr); (* noch *)
VAR b : SYSTEM.BYTE; VAR b : SYSTEM.BYTE;
p : pbarr; p : pbarr;
i : LONGINT; i : Types.Int32;
BEGIN BEGIN
p := SYSTEM.VAL(pbarr, SYSTEM.ADR(l)); p := SYSTEM.VAL(pbarr, SYSTEM.ADR(l));
FOR i := 0 TO SIZE(LONGINT) -1 DO FOR i := 0 TO SIZE(Types.Int32) -1 DO
b := p^[i]; bar[i] := b; b := p^[i]; bar[i] := b;
END END
END LongToByteArr; END LongToByteArr;
PROCEDURE LRealToByteArr ( l : LONGREAL; VAR lar : lrarr); (* noch *) PROCEDURE LRealToByteArr ( l : Types.Real64; VAR lar : lrarr); (* noch *)
VAR b : SYSTEM.BYTE; VAR b : SYSTEM.BYTE;
p : plrarr; p : plrarr;
i : LONGINT; i : Types.Int32;
BEGIN BEGIN
p := SYSTEM.VAL(plrarr, SYSTEM.ADR(l)); p := SYSTEM.VAL(plrarr, SYSTEM.ADR(l));
FOR i := 0 TO SIZE(LONGREAL) -1 DO FOR i := 0 TO SIZE(Types.Real64) -1 DO
b := p^[i]; lar[i] := b; b := p^[i]; lar[i] := b;
END END
END LRealToByteArr; END LRealToByteArr;
@ -65,7 +65,7 @@ MODULE ulmWrite;
*) *)
PROCEDURE IntS*(s: Streams.Stream; int: LONGINT; width: LONGINT); PROCEDURE IntS*(s: Streams.Stream; int: Types.Int32; width: Types.Int32);
VAR b, b0 : SYS.bytearray; VAR b, b0 : SYS.bytearray;
BEGIN BEGIN
SYS.LongToByteArr(int, b); SYS.LongToByteArr(int, b);
@ -73,7 +73,7 @@ MODULE ulmWrite;
Print.S2(s, "%*d", b0, b); Print.S2(s, "%*d", b0, b);
END IntS; END IntS;
PROCEDURE RealS*(s: Streams.Stream; real: LONGREAL; width: LONGINT); PROCEDURE RealS*(s: Streams.Stream; real: Types.Real64; width: Types.Int32);
VAR b : SYS.bytearray; lr : SYS.longrealarray; VAR b : SYS.bytearray; lr : SYS.longrealarray;
BEGIN BEGIN
SYS.LRealToByteArr(real, lr); SYS.LRealToByteArr(real, lr);
@ -93,11 +93,11 @@ MODULE ulmWrite;
PROCEDURE LineS*(s: Streams.Stream; str: ARRAY OF CHAR); PROCEDURE LineS*(s: Streams.Stream; str: ARRAY OF CHAR);
VAR VAR
count: LONGINT; count: Types.Int32;
nlOK: BOOLEAN; nlOK: BOOLEAN;
cnt: LONGINT; cnt: Types.Int32;
lineterm: StreamDisciplines.LineTerminator; lineterm: StreamDisciplines.LineTerminator;
len: INTEGER; i: INTEGER; len: Types.Int32; i: Types.Int32;
BEGIN BEGIN
cnt := 0; cnt := 0;
WHILE (cnt < LEN(str)) & (str[cnt] # 0X) DO WHILE (cnt < LEN(str)) & (str[cnt] # 0X) DO
@ -141,7 +141,7 @@ MODULE ulmWrite;
PROCEDURE LnS*(s: Streams.Stream); PROCEDURE LnS*(s: Streams.Stream);
VAR VAR
lineterm: StreamDisciplines.LineTerminator; lineterm: StreamDisciplines.LineTerminator;
len: INTEGER; len: Types.Int32;
BEGIN BEGIN
StreamDisciplines.GetLineTerm(s, lineterm); StreamDisciplines.GetLineTerm(s, lineterm);
IF lineterm[1] = 0X THEN IF lineterm[1] = 0X THEN
@ -157,7 +157,7 @@ MODULE ulmWrite;
PROCEDURE StringS*(s: Streams.Stream; str: ARRAY OF CHAR); PROCEDURE StringS*(s: Streams.Stream; str: ARRAY OF CHAR);
VAR VAR
cnt: LONGINT; cnt: Types.Int32;
BEGIN BEGIN
cnt := 0; cnt := 0;
WHILE (cnt < LEN(str)) & (str[cnt] # 0X) DO WHILE (cnt < LEN(str)) & (str[cnt] # 0X) DO
@ -168,7 +168,7 @@ MODULE ulmWrite;
PROCEDURE IndentS*(s: Streams.Stream); PROCEDURE IndentS*(s: Streams.Stream);
VAR VAR
indentwidth: INTEGER; indentwidth: Types.Int32;
BEGIN BEGIN
StreamDisciplines.GetIndentationWidth(s, indentwidth); StreamDisciplines.GetIndentationWidth(s, indentwidth);
WHILE (indentwidth > 0) & Streams.WriteByte(s, " ") DO WHILE (indentwidth > 0) & Streams.WriteByte(s, " ") DO
@ -180,12 +180,12 @@ MODULE ulmWrite;
(* procedures writing to Streams.stdout *) (* procedures writing to Streams.stdout *)
PROCEDURE Int*(int: LONGINT; width: LONGINT); PROCEDURE Int*(int: Types.Int32; width: Types.Int32);
BEGIN BEGIN
IntS(Streams.stdout, int, width); IntS(Streams.stdout, int, width);
END Int; END Int;
PROCEDURE Real*(real: LONGREAL; width: LONGINT); PROCEDURE Real*(real: Types.Real64; width: Types.Int32);
(* write real in exponential format *) (* write real in exponential format *)
BEGIN BEGIN
RealS(Streams.stdout, real, width); RealS(Streams.stdout, real, width);

2
src/tools/make/oberon.mk
View file

@ -273,6 +273,7 @@ oocX11:
ulm: ulm:
@printf "\nMaking ulm library for -O$(MODEL)\n" @printf "\nMaking ulm library for -O$(MODEL)\n"
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmTypes.Mod
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmObjects.Mod cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmObjects.Mod
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmPriorities.Mod cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmPriorities.Mod
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmDisciplines.Mod cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmDisciplines.Mod
@ -284,7 +285,6 @@ ulm:
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmResources.Mod cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmResources.Mod
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmForwarders.Mod cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmForwarders.Mod
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmRelatedEvents.Mod cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmRelatedEvents.Mod
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmTypes.Mod
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmStreams.Mod cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmStreams.Mod
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmStrings.Mod cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmStrings.Mod
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysTypes.Mod cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysTypes.Mod