mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 22:42:24 +00:00
Update library source to V2.
This commit is contained in:
David Brown
parent
4245c6e8b3
commit
7bdc53145e
46 changed files with 3141 additions and 3349 deletions
|
|
@ -520,6 +520,7 @@ MODULE ulmConstStrings;
|
|||
| Streams.fromStart: realpos := cnt;
|
||||
| Streams.fromPos: realpos := s.pos + cnt;
|
||||
| Streams.fromEnd: realpos := s.string.length + cnt;
|
||||
ELSE
|
||||
END;
|
||||
IF (realpos < 0) OR (realpos > s.string.length) THEN
|
||||
RETURN FALSE
|
||||
|
|
|
|||
|
|
@ -375,6 +375,7 @@ MODULE ulmEvents;
|
|||
ptr := ptr.next;
|
||||
END;
|
||||
psys.currentPriority := oldPriority;
|
||||
ELSE (* Explicitly ignore unhandled even type reactions *)
|
||||
END;
|
||||
END CallHandlers;
|
||||
|
||||
|
|
|
|||
|
|
@ -647,6 +647,7 @@ MODULE ulmPersistentObjects;
|
|||
ELSE
|
||||
form := incrF;
|
||||
END;
|
||||
ELSE
|
||||
END;
|
||||
IF mode DIV 4 MOD 2 > 0 THEN
|
||||
INC(form, sizeF);
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -64,43 +64,43 @@ MODULE ulmResources;
|
|||
TYPE
|
||||
StateChange* = SHORTINT; (* terminated..communicationResumed *)
|
||||
State = SHORTINT; (* alive, unreferenced, or alive *)
|
||||
(* whether objects are stopped or not is maintained separately *)
|
||||
(* whether objects are stopped or not is maintained separately *)
|
||||
Event* = POINTER TO EventRec; (* notification of state changes *)
|
||||
EventRec* =
|
||||
RECORD
|
||||
(Events.EventRec)
|
||||
change*: StateChange; (* new state *)
|
||||
resource*: Resource;
|
||||
END;
|
||||
RECORD
|
||||
(Events.EventRec)
|
||||
change*: StateChange; (* new state *)
|
||||
resource*: Resource;
|
||||
END;
|
||||
|
||||
TYPE
|
||||
Key* = POINTER TO KeyRec;
|
||||
KeyRec* =
|
||||
RECORD
|
||||
(Objects.ObjectRec)
|
||||
valid: BOOLEAN;
|
||||
resource: Resource;
|
||||
END;
|
||||
RECORD
|
||||
(Objects.ObjectRec)
|
||||
valid: BOOLEAN;
|
||||
resource: Resource;
|
||||
END;
|
||||
|
||||
TYPE
|
||||
List = POINTER TO ListRec;
|
||||
ListRec =
|
||||
RECORD
|
||||
resource: Resource;
|
||||
next: List;
|
||||
END;
|
||||
RECORD
|
||||
resource: Resource;
|
||||
next: List;
|
||||
END;
|
||||
Discipline = POINTER TO DisciplineRec;
|
||||
DisciplineRec =
|
||||
RECORD
|
||||
(Disciplines.DisciplineRec)
|
||||
state: State; (* alive, unreferenced, or terminated *)
|
||||
stopped: BOOLEAN; (* may be TRUE, if alive or unreferenced *)
|
||||
refcnt: LONGINT; (* # of Attach - # of Detach *)
|
||||
eventType: Events.EventType; (* may be NIL *)
|
||||
dependants: List; (* list of resources which depends on us *)
|
||||
dependsOn: Resource; (* we depend on this resource *)
|
||||
key: Key; (* attach key for dependsOn *)
|
||||
END;
|
||||
RECORD
|
||||
(Disciplines.DisciplineRec)
|
||||
state: State; (* alive, unreferenced, or terminated *)
|
||||
stopped: BOOLEAN; (* may be TRUE, if alive or unreferenced *)
|
||||
refcnt: LONGINT; (* # of Attach - # of Detach *)
|
||||
eventType: Events.EventType; (* may be NIL *)
|
||||
dependants: List; (* list of resources which depends on us *)
|
||||
dependsOn: Resource; (* we depend on this resource *)
|
||||
key: Key; (* attach key for dependsOn *)
|
||||
END;
|
||||
VAR
|
||||
discID: Disciplines.Identifier;
|
||||
|
||||
|
|
@ -120,27 +120,27 @@ MODULE ulmResources;
|
|||
noch
|
||||
*)
|
||||
IF ~Disciplines.Seek(resource, discID, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN (* noch *)
|
||||
NEW(disc); disc.id := discID;
|
||||
disc.state := alive; disc.refcnt := 0;
|
||||
disc.eventType := NIL;
|
||||
disc.dependants := NIL; disc.dependsOn := NIL;
|
||||
Disciplines.Add(resource, disc);
|
||||
NEW(disc); disc.id := discID;
|
||||
disc.state := alive; disc.refcnt := 0;
|
||||
disc.eventType := NIL;
|
||||
disc.dependants := NIL; disc.dependsOn := NIL;
|
||||
Disciplines.Add(resource, disc);
|
||||
END;
|
||||
END GetDisc;
|
||||
|
||||
PROCEDURE GenEvent(resource: Resource; change: StateChange);
|
||||
VAR
|
||||
disc: Discipline;
|
||||
event: Event;
|
||||
disc: Discipline;
|
||||
event: Event;
|
||||
BEGIN
|
||||
GetDisc(resource, disc);
|
||||
IF disc.eventType # NIL THEN
|
||||
NEW(event);
|
||||
event.type := disc.eventType;
|
||||
event.message := "Resources: state change notification";
|
||||
event.change := change;
|
||||
event.resource := resource;
|
||||
Events.Raise(event);
|
||||
NEW(event);
|
||||
event.type := disc.eventType;
|
||||
event.message := "Resources: state change notification";
|
||||
event.change := change;
|
||||
event.resource := resource;
|
||||
Events.Raise(event);
|
||||
END;
|
||||
END GenEvent;
|
||||
|
||||
|
|
@ -149,24 +149,24 @@ MODULE ulmResources;
|
|||
PROCEDURE Unlink(dependant, resource: Resource);
|
||||
(* undo DependsOn operation *)
|
||||
VAR
|
||||
dependantDisc, resourceDisc: Discipline;
|
||||
prev, member: List;
|
||||
dependantDisc, resourceDisc: Discipline;
|
||||
prev, member: List;
|
||||
BEGIN
|
||||
GetDisc(resource, resourceDisc);
|
||||
IF resourceDisc.state = terminated THEN
|
||||
(* no necessity for clean up *)
|
||||
RETURN
|
||||
(* no necessity for clean up *)
|
||||
RETURN
|
||||
END;
|
||||
GetDisc(dependant, dependantDisc);
|
||||
|
||||
prev := NIL; member := resourceDisc.dependants;
|
||||
WHILE member.resource # dependant DO
|
||||
prev := member; member := member.next;
|
||||
prev := member; member := member.next;
|
||||
END;
|
||||
IF prev = NIL THEN
|
||||
resourceDisc.dependants := member.next;
|
||||
resourceDisc.dependants := member.next;
|
||||
ELSE
|
||||
prev.next := member.next;
|
||||
prev.next := member.next;
|
||||
END;
|
||||
|
||||
(* Detach reference from dependant to resource *)
|
||||
|
|
@ -176,28 +176,29 @@ MODULE ulmResources;
|
|||
|
||||
PROCEDURE InternalNotify(resource: Resource; change: StateChange);
|
||||
VAR
|
||||
disc: Discipline;
|
||||
event: Event;
|
||||
dependant: List;
|
||||
disc: Discipline;
|
||||
event: Event;
|
||||
dependant: List;
|
||||
BEGIN
|
||||
GetDisc(resource, disc);
|
||||
CASE change OF
|
||||
| communicationResumed: disc.stopped := FALSE;
|
||||
| communicationStopped: disc.stopped := TRUE;
|
||||
| terminated: disc.stopped := FALSE; disc.state := terminated;
|
||||
ELSE (* Explicitly ignore unhandled values of change *)
|
||||
END;
|
||||
GenEvent(resource, change);
|
||||
|
||||
(* notify all dependants *)
|
||||
dependant := disc.dependants;
|
||||
WHILE dependant # NIL DO
|
||||
InternalNotify(dependant.resource, change);
|
||||
dependant := dependant.next;
|
||||
InternalNotify(dependant.resource, change);
|
||||
dependant := dependant.next;
|
||||
END;
|
||||
|
||||
(* remove dependency relation in case of termination, if present *)
|
||||
IF (change = terminated) & (disc.dependsOn # NIL) THEN
|
||||
Unlink(resource, disc.dependsOn);
|
||||
Unlink(resource, disc.dependsOn);
|
||||
END;
|
||||
END InternalNotify;
|
||||
|
||||
|
|
@ -205,16 +206,16 @@ MODULE ulmResources;
|
|||
|
||||
PROCEDURE TakeInterest*(resource: Resource; VAR eventType: Events.EventType);
|
||||
(* return resource specific event type for state notifications;
|
||||
eventType is guaranteed to be # NIL even if
|
||||
the given resource is already terminated
|
||||
eventType is guaranteed to be # NIL even if
|
||||
the given resource is already terminated
|
||||
*)
|
||||
VAR
|
||||
disc: Discipline;
|
||||
disc: Discipline;
|
||||
BEGIN
|
||||
GetDisc(resource, disc);
|
||||
IF disc.eventType = NIL THEN
|
||||
Events.Define(disc.eventType);
|
||||
Events.Ignore(disc.eventType);
|
||||
Events.Define(disc.eventType);
|
||||
Events.Ignore(disc.eventType);
|
||||
END;
|
||||
eventType := disc.eventType;
|
||||
END TakeInterest;
|
||||
|
|
@ -222,93 +223,93 @@ MODULE ulmResources;
|
|||
PROCEDURE Attach*(resource: Resource; VAR key: Key);
|
||||
(* mark the resource as being used until Detach gets called *)
|
||||
VAR
|
||||
disc: Discipline;
|
||||
disc: Discipline;
|
||||
BEGIN
|
||||
GetDisc(resource, disc);
|
||||
IF disc.state IN {terminated, unreferenced} THEN
|
||||
key := NIL;
|
||||
key := NIL;
|
||||
ELSE
|
||||
INC(disc.refcnt); NEW(key); key.valid := TRUE;
|
||||
key.resource := resource;
|
||||
INC(disc.refcnt); NEW(key); key.valid := TRUE;
|
||||
key.resource := resource;
|
||||
END;
|
||||
END Attach;
|
||||
|
||||
PROCEDURE Detach*(resource: Resource; key: Key);
|
||||
(* mark the resource as unused; the returned key of Attach must
|
||||
be given -- this allows to check for proper balances
|
||||
of Attach/Detach calls;
|
||||
the last Detach operation causes a state change to unreferenced
|
||||
be given -- this allows to check for proper balances
|
||||
of Attach/Detach calls;
|
||||
the last Detach operation causes a state change to unreferenced
|
||||
*)
|
||||
VAR
|
||||
disc: Discipline;
|
||||
disc: Discipline;
|
||||
BEGIN
|
||||
IF (key # NIL) & key.valid & (key.resource = resource) THEN
|
||||
GetDisc(resource, disc);
|
||||
IF disc.state # terminated THEN
|
||||
key.valid := FALSE; DEC(disc.refcnt);
|
||||
IF disc.refcnt = 0 THEN
|
||||
GenEvent(resource, unreferenced);
|
||||
disc.state := unreferenced;
|
||||
IF disc.dependsOn # NIL THEN
|
||||
Unlink(resource, disc.dependsOn);
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
GetDisc(resource, disc);
|
||||
IF disc.state # terminated THEN
|
||||
key.valid := FALSE; DEC(disc.refcnt);
|
||||
IF disc.refcnt = 0 THEN
|
||||
GenEvent(resource, unreferenced);
|
||||
disc.state := unreferenced;
|
||||
IF disc.dependsOn # NIL THEN
|
||||
Unlink(resource, disc.dependsOn);
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END Detach;
|
||||
|
||||
PROCEDURE Notify*(resource: Resource; change: StateChange);
|
||||
(* notify all interested parties about the new state;
|
||||
only valid state changes are accepted:
|
||||
- Notify doesn't accept any changes after termination
|
||||
- unreferenced is generated conditionally by Detach only
|
||||
- communicationResumed is valid after communicationStopped only
|
||||
valid notifications are propagated to all dependants (see below);
|
||||
only valid state changes are accepted:
|
||||
- Notify doesn't accept any changes after termination
|
||||
- unreferenced is generated conditionally by Detach only
|
||||
- communicationResumed is valid after communicationStopped only
|
||||
valid notifications are propagated to all dependants (see below);
|
||||
*)
|
||||
VAR
|
||||
disc: Discipline;
|
||||
event: Event;
|
||||
dependant: List;
|
||||
disc: Discipline;
|
||||
event: Event;
|
||||
dependant: List;
|
||||
BEGIN
|
||||
IF change # unreferenced THEN
|
||||
GetDisc(resource, disc);
|
||||
IF (disc.state # terminated) & (disc.state # change) &
|
||||
((change # communicationResumed) OR disc.stopped) THEN
|
||||
InternalNotify(resource, change);
|
||||
END;
|
||||
GetDisc(resource, disc);
|
||||
IF (disc.state # terminated) & (disc.state # change) &
|
||||
((change # communicationResumed) OR disc.stopped) THEN
|
||||
InternalNotify(resource, change);
|
||||
END;
|
||||
END;
|
||||
END Notify;
|
||||
|
||||
PROCEDURE DependsOn*(dependant, resource: Resource);
|
||||
(* states that `dependant' depends entirely on `resource' --
|
||||
this is usually the case if operations on `dependant'
|
||||
are delegated to `resource';
|
||||
only one call of DependsOn may be given per `dependant' while
|
||||
several DependsOn for one resource are valid;
|
||||
DependsOn calls implicitly Attach for resource and
|
||||
detaches if the dependant becomes unreferenced;
|
||||
all other state changes propagate from `resource' to
|
||||
`dependant'
|
||||
this is usually the case if operations on `dependant'
|
||||
are delegated to `resource';
|
||||
only one call of DependsOn may be given per `dependant' while
|
||||
several DependsOn for one resource are valid;
|
||||
DependsOn calls implicitly Attach for resource and
|
||||
detaches if the dependant becomes unreferenced;
|
||||
all other state changes propagate from `resource' to
|
||||
`dependant'
|
||||
*)
|
||||
VAR
|
||||
dependantDisc, resourceDisc: Discipline;
|
||||
member: List;
|
||||
dependantDisc, resourceDisc: Discipline;
|
||||
member: List;
|
||||
BEGIN
|
||||
GetDisc(resource, resourceDisc);
|
||||
IF resourceDisc.state <= unreferenced THEN
|
||||
(* do not create a relationship to dead or unreferenced objects
|
||||
but propagate a termination immediately to dependant
|
||||
*)
|
||||
IF resourceDisc.state = terminated THEN
|
||||
Notify(dependant, resourceDisc.state);
|
||||
END;
|
||||
RETURN
|
||||
(* do not create a relationship to dead or unreferenced objects
|
||||
but propagate a termination immediately to dependant
|
||||
*)
|
||||
IF resourceDisc.state = terminated THEN
|
||||
Notify(dependant, resourceDisc.state);
|
||||
END;
|
||||
RETURN
|
||||
END;
|
||||
|
||||
GetDisc(dependant, dependantDisc);
|
||||
IF dependantDisc.dependsOn # NIL THEN
|
||||
(* don't accept changes *)
|
||||
RETURN
|
||||
(* don't accept changes *)
|
||||
RETURN
|
||||
END;
|
||||
dependantDisc.dependsOn := resource;
|
||||
|
||||
|
|
@ -320,10 +321,10 @@ MODULE ulmResources;
|
|||
|
||||
PROCEDURE Alive*(resource: Resource) : BOOLEAN;
|
||||
(* returns TRUE if the resource is not yet terminated
|
||||
and ready for communication (i.e. not communicationStopped)
|
||||
and ready for communication (i.e. not communicationStopped)
|
||||
*)
|
||||
VAR
|
||||
disc: Discipline;
|
||||
disc: Discipline;
|
||||
BEGIN
|
||||
GetDisc(resource, disc);
|
||||
RETURN ~disc.stopped & (disc.state IN {alive, unreferenced})
|
||||
|
|
@ -331,10 +332,10 @@ MODULE ulmResources;
|
|||
|
||||
PROCEDURE Stopped*(resource: Resource) : BOOLEAN;
|
||||
(* returns TRUE if the object is currently not responsive
|
||||
and not yet terminated
|
||||
and not yet terminated
|
||||
*)
|
||||
VAR
|
||||
disc: Discipline;
|
||||
disc: Discipline;
|
||||
BEGIN
|
||||
GetDisc(resource, disc);
|
||||
RETURN disc.stopped
|
||||
|
|
@ -343,7 +344,7 @@ MODULE ulmResources;
|
|||
PROCEDURE Terminated*(resource: Resource) : BOOLEAN;
|
||||
(* returns TRUE if the resource is terminated *)
|
||||
VAR
|
||||
disc: Discipline;
|
||||
disc: Discipline;
|
||||
BEGIN
|
||||
GetDisc(resource, disc);
|
||||
RETURN disc.state = terminated
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
MODULE ulmSYSTEM;
|
||||
IMPORT SYSTEM, Unix, Sys := ulmSys;
|
||||
IMPORT SYSTEM, Platform, Sys := ulmSys;
|
||||
|
||||
TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
|
||||
pstring = POINTER TO ARRAY 1024 OF CHAR;
|
||||
pstatus = POINTER TO Unix.Status;
|
||||
(* pstatus = POINTER TO Platform.Status; *)
|
||||
|
||||
TYPE bytearray* = ARRAY SIZE(LONGINT) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *)
|
||||
pbytearray* = POINTER TO bytearray;
|
||||
|
|
@ -52,16 +52,16 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
|
|||
PROCEDURE UNIXCALL*(syscall: LONGINT; VAR d0, d1: LONGINT; (* in ulm version both LONGINT and INTEGER are 4 byte size *)
|
||||
arg1, arg2, arg3: LONGINT) : BOOLEAN;
|
||||
VAR
|
||||
n : LONGINT;
|
||||
ch : CHAR;
|
||||
pch : pchar;
|
||||
pstr : pstring;
|
||||
pst : pstatus;
|
||||
n: LONGINT;
|
||||
ch: CHAR;
|
||||
pch: pchar;
|
||||
pstr: pstring;
|
||||
h: Platform.FileHandle;
|
||||
(* pst : pstatus; *)
|
||||
BEGIN
|
||||
|
||||
IF syscall = Sys.read THEN
|
||||
d0 := Unix.Read(SHORT(arg1), arg2, arg3);
|
||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
||||
RETURN Platform.Read(arg1, arg2, arg3, n) = 0;
|
||||
(*NEW(pch);
|
||||
pch := SYSTEM.VAL(pchar, arg2);
|
||||
ch := pch^[0];
|
||||
|
|
@ -75,44 +75,48 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
|
|||
END;
|
||||
*)
|
||||
ELSIF syscall = Sys.write THEN
|
||||
d0 := Unix.Write(SHORT(arg1), arg2, arg3);
|
||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
||||
RETURN Platform.Write(arg1, arg2, arg3) = 0;
|
||||
(*NEW(pch);
|
||||
pch := SYSTEM.VAL(pchar, arg2);
|
||||
n := Write(SYSTEM.VAL(LONGINT, pch), 1);
|
||||
IF n # 1 THEN RETURN FALSE ELSE RETURN TRUE END
|
||||
*)
|
||||
ELSIF syscall = Sys.open THEN
|
||||
pstr := SYSTEM.VAL(pstring, arg1);
|
||||
d0 := Unix.Open(pstr^, SHORT(arg3), arg2);
|
||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
||||
pstr := SYSTEM.VAL(pstring, arg1);
|
||||
IF SYSTEM.VAL(SET, arg3) * {0,1} # {} THEN
|
||||
RETURN Platform.OldRW(pstr^, d0) = 0
|
||||
ELSE
|
||||
RETURN Platform.OldRO(pstr^, d0) = 0
|
||||
END
|
||||
ELSIF syscall = Sys.close THEN
|
||||
d0 := Unix.Close(SHORT(arg1));
|
||||
IF d0 = 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
||||
RETURN Platform.Close(arg1) = 0
|
||||
ELSIF syscall = Sys.lseek THEN
|
||||
d0 := Unix.Lseek(SHORT(arg1), arg2, SHORT(arg3));
|
||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
||||
RETURN Platform.Seek(arg1, arg2, SYSTEM.VAL(INTEGER, arg3)) = 0
|
||||
(*
|
||||
ELSIF syscall = Sys.ioctl THEN
|
||||
d0 := Unix.Ioctl(SHORT(arg1), SHORT(arg2), arg3);
|
||||
d0 := Platform.Ioctl(arg1, arg2, arg3);
|
||||
RETURN d0 >= 0;
|
||||
ELSIF syscall = Sys.fcntl THEN
|
||||
d0 := Unix.Fcntl (SHORT(arg1), SHORT(arg2), arg3);
|
||||
d0 := Platform.Fcntl (arg1, arg2, arg3);
|
||||
RETURN d0 >= 0;
|
||||
ELSIF syscall = Sys.dup THEN
|
||||
d0 := Unix.Dup(SHORT(arg1));
|
||||
d0 := Platform.Dup(arg1);
|
||||
RETURN d0 > 0;
|
||||
ELSIF syscall = Sys.pipe THEN
|
||||
d0 := Unix.Pipe(arg1);
|
||||
d0 := Platform.Pipe(arg1);
|
||||
RETURN d0 >= 0;
|
||||
ELSIF syscall = Sys.newstat THEN
|
||||
pst := SYSTEM.VAL(pstatus, arg2);
|
||||
pstr := SYSTEM.VAL(pstring, arg1);
|
||||
d0 := Unix.Stat(pstr^, pst^);
|
||||
d0 := Platform.Stat(pstr^, pst^);
|
||||
RETURN d0 >= 0
|
||||
ELSIF syscall = Sys.newfstat THEN
|
||||
pst := SYSTEM.VAL(pstatus, arg2);
|
||||
d0 := Unix.Fstat(SHORT(arg1), pst^);
|
||||
d0 := Platform.Fstat(arg1, pst^);
|
||||
RETURN d0 >= 0;
|
||||
*)
|
||||
ELSE
|
||||
HALT(99);
|
||||
END
|
||||
|
||||
END UNIXCALL;
|
||||
|
|
|
|||
|
|
@ -403,6 +403,7 @@ MODULE ulmScales;
|
|||
(* abs - abs or rel - rel *)
|
||||
restype := relative;
|
||||
END;
|
||||
ELSE
|
||||
END;
|
||||
ASSERT(ok); (* invalid operation *)
|
||||
END; END;
|
||||
|
|
|
|||
|
|
@ -115,6 +115,7 @@ MODULE ulmStreamConditions;
|
|||
| write: IF Streams.OutputWillBeBuffered(condition.stream) THEN
|
||||
RETURN TRUE
|
||||
END;
|
||||
ELSE
|
||||
END;
|
||||
msg.operation := condition.operation;
|
||||
msg.errors := errors;
|
||||
|
|
|
|||
|
|
@ -632,6 +632,7 @@ MODULE ulmStreams;
|
|||
| linebuf: nbuf := 1;
|
||||
| onebuf: nbuf := 1;
|
||||
| bufpool: nbuf := s.bufpool.maxbuf;
|
||||
ELSE (* Explicitly ignore unhandled values of s.bufmode *)
|
||||
END;
|
||||
END GetBufferPoolSize;
|
||||
|
||||
|
|
|
|||
|
|
@ -336,17 +336,17 @@ MODULE ulmSysConversions;
|
|||
|
||||
(* C type *)
|
||||
CASE type2 OF
|
||||
| "a": size2 := 8; INCL(flags, unsigned); (* char* *)
|
||||
| "c": size2 := 1; (* /* signed */ char *)
|
||||
| "C": size2 := 1; INCL(flags, unsigned); (* unsigned char *)
|
||||
| "s": size2 := 2; (* short int *)
|
||||
| "S": size2 := 2; INCL(flags, unsigned); (* unsigned short int *)
|
||||
| "i": size2 := 4; (* int *)
|
||||
| "I": size2 := 4; INCL(flags, unsigned); (* unsigned int *)
|
||||
| "u": size2 := 4; INCL(flags, unsigned); (* unsigned int *)
|
||||
| "l": size2 := 8; (* long int *)
|
||||
| "L": size2 := 8; INCL(flags, unsigned); (* long int *)
|
||||
| "-": size2 := 0;
|
||||
| "a": size2 := SIZE(Address); INCL(flags, unsigned); (* char* *)
|
||||
| "c": size2 := 1; (* /* signed */ char *)
|
||||
| "C": size2 := 1; INCL(flags, unsigned); (* unsigned char *)
|
||||
| "s": size2 := 2; (* short int *)
|
||||
| "S": size2 := 2; INCL(flags, unsigned); (* unsigned short int *)
|
||||
| "i": size2 := 4; (* int *)
|
||||
| "I": size2 := 4; INCL(flags, unsigned); (* unsigned int *)
|
||||
| "u": size2 := 4; INCL(flags, unsigned); (* unsigned int *)
|
||||
| "l": size2 := 8; (* long int *)
|
||||
| "L": size2 := 8; INCL(flags, unsigned); (* long int *)
|
||||
| "-": size2 := 0;
|
||||
ELSE Error(cv, "bad C type specifier"); RETURN FALSE
|
||||
END;
|
||||
IF size2 > 1 THEN
|
||||
|
|
|
|||
|
|
@ -59,14 +59,14 @@ MODULE ulmSysIO;
|
|||
closeonexec* = { 0 };
|
||||
|
||||
(* Fcntl requests *)
|
||||
dupfd* = 0; (* duplicate file descriptor *)
|
||||
getfd* = 1; (* get file desc flags (close-on-exec) *)
|
||||
setfd* = 2; (* set file desc flags (close-on-exec) *)
|
||||
getfl* = 3; (* get file flags *)
|
||||
setfl* = 4; (* set file flags (ndelay, append) *)
|
||||
getlk* = 5; (* get file lock *)
|
||||
setlk* = 6; (* set file lock *)
|
||||
setlkw* = 7; (* set file lock and wait *)
|
||||
dupfd* = 0; (* duplicate file descriptor *)
|
||||
getfd* = 1; (* get file desc flags (close-on-exec) *)
|
||||
setfd* = 2; (* set file desc flags (close-on-exec) *)
|
||||
getfl* = 3; (* get file flags *)
|
||||
setfl* = 4; (* set file flags (ndelay, append) *)
|
||||
getlk* = 5; (* get file lock *)
|
||||
setlk* = 6; (* set file lock *)
|
||||
setlkw* = 7; (* set file lock and wait *)
|
||||
setown* = 8; (* set owner (async IO) *)
|
||||
getown* = 9; (* get owner (async IO) *)
|
||||
setsig* = 10; (* set SIGIO replacement *)
|
||||
|
|
@ -80,263 +80,267 @@ MODULE ulmSysIO;
|
|||
Whence* = LONGINT;
|
||||
|
||||
PROCEDURE OpenCreat*(VAR fd: File;
|
||||
filename: ARRAY OF CHAR; options: SET;
|
||||
protection: Protection;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
filename: ARRAY OF CHAR; options: SET;
|
||||
protection: Protection;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
(* the filename must be 0X-terminated *)
|
||||
VAR
|
||||
d0, d1: (*INTEGER*)LONGINT;
|
||||
d0, d1: (*INTEGER*)LONGINT;
|
||||
BEGIN
|
||||
interrupted := FALSE;
|
||||
LOOP
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.open, d0, d1,
|
||||
SYS.ADR(filename), SYS.VAL(LONGINT, options), protection) THEN
|
||||
fd := d0;
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.open, filename);
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.open, d0, d1,
|
||||
SYS.ADR(filename), SYS.VAL(LONGINT, options), protection) THEN
|
||||
fd := d0;
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.open, filename);
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END OpenCreat;
|
||||
|
||||
PROCEDURE Open*(VAR fd: File;
|
||||
filename: ARRAY OF CHAR; options: SET;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
filename: ARRAY OF CHAR; options: SET;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
(* the filename must be 0X-terminated *)
|
||||
BEGIN
|
||||
RETURN OpenCreat(fd, filename, options, 0, errors, retry, interrupted)
|
||||
END Open;
|
||||
|
||||
PROCEDURE Close*(fd: File;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
a0, a1 : LONGINT; (* just to match UNIXCALL interface *)
|
||||
d0, d1: LONGINT;
|
||||
a0, a1 : LONGINT; (* just to match UNIXCALL interface *)
|
||||
BEGIN
|
||||
interrupted := FALSE;
|
||||
a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
|
||||
LOOP
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.close, d0, d1, fd, a0, a1) THEN
|
||||
(*IF ulmSYSTEM.UNIXCALL(Sys.close, d0, d1, fd) THEN*)
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.close, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.close, d0, d1, fd, a0, a1) THEN
|
||||
(*IF ulmSYSTEM.UNIXCALL(Sys.close, d0, d1, fd) THEN*)
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.close, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END Close;
|
||||
|
||||
PROCEDURE Read*(fd: File; buf: Address; cnt: Count;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : Count;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : Count;
|
||||
(* return value of 0: EOF
|
||||
-1: I/O error
|
||||
>0: number of bytes read
|
||||
-1: I/O error
|
||||
>0: number of bytes read
|
||||
*)
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
BEGIN
|
||||
interrupted := FALSE;
|
||||
LOOP
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.read, d0, d1, fd, buf, cnt) THEN
|
||||
RETURN d0
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.read, "");
|
||||
RETURN -1
|
||||
END;
|
||||
END;
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.read, d0, d1, fd, buf, cnt) THEN
|
||||
RETURN d0
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.read, "");
|
||||
RETURN -1
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END Read;
|
||||
|
||||
PROCEDURE Write*(fd: File; buf: Address; cnt: Count;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : Count;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : Count;
|
||||
(* return value of -1: I/O error
|
||||
>=0: number of bytes written
|
||||
>=0: number of bytes written
|
||||
*)
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
BEGIN
|
||||
interrupted := FALSE;
|
||||
LOOP
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.write, d0, d1, fd, buf, cnt) THEN
|
||||
RETURN d0
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.write, "");
|
||||
RETURN -1
|
||||
END;
|
||||
END;
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.write, d0, d1, fd, buf, cnt) THEN
|
||||
RETURN d0
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.write, "");
|
||||
RETURN -1
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END Write;
|
||||
|
||||
PROCEDURE Seek*(fd: File; offset: Count; whence: Whence;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
BEGIN
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.lseek, d0, d1, fd, offset, whence) THEN
|
||||
RETURN TRUE
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.lseek, "");
|
||||
RETURN FALSE
|
||||
SysErrors.Raise(errors, d0, Sys.lseek, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END Seek;
|
||||
|
||||
PROCEDURE Tell*(fd: File; VAR offset: Count;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
BEGIN
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.lseek, d0, d1, fd, 0, fromPos) THEN
|
||||
offset := d0;
|
||||
RETURN TRUE
|
||||
offset := d0;
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.lseek, "");
|
||||
RETURN FALSE
|
||||
SysErrors.Raise(errors, d0, Sys.lseek, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END Tell;
|
||||
|
||||
PROCEDURE Isatty*(fd: File) : BOOLEAN;
|
||||
CONST
|
||||
sizeofStructTermIO = 18;
|
||||
tcgeta = 00005405H;
|
||||
sizeofStructTermIO = 18;
|
||||
tcgeta = 00005405H;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
buf: ARRAY 32 OF SYS.BYTE; (* Should be more than sufficient *)
|
||||
d0, d1: LONGINT;
|
||||
buf: ARRAY 32 OF SYS.BYTE; (* Should be more than sufficient *)
|
||||
BEGIN
|
||||
(* following system call fails for non-tty's *)
|
||||
RETURN ulmSYSTEM.UNIXCALL(Sys.ioctl, d0, d1, fd, tcgeta, SYS.ADR(buf))
|
||||
END Isatty;
|
||||
|
||||
PROCEDURE Fcntl*(fd: File; request: INTEGER; VAR arg: LONGINT;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
BEGIN
|
||||
interrupted := FALSE;
|
||||
LOOP
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, arg) THEN
|
||||
arg := d0;
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.fcntl, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, arg) THEN
|
||||
arg := d0;
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.fcntl, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END Fcntl;
|
||||
|
||||
PROCEDURE FcntlSet*(fd: File; request: INTEGER; flags: SET;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
BEGIN
|
||||
interrupted := FALSE;
|
||||
LOOP
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, SYS.VAL(LONGINT, flags)) THEN
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.fcntl, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, SYS.VAL(LONGINT, flags)) THEN
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.fcntl, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END FcntlSet;
|
||||
|
||||
PROCEDURE FcntlGet*(fd: File; request: INTEGER; VAR flags: SET;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
BEGIN
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, 0) THEN
|
||||
ulmSYSTEM.WMOVE(SYS.ADR(d0), SYS.ADR(flags), 1);
|
||||
RETURN TRUE
|
||||
ulmSYSTEM.WMOVE(SYS.ADR(d0), SYS.ADR(flags), 1);
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.fcntl, "");
|
||||
RETURN FALSE
|
||||
SysErrors.Raise(errors, d0, Sys.fcntl, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END FcntlGet;
|
||||
|
||||
PROCEDURE Dup*(fd: File; VAR newfd: File;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
a0, a1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
a0, a1: LONGINT;
|
||||
BEGIN
|
||||
a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.dup, d0, d1, fd, a0, a1) THEN
|
||||
newfd := d0;
|
||||
RETURN TRUE
|
||||
newfd := d0;
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.dup, "");
|
||||
RETURN FALSE
|
||||
SysErrors.Raise(errors, d0, Sys.dup, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END Dup;
|
||||
|
||||
PROCEDURE Dup2*(fd, newfd: File; errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
a0, a1: LONGINT;
|
||||
fd2: File;
|
||||
interrupted: BOOLEAN;
|
||||
d0, d1: LONGINT;
|
||||
a0, a1: LONGINT;
|
||||
fd2: File;
|
||||
interrupted: BOOLEAN;
|
||||
BEGIN
|
||||
a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
|
||||
fd2 := newfd;
|
||||
(* handmade close to avoid unnecessary events *)
|
||||
IF ~ulmSYSTEM.UNIXCALL(Sys.close, d0, d1, newfd, a0, a1) THEN END;
|
||||
IF Fcntl(fd, dupfd, fd2, errors, TRUE, interrupted) THEN
|
||||
IF fd2 = newfd THEN
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
RETURN Close(fd2, errors, TRUE, interrupted) & FALSE
|
||||
END;
|
||||
IF fd2 = newfd THEN
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
RETURN Close(fd2, errors, TRUE, interrupted) & FALSE
|
||||
END;
|
||||
ELSE
|
||||
RETURN FALSE
|
||||
RETURN FALSE
|
||||
END;
|
||||
END Dup2;
|
||||
|
||||
PROCEDURE Pipe*(VAR readfd, writefd: File;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
a0, a1: LONGINT;
|
||||
fds : ARRAY 2 OF (*File*)INTEGER; (* it needs int pipefd[2], and int is 4 bytes long on x86_64 -- noch *)
|
||||
d0, d1: LONGINT;
|
||||
a0, a1: LONGINT;
|
||||
fds : ARRAY 2 OF (*File*)INTEGER; (* it needs int pipefd[2], and int is 4 bytes long on x86_64 -- noch *)
|
||||
BEGIN
|
||||
a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.pipe, d0, d1, SYS.ADR (fds), a0, a1) THEN
|
||||
readfd := fds[0]; writefd := fds[1];
|
||||
RETURN TRUE
|
||||
readfd := fds[0]; writefd := fds[1];
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.pipe, "");
|
||||
RETURN FALSE
|
||||
SysErrors.Raise(errors, d0, Sys.pipe, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END Pipe;
|
||||
|
||||
|
|
|
|||
|
|
@ -45,42 +45,42 @@ MODULE ulmSysStat;
|
|||
CONST
|
||||
(* file mode:
|
||||
bit 0 = 1<<0 bit 31 = 1<<31
|
||||
|
||||
|
||||
user group other
|
||||
3 1 1111 11
|
||||
1 ... 6 5432 109 876 543 210
|
||||
+--------+------+-----+-----+-----+-----+
|
||||
| unused | type | sst | rwx | rwx | rwx |
|
||||
+--------+------+-----+-----+-----+-----+
|
||||
+--------+------+-----+-----+-----+-----+
|
||||
| unused | type | sst | rwx | rwx | rwx |
|
||||
+--------+------+-----+-----+-----+-----+
|
||||
*)
|
||||
|
||||
type* = {12..15};
|
||||
prot* = {0..8};
|
||||
|
||||
(* file types; example: (stat.mode * type = dir) *)
|
||||
reg* = {15}; (* regular *)
|
||||
dir* = {14}; (* directory *)
|
||||
chr* = {13}; (* character special *)
|
||||
fifo* = {12}; (* fifo *)
|
||||
blk* = {13..14}; (* block special *)
|
||||
symlink* = {13, 15}; (* symbolic link *)
|
||||
socket* = {14, 15}; (* socket *)
|
||||
reg* = {15}; (* regular *)
|
||||
dir* = {14}; (* directory *)
|
||||
chr* = {13}; (* character special *)
|
||||
fifo* = {12}; (* fifo *)
|
||||
blk* = {13..14}; (* block special *)
|
||||
symlink* = {13, 15}; (* symbolic link *)
|
||||
socket* = {14, 15}; (* socket *)
|
||||
|
||||
(* special *)
|
||||
setuid* = 11; (* set user id on execution *)
|
||||
setgid* = 10; (* set group id on execution *)
|
||||
savetext* = 9; (* save swapped text even after use *)
|
||||
setuid* = 11; (* set user id on execution *)
|
||||
setgid* = 10; (* set group id on execution *)
|
||||
savetext* = 9; (* save swapped text even after use *)
|
||||
|
||||
(* protection *)
|
||||
uread* = 8; (* read permission owner *)
|
||||
uwrite* = 7; (* write permission owner *)
|
||||
uexec* = 6; (* execute/search permission owner *)
|
||||
gread* = 5; (* read permission group *)
|
||||
gwrite* = 4; (* write permission group *)
|
||||
gexec* = 3; (* execute/search permission group *)
|
||||
oread* = 2; (* read permission other *)
|
||||
owrite* = 1; (* write permission other *)
|
||||
oexec* = 0; (* execute/search permission other *)
|
||||
uread* = 8; (* read permission owner *)
|
||||
uwrite* = 7; (* write permission owner *)
|
||||
uexec* = 6; (* execute/search permission owner *)
|
||||
gread* = 5; (* read permission group *)
|
||||
gwrite* = 4; (* write permission group *)
|
||||
gexec* = 3; (* execute/search permission group *)
|
||||
oread* = 2; (* read permission other *)
|
||||
owrite* = 1; (* write permission other *)
|
||||
oexec* = 0; (* execute/search permission other *)
|
||||
|
||||
(* example for "r-xr-x---": (read + exec) * (owner + group) *)
|
||||
owner* = {uread, uwrite, uexec};
|
||||
|
|
@ -92,136 +92,98 @@ MODULE ulmSysStat;
|
|||
rwx* = prot;
|
||||
|
||||
TYPE
|
||||
StatRec* = (* result of stat(2) and fstat(2) *)
|
||||
RECORD
|
||||
device*: SysTypes.Device; (* ID of device containing
|
||||
a directory entry for this file *)
|
||||
inode*: SysTypes.Inode; (* inode number *)
|
||||
nlinks*: LONGINT(*INTEGER*); (* number of links *)
|
||||
mode*: SET; (* file mode; see mknod(2) *)
|
||||
uid*: INTEGER; (* user id of the file's owner *)
|
||||
gid*: INTEGER; (* group id of the file's group *)
|
||||
rdev*: SysTypes.Device; (* ID of device
|
||||
this entry is defined only for
|
||||
character special or block
|
||||
special files
|
||||
*)
|
||||
size*: SysTypes.Offset; (* file size in bytes *)
|
||||
blksize*: LONGINT; (* preferred blocksize *)
|
||||
blocks*: LONGINT; (* # of blocks allocated *)
|
||||
atime*: SysTypes.Time; (* time of last access *)
|
||||
mtime*: SysTypes.Time; (* time of last data modification *)
|
||||
ctime*: SysTypes.Time; (* time of last file status change *)
|
||||
END;
|
||||
StatRec* = RECORD (* result of stat(2) and fstat(2) *)
|
||||
device*: SysTypes.Device; (* ID of device containing a directory entry
|
||||
for this file *)
|
||||
inode*: SysTypes.Inode; (* inode number *)
|
||||
mode*: SET; (* file mode; see mknod(2) *)
|
||||
nlinks*: LONGINT; (* number of links *)
|
||||
uid*: LONGINT; (* user id of the file's owner *)
|
||||
gid*: LONGINT; (* group id of the file's group *)
|
||||
rdev*: SysTypes.Device; (* ID of device. this entry is defined only for
|
||||
character special or block special files *)
|
||||
size*: SysTypes.Offset; (* file size in bytes *)
|
||||
|
||||
(* Blocks and blksize are not available on all platforms.
|
||||
blksize*: LONGINT; (* preferred blocksize *)
|
||||
blocks*: LONGINT; (* # of blocks allocated *)
|
||||
*)
|
||||
|
||||
atime*: SysTypes.Time; (* time of last access *)
|
||||
mtime*: SysTypes.Time; (* time of last data modification *)
|
||||
ctime*: SysTypes.Time; (* time of last file status change *)
|
||||
END;
|
||||
|
||||
(* StatRec* = (* result of stat(2) and fstat(2) *)
|
||||
RECORD
|
||||
device*: SysTypes.Device; (* ID of device containing
|
||||
a directory entry for this file *)
|
||||
inode*: SysTypes.Inode; (* inode number *)
|
||||
nlinks*: LONGINT; (* number of links *)
|
||||
mode*: INTEGER(*SET*); (* file mode; see mknod(2) *)
|
||||
uid*: INTEGER; (* user id of the file's owner *)
|
||||
gid*: INTEGER; (* group id of the file's group *)
|
||||
pad0: INTEGER;
|
||||
rdev*: SysTypes.Device; (* ID of device
|
||||
this entry is defined only for
|
||||
character special or block
|
||||
special files
|
||||
*)
|
||||
size*: SysTypes.Offset; (* file size in bytes *)
|
||||
blksize*: LONGINT; (* preferred blocksize *)
|
||||
blocks*: LONGINT; (* # of blocks allocated *)
|
||||
atime*: SysTypes.Time; (* time of last access *)
|
||||
atimences* : LONGINT;
|
||||
mtime*: SysTypes.Time; (* time of last data modification *)
|
||||
mtimensec* : LONGINT;
|
||||
ctime*: SysTypes.Time; (* time of last file status change *)
|
||||
ctimensec* : LONGINT;
|
||||
unused0*, unused1*, unused2*: LONGINT;
|
||||
END;
|
||||
*)
|
||||
(* Linux kernel struct stat (2.2.17)
|
||||
struct stat {
|
||||
unsigned short st_dev;
|
||||
unsigned short __pad1;
|
||||
unsigned long st_ino;
|
||||
unsigned short st_mode;
|
||||
unsigned short st_nlink;
|
||||
unsigned short st_uid;
|
||||
unsigned short st_gid;
|
||||
unsigned short st_rdev;
|
||||
unsigned short __pad2;
|
||||
unsigned long st_size;
|
||||
unsigned long st_blksize;
|
||||
unsigned long st_blocks;
|
||||
unsigned long st_atime;
|
||||
unsigned long __unused1;
|
||||
unsigned long st_mtime;
|
||||
unsigned long __unused2;
|
||||
unsigned long st_ctime;
|
||||
unsigned long __unused3;
|
||||
unsigned long __unused4;
|
||||
unsigned long __unused5;
|
||||
};
|
||||
*)
|
||||
|
||||
CONST
|
||||
statbufsize = 144(*64*); (* see <sys/stat.h> *) (* sizeof struct stat gives us 144 on x86_64 and 88 or x86; -- noch *)
|
||||
TYPE
|
||||
UnixStatRec = ARRAY statbufsize OF SYS.BYTE;
|
||||
CONST
|
||||
statbufconv =
|
||||
(*"is=dev/-s=pad1/ll=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/ll=size/2*ll=blksize,blocks/il=atime/-l/il=mtime/-l/il=ctime/3*-l";*)
|
||||
"lL=dev/lL=ino/lL=nlink/Su=mode/2*iu=uid+gid/-i=pad0/lL=rdev/ll=size/2*ll=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l"; (* noch *)
|
||||
VAR
|
||||
statbuffmt: SysConversions.Format;
|
||||
PROCEDURE -Aincludesysstat '#include <sys/stat.h>';
|
||||
PROCEDURE -Aerrno '#include <errno.h>';
|
||||
|
||||
PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1, d2: LONGINT;
|
||||
origbuf: UnixStatRec;
|
||||
PROCEDURE -structstats "struct stat s";
|
||||
PROCEDURE -statdev(): LONGINT "(LONGINT)s.st_dev";
|
||||
PROCEDURE -statino(): LONGINT "(LONGINT)s.st_ino";
|
||||
PROCEDURE -statmode(): LONGINT "(LONGINT)s.st_mode";
|
||||
PROCEDURE -statnlink(): LONGINT "(LONGINT)s.st_nlink";
|
||||
PROCEDURE -statuid(): LONGINT "(LONGINT)s.st_uid";
|
||||
PROCEDURE -statgid(): LONGINT "(LONGINT)s.st_gid";
|
||||
PROCEDURE -statrdev(): LONGINT "(LONGINT)s.st_rdev";
|
||||
PROCEDURE -statsize(): LONGINT "(LONGINT)s.st_size";
|
||||
PROCEDURE -statatime(): LONGINT "(LONGINT)s.st_atime";
|
||||
PROCEDURE -statmtime(): LONGINT "(LONGINT)s.st_mtime";
|
||||
PROCEDURE -statctime(): LONGINT "(LONGINT)s.st_ctime";
|
||||
|
||||
(* Blocks and blksize are not available on all platforms.
|
||||
PROCEDURE -statblksize(): LONGINT "(LONGINT)s.st_blksize";
|
||||
PROCEDURE -statblocks(): LONGINT "(LONGINT)s.st_blocks";
|
||||
*)
|
||||
|
||||
PROCEDURE -fstat(fd: LONGINT): INTEGER "fstat(fd, &s)";
|
||||
PROCEDURE -stat (n: ARRAY OF CHAR): INTEGER "stat((char*)n, &s)";
|
||||
|
||||
PROCEDURE -err(): INTEGER "errno";
|
||||
|
||||
PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec; errors: RelatedEvents.Object): BOOLEAN;
|
||||
BEGIN
|
||||
IF uSYS.UNIXCALL(Sys.newstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf), d2) THEN
|
||||
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.newstat, path);
|
||||
RETURN FALSE
|
||||
END;
|
||||
structstats;
|
||||
IF stat(path) < 0 THEN SysErrors.Raise(errors, err(), Sys.newstat, path); RETURN FALSE END;
|
||||
buf.device := SYS.VAL(SysTypes.Device, statdev());
|
||||
buf.inode := SYS.VAL(SysTypes.Inode, statino());
|
||||
buf.mode := SYS.VAL(SET, statmode());
|
||||
buf.nlinks := statnlink();
|
||||
buf.uid := statuid();
|
||||
buf.gid := statgid();
|
||||
buf.rdev := SYS.VAL(SysTypes.Device, statrdev());
|
||||
buf.size := SYS.VAL(SysTypes.Offset, statsize());
|
||||
(* Blocks and blksize are not available on all platforms.
|
||||
buf.blksize := statblksize();
|
||||
buf.blocks := statblocks();
|
||||
*)
|
||||
buf.atime := SYS.VAL(SysTypes.Time, statatime());
|
||||
buf.mtime := SYS.VAL(SysTypes.Time, statmtime());
|
||||
buf.ctime := SYS.VAL(SysTypes.Time, statctime());
|
||||
RETURN TRUE;
|
||||
END Stat;
|
||||
(* commented temporarily, it is used only in FTPUnixDirLister module *) (*
|
||||
PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: INTEGER;
|
||||
origbuf: UnixStatRec;
|
||||
|
||||
PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec; errors: RelatedEvents.Object): BOOLEAN;
|
||||
BEGIN
|
||||
IF SYS.UNIXCALL(Sys.newlstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf)) THEN
|
||||
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.newlstat, path);
|
||||
RETURN FALSE
|
||||
END;
|
||||
END Lstat;
|
||||
*)
|
||||
PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1, d2: LONGINT;
|
||||
origbuf: UnixStatRec;
|
||||
BEGIN
|
||||
IF uSYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf), d2) THEN
|
||||
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.newfstat, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
structstats;
|
||||
IF fstat(SYS.VAL(LONGINT, fd)) < 0 THEN SysErrors.Raise(errors, err(), Sys.newfstat, ""); RETURN FALSE END;
|
||||
buf.device := SYS.VAL(SysTypes.Device, statdev());
|
||||
buf.inode := SYS.VAL(SysTypes.Inode, statino());
|
||||
buf.mode := SYS.VAL(SET, statmode());
|
||||
buf.nlinks := statnlink();
|
||||
buf.uid := statuid();
|
||||
buf.gid := statgid();
|
||||
buf.rdev := SYS.VAL(SysTypes.Device, statrdev());
|
||||
buf.size := SYS.VAL(SysTypes.Offset, statsize());
|
||||
(* Blocks and blksize are not available on all platforms.
|
||||
buf.blksize := statblksize();
|
||||
buf.blocks := statblocks();
|
||||
*)
|
||||
buf.atime := SYS.VAL(SysTypes.Time, statatime());
|
||||
buf.mtime := SYS.VAL(SysTypes.Time, statmtime());
|
||||
buf.ctime := SYS.VAL(SysTypes.Time, statctime());
|
||||
RETURN TRUE;
|
||||
END Fstat;
|
||||
|
||||
BEGIN
|
||||
SysConversions.Compile(statbuffmt, statbufconv);
|
||||
|
||||
END ulmSysStat.
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -229,6 +229,7 @@ MODULE ulmTexts;
|
|||
| Streams.fromStart: pos := count;
|
||||
| Streams.fromPos: pos := count + s.pos;
|
||||
| Streams.fromEnd: pos := count + s.len;
|
||||
ELSE
|
||||
END;
|
||||
IF (pos >= 0) & (pos <= s.len) THEN
|
||||
s.pos := pos;
|
||||
|
|
|
|||
|
|
@ -200,6 +200,7 @@ MODULE ulmTimes;
|
|||
| epochUnit: value := measure.timeval.epoch;
|
||||
| secondUnit: value := measure.timeval.second;
|
||||
| usecUnit: value := measure.timeval.usec;
|
||||
ELSE
|
||||
END;
|
||||
END; END;
|
||||
END InternalGetValue;
|
||||
|
|
@ -212,6 +213,7 @@ MODULE ulmTimes;
|
|||
| epochUnit: measure.timeval.epoch := value;
|
||||
| secondUnit: measure.timeval.second := value;
|
||||
| usecUnit: measure.timeval.usec := value;
|
||||
ELSE
|
||||
END;
|
||||
Normalize(measure.timeval);
|
||||
END; END;
|
||||
|
|
@ -274,6 +276,7 @@ MODULE ulmTimes;
|
|||
CASE op OF
|
||||
| Scales.add: Add(op1.timeval, op2.timeval, result.timeval);
|
||||
| Scales.sub: Sub(op1.timeval, op2.timeval, result.timeval);
|
||||
ELSE
|
||||
END;
|
||||
END;
|
||||
END; END;
|
||||
|
|
@ -283,25 +286,28 @@ MODULE ulmTimes;
|
|||
|
||||
PROCEDURE ReturnVal(val1, val2: Scales.Value) : INTEGER;
|
||||
BEGIN
|
||||
IF val1 < val2 THEN
|
||||
RETURN -1
|
||||
ELSIF val1 > val2 THEN
|
||||
RETURN 1
|
||||
ELSE
|
||||
RETURN 0
|
||||
END;
|
||||
IF val1 < val2 THEN
|
||||
RETURN -1
|
||||
ELSIF val1 > val2 THEN
|
||||
RETURN 1
|
||||
ELSE
|
||||
RETURN 0
|
||||
END;
|
||||
END ReturnVal;
|
||||
|
||||
BEGIN
|
||||
WITH op1: ReferenceTime DO WITH op2: ReferenceTime DO
|
||||
IF op1.timeval.epoch # op2.timeval.epoch THEN
|
||||
RETURN ReturnVal(op1.timeval.epoch, op2.timeval.epoch)
|
||||
ELSIF op1.timeval.second # op2.timeval.second THEN
|
||||
RETURN ReturnVal(op1.timeval.second, op2.timeval.second)
|
||||
ELSE
|
||||
RETURN ReturnVal(op1.timeval.usec, op2.timeval.usec)
|
||||
END;
|
||||
END; END;
|
||||
WITH op1: ReferenceTime DO
|
||||
WITH op2: ReferenceTime DO
|
||||
IF op1.timeval.epoch # op2.timeval.epoch THEN
|
||||
RETURN ReturnVal(op1.timeval.epoch, op2.timeval.epoch)
|
||||
ELSIF op1.timeval.second # op2.timeval.second THEN
|
||||
RETURN ReturnVal(op1.timeval.second, op2.timeval.second)
|
||||
ELSE
|
||||
RETURN ReturnVal(op1.timeval.usec, op2.timeval.usec)
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
RETURN 0;
|
||||
END Compare;
|
||||
|
||||
(* ========= initialization procedures ========================== *)
|
||||
|
|
|
|||
|
|
@ -50,34 +50,32 @@ MODULE ulmTypes;
|
|||
IMPORT SYS := SYSTEM;
|
||||
|
||||
TYPE
|
||||
Address* = (*SYS.PTR*) LONGINT (*SYS.ADDRESS*);
|
||||
Address* = LONGINT (*SYS.ADDRESS*);
|
||||
(* ulm compiler can accept
|
||||
VAR p : SYSTEM.ADDRESS; // SYSTEM.PTR in ETH and V4 versions
|
||||
...
|
||||
p := SYSTEM.ADR(something);
|
||||
and this is how it is used in ulm oberon system library,
|
||||
while SYSTEM.ADR returns LONGINT in ETH and V4 versions.
|
||||
Thus I leave it as LONGINT for now, before coming up with better solution -- noch *)
|
||||
UntracedAddress* = POINTER[1] TO UntracedAddressDesc; (*SYS.UNTRACEDADDRESS;*)
|
||||
...
|
||||
p := SYSTEM.ADR(something);
|
||||
and this is how it is used in ulm oberon system library,
|
||||
while SYSTEM.ADR returns LONGINT in ETH and V4 versions.
|
||||
Thus I leave it as LONGINT for now, before coming up with better solution -- noch *)
|
||||
|
||||
UntracedAddress* = POINTER[1] TO UntracedAddressDesc; (*SYS.UNTRACEDADDRESS;*)
|
||||
UntracedAddressDesc* = RECORD[1] END;
|
||||
|
||||
intarr64 = ARRAY 8 OF SYS.BYTE; (* to emulate int16 on x86_64; -- noch *)
|
||||
intarr16 = ARRAY 2 OF SYS.BYTE;
|
||||
|
||||
Count* = LONGINT;
|
||||
Size* = Count;
|
||||
Byte* = SYS.BYTE;
|
||||
|
||||
Count* = LONGINT;
|
||||
Size* = Count;
|
||||
Byte* = SYS.BYTE;
|
||||
IntAddress* = LONGINT;
|
||||
Int8* = SHORTINT;
|
||||
Int16* = intarr16(*INTEGER*); (* we don't have 16 bit integer in x86_64 version of voc *)
|
||||
Int32* = INTEGER;
|
||||
Real32* = REAL;
|
||||
Real64* = LONGREAL;
|
||||
Int8* = SHORTINT;
|
||||
Int16* = INTEGER; (* No real 16 bit integer type *)
|
||||
Int32* = INTEGER;
|
||||
Real32* = REAL;
|
||||
Real64* = LONGREAL;
|
||||
|
||||
CONST
|
||||
bigEndian* = 0; (* SPARC, M68K etc *)
|
||||
bigEndian* = 0; (* SPARC, M68K etc *)
|
||||
littleEndian* = 1; (* Intel 80x86, VAX etc *)
|
||||
byteorder* = littleEndian; (* machine-dependent constant *)
|
||||
byteorder* = littleEndian; (* machine-dependent constant *)
|
||||
TYPE
|
||||
ByteOrder* = SHORTINT; (* bigEndian or littleEndian *)
|
||||
|
||||
|
|
@ -93,21 +91,17 @@ MODULE ulmTypes;
|
|||
|
||||
PROCEDURE ToInt8*(int: LONGINT) : Int8;
|
||||
BEGIN
|
||||
RETURN SHORT(SHORT(int))
|
||||
RETURN SYS.VAL(SHORTINT, int)
|
||||
END ToInt8;
|
||||
|
||||
PROCEDURE ToInt16*(int: LONGINT; VAR int16: Int16)(* : Int16*);
|
||||
VAR longintarr : intarr64;
|
||||
PROCEDURE ToInt16*(int: LONGINT) : Int16;
|
||||
BEGIN
|
||||
(*RETURN SYS.VAL(Int16, int)*)
|
||||
longintarr := SYS.VAL(intarr64, int);
|
||||
int16[0] := longintarr[0];
|
||||
int16[1] := longintarr[1]; (* this will work for little endian -- noch *)
|
||||
RETURN SYS.VAL(Int16, int)
|
||||
END ToInt16;
|
||||
|
||||
PROCEDURE ToInt32*(int: LONGINT) : Int32;
|
||||
BEGIN
|
||||
RETURN SHORT(int)
|
||||
RETURN SYS.VAL(INTEGER, int)
|
||||
END ToInt32;
|
||||
|
||||
PROCEDURE ToReal32*(real: LONGREAL) : Real32;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue