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

SysStat, SysConversions ported

Browse source
This commit is contained in:
Norayr Chilingarian 2013-11-05 22:05:20 +04:00
parent 1355629f90
commit d2c954e16f
15 changed files with 3336 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

1
makefile
View file

@ -204,6 +204,7 @@ stage6:
$(VOCSTATIC) -sP ulmStreamConditions.Mod $(VOCSTATIC) -sP ulmStreamConditions.Mod
$(VOCSTATIC) -sP ulmTimeConditions.Mod $(VOCSTATIC) -sP ulmTimeConditions.Mod
$(VOCSTATIC) -sP ulmSysConversions.Mod $(VOCSTATIC) -sP ulmSysConversions.Mod
$(VOCSTATIC) -sP ulmSysStat.Mod
#pow32 libs #pow32 libs

0
src/lib/ulm/ulmSysConversions.Mod → src/lib/ulm/armv6j/ulmSysConversions.Mod
View file

200
src/lib/ulm/armv6j/ulmSysStat.Mod Normal file
View file

@ -0,0 +1,200 @@
(* Ulm's Oberon Library
Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: SysStat.om,v 1.3 2000/11/12 13:02:09 borchert Exp $
----------------------------------------------------------------------------
$Log: SysStat.om,v $
Revision 1.3 2000/11/12 13:02:09 borchert
door file type added
Revision 1.2 2000/11/12 12:48:07 borchert
- conversion adapted to Solaris 2.x
- Lstat added
Revision 1.1 1994/02/23 08:00:48 borchert
Initial revision
----------------------------------------------------------------------------
AFB 9/89
----------------------------------------------------------------------------
*)
MODULE ulmSysStat;
(* examine inode: stat(2) and fstat(2) *)
IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, SysConversions := ulmSysConversions, SysError := ulmSysErrors,
SysTypes := ulmSysTypes;
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 |
+--------+------+-----+-----+-----+-----+
*)
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 *)
(* special *)
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 *)
(* example for "r-xr-x---": (read + exec) * (owner + group) *)
owner* = {uread, uwrite, uexec};
group* = {gread, gwrite, gexec};
other* = {oread, owrite, oexec};
read* = {uread, gread, oread};
write* = {uwrite, gwrite, owrite};
exec* = {uexec, gexec, oexec};
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 *)
mode*: SET; (* file mode; see mknod(2) *)
nlinks*: INTEGER; (* number of links *)
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;
(* 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 = 88(*64*); (* see <sys/stat.h> *) (* sizeof struct stat gives us 144 on x86_64 and 88 on x86 *)
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";*)
"ls=dev/-s=pad1/lL=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/lL=size/2*lL=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l";
VAR
statbuffmt: SysConversions.Format;
PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
d0, d1, d2: LONGINT;
origbuf: UnixStatRec;
BEGIN
IF SYS.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;
END Stat;
PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
d0, d1: INTEGER;
origbuf: UnixStatRec;
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: INTEGER;
origbuf: UnixStatRec;
BEGIN
IF SYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf)) THEN
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
RETURN TRUE
ELSE
SysErrors.Raise(errors, d0, Sys.newfstat, "");
RETURN FALSE
END;
END Fstat;
BEGIN
SysConversions.Compile(statbuffmt, statbufconv);
END ulmSysStat.

2
src/lib/ulm/armv6j/ulmSysTypes.Mod
View file

@ -41,7 +41,7 @@ MODULE ulmSysTypes;
File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *) File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *)
Offset* = LONGINT; Offset* = LONGINT;
Device* = INTEGER; Device* = LONGINT;
Inode* = LONGINT; Inode* = LONGINT;
Time* = LONGINT; Time* = LONGINT;

574
src/lib/ulm/armv6j_hardfp/ulmSysConversions.Mod Normal file
View file

@ -0,0 +1,574 @@
(* Ulm's Oberon Library
Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: SysConversi.om,v 1.2 1997/07/30 09:38:16 borchert Exp $
----------------------------------------------------------------------------
$Log: SysConversi.om,v $
Revision 1.2 1997/07/30 09:38:16 borchert
bug in ReadConv fixed: cv.flags was used but not set for
counts > 1
Revision 1.1 1994/02/23 07:58:28 borchert
Initial revision
----------------------------------------------------------------------------
AFB 8/90
adapted to linux cae 02/01
----------------------------------------------------------------------------
*)
MODULE ulmSysConversions;
(* convert Oberon records to/from C structures *)
IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Streams := ulmStreams, Strings := ulmStrings,
SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts;
TYPE
Address* = SysTypes.Address;
Size* = Address;
(* format:
Format = Conversion { "/" Conversion } .
Conversion = [ Factors ] ConvChars [ Comment ] .
Factors = Array | Factor | Array Factor | Factor Array .
Array = Integer ":" .
Factor = Integer "*" .
ConvChars = OberonType CType | Skip CType | OberonType Skip .
OberonType = "a" | "b" | "c" | "s" | "i" | "l" | "S" .
CType = "a" | "c" | "s" | "i" | "l" .
Integer = Digit { Digit } .
Digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" .
Skip = "-" .
Comment = "=" { AnyChar } .
AnyChar = (* all characters except "/" *) .
Oberon data types:
a: Address
b: SYS.BYTE
B: BOOLEAN
c: CHAR
s: SHORTINT
i: INTEGER
l: LONGINT
S: SET
C data types:
a: char *
c: /* signed */ char
C: unsigned char
s: short int
S: unsigned short int
i: int
I: unsigned int
u: unsigned int
l: long int
L: unsigned long int
example:
conversion from
Rec =
RECORD
a, b: INTEGER;
c: CHAR;
s: SET;
f: ARRAY 3 OF INTEGER;
END;
to
struct rec {
short a, b;
char c;
int xx; /* to be skipped on conversion */
int s;
int f[3];
};
or vice versa:
"2*is=a,b/cc=c/-i=xx/Si=s/3:ii=f"
The comments allow to give the field names.
*)
CONST
(* conversion flags *)
unsigned = 0; (* suppress sign extension *)
boolean = 1; (* convert anything # 0 to 1 *)
TYPE
Flags = SET;
Event* = POINTER TO EventRec;
EventRec* =
RECORD
(Events.EventRec)
format*: Events.Message;
END;
ConvStream = POINTER TO ConvStreamRec;
ConvStreamRec =
RECORD
fmt: Texts.Text;
char: CHAR;
eof: BOOLEAN;
(* 1: Oberon type
2: C type
*)
type1, type2: CHAR; length: INTEGER; left: INTEGER;
offset1, offset2: Address;
size1, size2: Address; elementsleft: INTEGER; flags: Flags;
END;
Format* = POINTER TO FormatRec;
FormatRec* =
RECORD
(Objects.ObjectRec)
offset1, offset2: Address;
size1, size2: Address;
flags: Flags;
next: Format;
END;
VAR
badformat*: Events.EventType;
PROCEDURE Error(cv: ConvStream; msg: ARRAY OF CHAR);
VAR
event: Event;
BEGIN
NEW(event);
event.type := badformat;
event.message := "SysConversions: ";
Strings.Concatenate(event.message, msg);
Strings.Read(event.format, cv.fmt);
Events.Raise(event);
cv.eof := TRUE;
cv.char := 0X;
cv.left := 0;
cv.elementsleft := 0;
END Error;
PROCEDURE SizeError(msg, format: ARRAY OF CHAR);
VAR
event: Event;
BEGIN
NEW(event);
event.type := badformat;
event.message := "SysConversions: ";
Strings.Concatenate(event.message, msg);
COPY(format, event.format);
Events.Raise(event);
END SizeError;
PROCEDURE NextCh(cv: ConvStream);
BEGIN
cv.eof := cv.eof OR ~Streams.ReadByte(cv.fmt, cv.char) OR (cv.char = 0X);
IF cv.eof THEN
cv.char := 0X;
END;
END NextCh;
PROCEDURE IsDigit(ch: CHAR) : BOOLEAN;
BEGIN
RETURN (ch >= "0") & (ch <= "9")
END IsDigit;
PROCEDURE ReadInt(cv: ConvStream; VAR i: INTEGER);
BEGIN
i := 0;
REPEAT
i := 10 * i + ORD(cv.char) - ORD("0");
NextCh(cv);
UNTIL ~IsDigit(cv.char);
END ReadInt;
PROCEDURE Open(VAR cv: ConvStream; format: ARRAY OF CHAR);
BEGIN
NEW(cv);
Texts.Open(SYS.VAL(Streams.Stream, cv.fmt));
Strings.Write(cv.fmt, format);
cv.left := 0; cv.elementsleft := 0;
cv.offset1 := 0; cv.offset2 := 0;
cv.eof := FALSE;
NextCh(cv);
END Open;
PROCEDURE Close(VAR cv: ConvStream);
BEGIN
IF ~Streams.Close(cv.fmt) THEN END;
END Close;
PROCEDURE ScanConv(cv: ConvStream;
VAR type1, type2: CHAR;
VAR length: INTEGER) : BOOLEAN;
VAR
i: INTEGER;
factor: INTEGER;
BEGIN
IF cv.left > 0 THEN
type1 := cv.type1;
type2 := cv.type2;
length := cv.length;
DEC(cv.left);
RETURN TRUE
END;
IF cv.char = "/" THEN
NextCh(cv);
END;
IF cv.eof THEN
RETURN FALSE
END;
factor := 0; length := 0;
WHILE IsDigit(cv.char) DO
ReadInt(cv, i);
IF i <= 0 THEN
Error(cv, "integer must be positive"); RETURN FALSE
END;
IF cv.char = ":" THEN
IF length # 0 THEN
Error(cv, "multiple length specification"); RETURN FALSE
END;
length := i;
NextCh(cv);
ELSIF cv.char = "*" THEN
IF factor # 0 THEN
Error(cv, "multiple factor specification"); RETURN FALSE
END;
factor := i; cv.left := factor - 1;
NextCh(cv);
ELSE
Error(cv, "factor or length expected"); RETURN FALSE
END;
END;
type1 := cv.char; NextCh(cv);
type2 := cv.char; NextCh(cv);
IF cv.left > 0 THEN
cv.type1 := type1; cv.type2 := type2; cv.length := length;
END;
IF cv.char = "=" THEN (* comment *)
REPEAT
NextCh(cv);
UNTIL cv.eof OR (cv.char = "/");
END;
RETURN TRUE
END ScanConv;
PROCEDURE Align(VAR offset: Address; boundary: Address);
BEGIN
IF SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary) # 0 THEN
offset := SYS.VAL (INTEGER, offset) + (SYS.VAL (INTEGER, boundary) - SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary));
END;
END Align;
PROCEDURE ReadConv(cv: ConvStream;
VAR offset1, offset2: Address;
VAR size1, size2: Address;
VAR flags: Flags) : BOOLEAN;
VAR
type1, type2: CHAR;
length: INTEGER;
align: BOOLEAN;
boundary: INTEGER;
BEGIN
IF cv.elementsleft > 0 THEN
DEC(cv.elementsleft);
(* Oberon type *)
IF size1 > SIZE(SYS.BYTE) THEN
Align(cv.offset1, SIZE(INTEGER));
END;
offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1;
size1 := cv.size1; size2 := cv.size2; flags := cv.flags;
IF (size1 > 0) & (cv.elementsleft = 0) THEN
Align(cv.offset1, SIZE(INTEGER));
END;
(* C type *)
IF size2 > 1 THEN
Align(cv.offset2, 2);
END;
offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2);
RETURN TRUE
END;
IF ScanConv(cv, type1, type2, length) THEN
flags := {};
(* Oberon type *)
CASE type1 OF
| "a": size1 := SIZE(Address); INCL(flags, unsigned);
| "b": size1 := SIZE(SYS.BYTE); INCL(flags, unsigned);
| "B": size1 := SIZE(BOOLEAN); INCL(flags, boolean);
| "c": size1 := SIZE(CHAR); INCL(flags, unsigned);
| "s": size1 := SIZE(SHORTINT);
| "i": size1 := SIZE(INTEGER);
| "l": size1 := SIZE(LONGINT);
| "S": size1 := SIZE(SET); INCL(flags, unsigned);
| "-": size1 := 0;
ELSE Error(cv, "bad Oberon type specifier"); RETURN FALSE
END;
IF size1 > 0 THEN
IF length > 0 THEN
Align(cv.offset1, SIZE(INTEGER));
ELSIF size1 > SIZE(SYS.BYTE) THEN
Align(cv.offset1, SIZE(INTEGER));
END;
END;
offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1;
(* C type *)
CASE type2 OF
| "a": size2 := 4; 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 := 4; (* long int *)
| "L": size2 := 4; INCL(flags, unsigned); (* long int *)
| "-": size2 := 0;
ELSE Error(cv, "bad C type specifier"); RETURN FALSE
END;
IF size2 > 1 THEN
Align(cv.offset2, size2);
END;
offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2);
cv.size1 := size1; cv.size2 := size2;
IF length > 0 THEN
cv.elementsleft := length - 1;
cv.flags := flags;
END;
RETURN TRUE
ELSE
RETURN FALSE
END;
END ReadConv;
PROCEDURE Convert(from, to: Address; ssize, dsize: Address; flags: Flags);
TYPE
Bytes = ARRAY 8 OF CHAR;
Pointer = POINTER TO Bytes;
VAR
dest, source: Pointer;
dindex, sindex: INTEGER;
nonzero: BOOLEAN;
fill : CHAR;
BEGIN
IF ssize > 0 THEN
dest := SYS.VAL(Pointer, to);
source := SYS.VAL(Pointer, from);
dindex := 0; sindex := 0;
IF boolean IN flags THEN
nonzero := FALSE;
WHILE ssize > 0 DO
nonzero := nonzero OR (source[sindex] # 0X);
INC(sindex); ssize := SYS.VAL (INTEGER, ssize) - 1;
END;
IF dsize > 0 THEN
IF nonzero THEN
dest[dindex] := 1X;
ELSE
dest[dindex] := 0X;
END;
dsize := dsize - 1; INC (dindex);
END;
WHILE dsize > 0 DO
dest[dindex] := 0X;
dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex);
END;
ELSE
WHILE (dsize > 0) & (ssize > 0) DO
dest[dindex] := source[sindex];
ssize := SYS.VAL (INTEGER, ssize) - 1;
dsize := dsize - 1;
INC(dindex); INC(sindex);
END;
IF dsize > 0 THEN
(* sindex has been incremented at least once because
* ssize and dsize were greater than 0, i.e. sindex-1
* is a valid inex. *)
fill := 0X;
IF ~(unsigned IN flags) & (source[sindex-1] >= 080X) THEN
fill := 0FFX;
END;
END;
WHILE dsize > 0 DO
dest[dindex] := fill;
dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex);
END;
END;
END;
END Convert;
PROCEDURE ByAddrToC*(from, to: Address; format: ARRAY OF CHAR);
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO
Convert(from + offset1, to + offset2, size1, size2, flags);
END;
Close(cv);
END ByAddrToC;
PROCEDURE ByAddrFromC*(from, to: Address; format: ARRAY OF CHAR);
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO
Convert(from + offset2, to + offset1, size2, size1, flags);
END;
Close(cv);
END ByAddrFromC;
PROCEDURE CSize*(format: ARRAY OF CHAR) : Size;
(* returns the size of the C-structure described by `format' *)
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
size: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END;
Close(cv);
size := offset2 + size2;
Align(size, 2);
RETURN size
END CSize;
PROCEDURE OberonSize*(format: ARRAY OF CHAR) : Size;
(* returns the size of the Oberon-structure described by `format' *)
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
size: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END;
Close(cv);
size := offset1 + size1;
Align(size, SIZE(INTEGER));
RETURN size
END OberonSize;
PROCEDURE ToC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR);
BEGIN
IF OberonSize(format) > LEN(from) THEN
SizeError("Oberon record is too small", format); RETURN
END;
IF CSize(format) > LEN(to) THEN
SizeError("C structure is too small", format); RETURN
END;
ByAddrToC(SYS.ADR(from), SYS.ADR(to), format);
END ToC;
PROCEDURE FromC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR);
BEGIN
IF OberonSize(format) > LEN(to) THEN
SizeError("Oberon record is too small", format); RETURN
END;
IF CSize(format) > LEN(from) THEN
SizeError("C structure is too small", format); RETURN
END;
ByAddrFromC(SYS.ADR(from), SYS.ADR(to), format);
END FromC;
PROCEDURE Compile*(VAR fmt: Format; format: ARRAY OF CHAR);
(* translate format into an internal representation
which is later referenced by fmt;
ByFmtToC and ByFmtFromC are faster than ToC and FromC
*)
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
flags: Flags;
element: Format;
head, tail: Format;
BEGIN
Open(cv, format);
head := NIL; tail := NIL;
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO
NEW(element);
element.offset1 := offset1;
element.offset2 := offset2;
element.size1 := size1;
element.size2 := size2;
element.flags := flags;
element.next := NIL;
IF tail # NIL THEN
tail.next := element;
ELSE
head := element;
END;
tail := element;
END;
fmt := head;
Close(cv);
END Compile;
PROCEDURE ByFmtAndAddrToC*(from, to: Address; format: Format);
VAR
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
WHILE format # NIL DO
Convert(from + format.offset1, to + format.offset2,
format.size1, format.size2, format.flags);
format := format.next;
END;
END ByFmtAndAddrToC;
PROCEDURE ByFmtAndAddrFromC*(from, to: Address; format: Format);
VAR
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
WHILE format # NIL DO
Convert(from + format.offset2, to + format.offset1,
format.size2, format.size1, format.flags);
format := format.next;
END;
END ByFmtAndAddrFromC;
PROCEDURE ByFmtToC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format);
BEGIN
ByFmtAndAddrToC(SYS.ADR(from), SYS.ADR(to), format);
END ByFmtToC;
PROCEDURE ByFmtFromC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format);
BEGIN
ByFmtAndAddrFromC(SYS.ADR(from), SYS.ADR(to), format);
END ByFmtFromC;
BEGIN
Events.Define(badformat);
Events.SetPriority(badformat, Priorities.liberrors);
END ulmSysConversions.

200
src/lib/ulm/armv6j_hardfp/ulmSysStat.Mod Normal file
View file

@ -0,0 +1,200 @@
(* Ulm's Oberon Library
Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: SysStat.om,v 1.3 2000/11/12 13:02:09 borchert Exp $
----------------------------------------------------------------------------
$Log: SysStat.om,v $
Revision 1.3 2000/11/12 13:02:09 borchert
door file type added
Revision 1.2 2000/11/12 12:48:07 borchert
- conversion adapted to Solaris 2.x
- Lstat added
Revision 1.1 1994/02/23 08:00:48 borchert
Initial revision
----------------------------------------------------------------------------
AFB 9/89
----------------------------------------------------------------------------
*)
MODULE ulmSysStat;
(* examine inode: stat(2) and fstat(2) *)
IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, SysConversions := ulmSysConversions, SysError := ulmSysErrors,
SysTypes := ulmSysTypes;
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 |
+--------+------+-----+-----+-----+-----+
*)
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 *)
(* special *)
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 *)
(* example for "r-xr-x---": (read + exec) * (owner + group) *)
owner* = {uread, uwrite, uexec};
group* = {gread, gwrite, gexec};
other* = {oread, owrite, oexec};
read* = {uread, gread, oread};
write* = {uwrite, gwrite, owrite};
exec* = {uexec, gexec, oexec};
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 *)
mode*: SET; (* file mode; see mknod(2) *)
nlinks*: INTEGER; (* number of links *)
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;
(* 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 = 88(*64*); (* see <sys/stat.h> *) (* sizeof struct stat gives us 144 on x86_64 and 88 on x86 *)
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";*)
"ls=dev/-s=pad1/lL=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/lL=size/2*lL=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l";
VAR
statbuffmt: SysConversions.Format;
PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
d0, d1, d2: LONGINT;
origbuf: UnixStatRec;
BEGIN
IF SYS.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;
END Stat;
PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
d0, d1: INTEGER;
origbuf: UnixStatRec;
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: INTEGER;
origbuf: UnixStatRec;
BEGIN
IF SYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf)) THEN
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
RETURN TRUE
ELSE
SysErrors.Raise(errors, d0, Sys.newfstat, "");
RETURN FALSE
END;
END Fstat;
BEGIN
SysConversions.Compile(statbuffmt, statbufconv);
END ulmSysStat.

2
src/lib/ulm/armv6j_hardfp/ulmSysTypes.Mod
View file

@ -41,7 +41,7 @@ MODULE ulmSysTypes;
File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *) File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *)
Offset* = LONGINT; Offset* = LONGINT;
Device* = INTEGER; Device* = LONGINT;
Inode* = LONGINT; Inode* = LONGINT;
Time* = LONGINT; Time* = LONGINT;

574
src/lib/ulm/armv7a_hardfp/ulmSysConversions.Mod Normal file
View file

@ -0,0 +1,574 @@
(* Ulm's Oberon Library
Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: SysConversi.om,v 1.2 1997/07/30 09:38:16 borchert Exp $
----------------------------------------------------------------------------
$Log: SysConversi.om,v $
Revision 1.2 1997/07/30 09:38:16 borchert
bug in ReadConv fixed: cv.flags was used but not set for
counts > 1
Revision 1.1 1994/02/23 07:58:28 borchert
Initial revision
----------------------------------------------------------------------------
AFB 8/90
adapted to linux cae 02/01
----------------------------------------------------------------------------
*)
MODULE ulmSysConversions;
(* convert Oberon records to/from C structures *)
IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Streams := ulmStreams, Strings := ulmStrings,
SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts;
TYPE
Address* = SysTypes.Address;
Size* = Address;
(* format:
Format = Conversion { "/" Conversion } .
Conversion = [ Factors ] ConvChars [ Comment ] .
Factors = Array | Factor | Array Factor | Factor Array .
Array = Integer ":" .
Factor = Integer "*" .
ConvChars = OberonType CType | Skip CType | OberonType Skip .
OberonType = "a" | "b" | "c" | "s" | "i" | "l" | "S" .
CType = "a" | "c" | "s" | "i" | "l" .
Integer = Digit { Digit } .
Digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" .
Skip = "-" .
Comment = "=" { AnyChar } .
AnyChar = (* all characters except "/" *) .
Oberon data types:
a: Address
b: SYS.BYTE
B: BOOLEAN
c: CHAR
s: SHORTINT
i: INTEGER
l: LONGINT
S: SET
C data types:
a: char *
c: /* signed */ char
C: unsigned char
s: short int
S: unsigned short int
i: int
I: unsigned int
u: unsigned int
l: long int
L: unsigned long int
example:
conversion from
Rec =
RECORD
a, b: INTEGER;
c: CHAR;
s: SET;
f: ARRAY 3 OF INTEGER;
END;
to
struct rec {
short a, b;
char c;
int xx; /* to be skipped on conversion */
int s;
int f[3];
};
or vice versa:
"2*is=a,b/cc=c/-i=xx/Si=s/3:ii=f"
The comments allow to give the field names.
*)
CONST
(* conversion flags *)
unsigned = 0; (* suppress sign extension *)
boolean = 1; (* convert anything # 0 to 1 *)
TYPE
Flags = SET;
Event* = POINTER TO EventRec;
EventRec* =
RECORD
(Events.EventRec)
format*: Events.Message;
END;
ConvStream = POINTER TO ConvStreamRec;
ConvStreamRec =
RECORD
fmt: Texts.Text;
char: CHAR;
eof: BOOLEAN;
(* 1: Oberon type
2: C type
*)
type1, type2: CHAR; length: INTEGER; left: INTEGER;
offset1, offset2: Address;
size1, size2: Address; elementsleft: INTEGER; flags: Flags;
END;
Format* = POINTER TO FormatRec;
FormatRec* =
RECORD
(Objects.ObjectRec)
offset1, offset2: Address;
size1, size2: Address;
flags: Flags;
next: Format;
END;
VAR
badformat*: Events.EventType;
PROCEDURE Error(cv: ConvStream; msg: ARRAY OF CHAR);
VAR
event: Event;
BEGIN
NEW(event);
event.type := badformat;
event.message := "SysConversions: ";
Strings.Concatenate(event.message, msg);
Strings.Read(event.format, cv.fmt);
Events.Raise(event);
cv.eof := TRUE;
cv.char := 0X;
cv.left := 0;
cv.elementsleft := 0;
END Error;
PROCEDURE SizeError(msg, format: ARRAY OF CHAR);
VAR
event: Event;
BEGIN
NEW(event);
event.type := badformat;
event.message := "SysConversions: ";
Strings.Concatenate(event.message, msg);
COPY(format, event.format);
Events.Raise(event);
END SizeError;
PROCEDURE NextCh(cv: ConvStream);
BEGIN
cv.eof := cv.eof OR ~Streams.ReadByte(cv.fmt, cv.char) OR (cv.char = 0X);
IF cv.eof THEN
cv.char := 0X;
END;
END NextCh;
PROCEDURE IsDigit(ch: CHAR) : BOOLEAN;
BEGIN
RETURN (ch >= "0") & (ch <= "9")
END IsDigit;
PROCEDURE ReadInt(cv: ConvStream; VAR i: INTEGER);
BEGIN
i := 0;
REPEAT
i := 10 * i + ORD(cv.char) - ORD("0");
NextCh(cv);
UNTIL ~IsDigit(cv.char);
END ReadInt;
PROCEDURE Open(VAR cv: ConvStream; format: ARRAY OF CHAR);
BEGIN
NEW(cv);
Texts.Open(SYS.VAL(Streams.Stream, cv.fmt));
Strings.Write(cv.fmt, format);
cv.left := 0; cv.elementsleft := 0;
cv.offset1 := 0; cv.offset2 := 0;
cv.eof := FALSE;
NextCh(cv);
END Open;
PROCEDURE Close(VAR cv: ConvStream);
BEGIN
IF ~Streams.Close(cv.fmt) THEN END;
END Close;
PROCEDURE ScanConv(cv: ConvStream;
VAR type1, type2: CHAR;
VAR length: INTEGER) : BOOLEAN;
VAR
i: INTEGER;
factor: INTEGER;
BEGIN
IF cv.left > 0 THEN
type1 := cv.type1;
type2 := cv.type2;
length := cv.length;
DEC(cv.left);
RETURN TRUE
END;
IF cv.char = "/" THEN
NextCh(cv);
END;
IF cv.eof THEN
RETURN FALSE
END;
factor := 0; length := 0;
WHILE IsDigit(cv.char) DO
ReadInt(cv, i);
IF i <= 0 THEN
Error(cv, "integer must be positive"); RETURN FALSE
END;
IF cv.char = ":" THEN
IF length # 0 THEN
Error(cv, "multiple length specification"); RETURN FALSE
END;
length := i;
NextCh(cv);
ELSIF cv.char = "*" THEN
IF factor # 0 THEN
Error(cv, "multiple factor specification"); RETURN FALSE
END;
factor := i; cv.left := factor - 1;
NextCh(cv);
ELSE
Error(cv, "factor or length expected"); RETURN FALSE
END;
END;
type1 := cv.char; NextCh(cv);
type2 := cv.char; NextCh(cv);
IF cv.left > 0 THEN
cv.type1 := type1; cv.type2 := type2; cv.length := length;
END;
IF cv.char = "=" THEN (* comment *)
REPEAT
NextCh(cv);
UNTIL cv.eof OR (cv.char = "/");
END;
RETURN TRUE
END ScanConv;
PROCEDURE Align(VAR offset: Address; boundary: Address);
BEGIN
IF SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary) # 0 THEN
offset := SYS.VAL (INTEGER, offset) + (SYS.VAL (INTEGER, boundary) - SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary));
END;
END Align;
PROCEDURE ReadConv(cv: ConvStream;
VAR offset1, offset2: Address;
VAR size1, size2: Address;
VAR flags: Flags) : BOOLEAN;
VAR
type1, type2: CHAR;
length: INTEGER;
align: BOOLEAN;
boundary: INTEGER;
BEGIN
IF cv.elementsleft > 0 THEN
DEC(cv.elementsleft);
(* Oberon type *)
IF size1 > SIZE(SYS.BYTE) THEN
Align(cv.offset1, SIZE(INTEGER));
END;
offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1;
size1 := cv.size1; size2 := cv.size2; flags := cv.flags;
IF (size1 > 0) & (cv.elementsleft = 0) THEN
Align(cv.offset1, SIZE(INTEGER));
END;
(* C type *)
IF size2 > 1 THEN
Align(cv.offset2, 2);
END;
offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2);
RETURN TRUE
END;
IF ScanConv(cv, type1, type2, length) THEN
flags := {};
(* Oberon type *)
CASE type1 OF
| "a": size1 := SIZE(Address); INCL(flags, unsigned);
| "b": size1 := SIZE(SYS.BYTE); INCL(flags, unsigned);
| "B": size1 := SIZE(BOOLEAN); INCL(flags, boolean);
| "c": size1 := SIZE(CHAR); INCL(flags, unsigned);
| "s": size1 := SIZE(SHORTINT);
| "i": size1 := SIZE(INTEGER);
| "l": size1 := SIZE(LONGINT);
| "S": size1 := SIZE(SET); INCL(flags, unsigned);
| "-": size1 := 0;
ELSE Error(cv, "bad Oberon type specifier"); RETURN FALSE
END;
IF size1 > 0 THEN
IF length > 0 THEN
Align(cv.offset1, SIZE(INTEGER));
ELSIF size1 > SIZE(SYS.BYTE) THEN
Align(cv.offset1, SIZE(INTEGER));
END;
END;
offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1;
(* C type *)
CASE type2 OF
| "a": size2 := 4; 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 := 4; (* long int *)
| "L": size2 := 4; INCL(flags, unsigned); (* long int *)
| "-": size2 := 0;
ELSE Error(cv, "bad C type specifier"); RETURN FALSE
END;
IF size2 > 1 THEN
Align(cv.offset2, size2);
END;
offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2);
cv.size1 := size1; cv.size2 := size2;
IF length > 0 THEN
cv.elementsleft := length - 1;
cv.flags := flags;
END;
RETURN TRUE
ELSE
RETURN FALSE
END;
END ReadConv;
PROCEDURE Convert(from, to: Address; ssize, dsize: Address; flags: Flags);
TYPE
Bytes = ARRAY 8 OF CHAR;
Pointer = POINTER TO Bytes;
VAR
dest, source: Pointer;
dindex, sindex: INTEGER;
nonzero: BOOLEAN;
fill : CHAR;
BEGIN
IF ssize > 0 THEN
dest := SYS.VAL(Pointer, to);
source := SYS.VAL(Pointer, from);
dindex := 0; sindex := 0;
IF boolean IN flags THEN
nonzero := FALSE;
WHILE ssize > 0 DO
nonzero := nonzero OR (source[sindex] # 0X);
INC(sindex); ssize := SYS.VAL (INTEGER, ssize) - 1;
END;
IF dsize > 0 THEN
IF nonzero THEN
dest[dindex] := 1X;
ELSE
dest[dindex] := 0X;
END;
dsize := dsize - 1; INC (dindex);
END;
WHILE dsize > 0 DO
dest[dindex] := 0X;
dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex);
END;
ELSE
WHILE (dsize > 0) & (ssize > 0) DO
dest[dindex] := source[sindex];
ssize := SYS.VAL (INTEGER, ssize) - 1;
dsize := dsize - 1;
INC(dindex); INC(sindex);
END;
IF dsize > 0 THEN
(* sindex has been incremented at least once because
* ssize and dsize were greater than 0, i.e. sindex-1
* is a valid inex. *)
fill := 0X;
IF ~(unsigned IN flags) & (source[sindex-1] >= 080X) THEN
fill := 0FFX;
END;
END;
WHILE dsize > 0 DO
dest[dindex] := fill;
dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex);
END;
END;
END;
END Convert;
PROCEDURE ByAddrToC*(from, to: Address; format: ARRAY OF CHAR);
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO
Convert(from + offset1, to + offset2, size1, size2, flags);
END;
Close(cv);
END ByAddrToC;
PROCEDURE ByAddrFromC*(from, to: Address; format: ARRAY OF CHAR);
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO
Convert(from + offset2, to + offset1, size2, size1, flags);
END;
Close(cv);
END ByAddrFromC;
PROCEDURE CSize*(format: ARRAY OF CHAR) : Size;
(* returns the size of the C-structure described by `format' *)
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
size: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END;
Close(cv);
size := offset2 + size2;
Align(size, 2);
RETURN size
END CSize;
PROCEDURE OberonSize*(format: ARRAY OF CHAR) : Size;
(* returns the size of the Oberon-structure described by `format' *)
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
size: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END;
Close(cv);
size := offset1 + size1;
Align(size, SIZE(INTEGER));
RETURN size
END OberonSize;
PROCEDURE ToC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR);
BEGIN
IF OberonSize(format) > LEN(from) THEN
SizeError("Oberon record is too small", format); RETURN
END;
IF CSize(format) > LEN(to) THEN
SizeError("C structure is too small", format); RETURN
END;
ByAddrToC(SYS.ADR(from), SYS.ADR(to), format);
END ToC;
PROCEDURE FromC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR);
BEGIN
IF OberonSize(format) > LEN(to) THEN
SizeError("Oberon record is too small", format); RETURN
END;
IF CSize(format) > LEN(from) THEN
SizeError("C structure is too small", format); RETURN
END;
ByAddrFromC(SYS.ADR(from), SYS.ADR(to), format);
END FromC;
PROCEDURE Compile*(VAR fmt: Format; format: ARRAY OF CHAR);
(* translate format into an internal representation
which is later referenced by fmt;
ByFmtToC and ByFmtFromC are faster than ToC and FromC
*)
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
flags: Flags;
element: Format;
head, tail: Format;
BEGIN
Open(cv, format);
head := NIL; tail := NIL;
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO
NEW(element);
element.offset1 := offset1;
element.offset2 := offset2;
element.size1 := size1;
element.size2 := size2;
element.flags := flags;
element.next := NIL;
IF tail # NIL THEN
tail.next := element;
ELSE
head := element;
END;
tail := element;
END;
fmt := head;
Close(cv);
END Compile;
PROCEDURE ByFmtAndAddrToC*(from, to: Address; format: Format);
VAR
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
WHILE format # NIL DO
Convert(from + format.offset1, to + format.offset2,
format.size1, format.size2, format.flags);
format := format.next;
END;
END ByFmtAndAddrToC;
PROCEDURE ByFmtAndAddrFromC*(from, to: Address; format: Format);
VAR
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
WHILE format # NIL DO
Convert(from + format.offset2, to + format.offset1,
format.size2, format.size1, format.flags);
format := format.next;
END;
END ByFmtAndAddrFromC;
PROCEDURE ByFmtToC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format);
BEGIN
ByFmtAndAddrToC(SYS.ADR(from), SYS.ADR(to), format);
END ByFmtToC;
PROCEDURE ByFmtFromC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format);
BEGIN
ByFmtAndAddrFromC(SYS.ADR(from), SYS.ADR(to), format);
END ByFmtFromC;
BEGIN
Events.Define(badformat);
Events.SetPriority(badformat, Priorities.liberrors);
END ulmSysConversions.

200
src/lib/ulm/armv7a_hardfp/ulmSysStat.Mod Normal file
View file

@ -0,0 +1,200 @@
(* Ulm's Oberon Library
Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: SysStat.om,v 1.3 2000/11/12 13:02:09 borchert Exp $
----------------------------------------------------------------------------
$Log: SysStat.om,v $
Revision 1.3 2000/11/12 13:02:09 borchert
door file type added
Revision 1.2 2000/11/12 12:48:07 borchert
- conversion adapted to Solaris 2.x
- Lstat added
Revision 1.1 1994/02/23 08:00:48 borchert
Initial revision
----------------------------------------------------------------------------
AFB 9/89
----------------------------------------------------------------------------
*)
MODULE ulmSysStat;
(* examine inode: stat(2) and fstat(2) *)
IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, SysConversions := ulmSysConversions, SysError := ulmSysErrors,
SysTypes := ulmSysTypes;
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 |
+--------+------+-----+-----+-----+-----+
*)
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 *)
(* special *)
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 *)
(* example for "r-xr-x---": (read + exec) * (owner + group) *)
owner* = {uread, uwrite, uexec};
group* = {gread, gwrite, gexec};
other* = {oread, owrite, oexec};
read* = {uread, gread, oread};
write* = {uwrite, gwrite, owrite};
exec* = {uexec, gexec, oexec};
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 *)
mode*: SET; (* file mode; see mknod(2) *)
nlinks*: INTEGER; (* number of links *)
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;
(* 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 = 88(*64*); (* see <sys/stat.h> *) (* sizeof struct stat gives us 144 on x86_64 and 88 on x86 *)
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";*)
"ls=dev/-s=pad1/lL=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/lL=size/2*lL=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l";
VAR
statbuffmt: SysConversions.Format;
PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
d0, d1, d2: LONGINT;
origbuf: UnixStatRec;
BEGIN
IF SYS.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;
END Stat;
PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
d0, d1: INTEGER;
origbuf: UnixStatRec;
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: INTEGER;
origbuf: UnixStatRec;
BEGIN
IF SYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf)) THEN
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
RETURN TRUE
ELSE
SysErrors.Raise(errors, d0, Sys.newfstat, "");
RETURN FALSE
END;
END Fstat;
BEGIN
SysConversions.Compile(statbuffmt, statbufconv);
END ulmSysStat.

2
src/lib/ulm/armv7a_hardfp/ulmSysTypes.Mod
View file

@ -41,7 +41,7 @@ MODULE ulmSysTypes;
File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *) File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *)
Offset* = LONGINT; Offset* = LONGINT;
Device* = INTEGER; Device* = LONGINT;
Inode* = LONGINT; Inode* = LONGINT;
Time* = LONGINT; Time* = LONGINT;

10
src/lib/ulm/ulmSYSTEM.Mod
View file

@ -3,6 +3,7 @@ IMPORT SYSTEM, Unix, Sys := ulmSys;
TYPE pchar = POINTER TO ARRAY 1 OF CHAR; TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
pstring = POINTER TO ARRAY 1024 OF CHAR; pstring = POINTER TO ARRAY 1024 OF CHAR;
pstatus = POINTER TO Unix.Status;
TYPE bytearray* = ARRAY SIZE(LONGINT) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *) 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; pbytearray* = POINTER TO bytearray;
@ -55,6 +56,7 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
ch : CHAR; ch : CHAR;
pch : pchar; pch : pchar;
pstr : pstring; pstr : pstring;
pst : pstatus;
BEGIN BEGIN
IF syscall = Sys.read THEN IF syscall = Sys.read THEN
@ -103,7 +105,13 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
d0 := Unix.Pipe(arg1); d0 := Unix.Pipe(arg1);
RETURN d0 >= 0; RETURN d0 >= 0;
ELSIF syscall = Sys.newstat THEN ELSIF syscall = Sys.newstat THEN
(*d0 := Unix.Stat(arg1, arg2);*) pst := SYSTEM.VAL(pstatus, arg2);
pstr := SYSTEM.VAL(pstring, arg1);
d0 := Unix.Stat(pstr^, pst^);
RETURN d0 >= 0
ELSIF syscall = Sys.newfstat THEN
pst := SYSTEM.VAL(pstatus, arg2);
d0 := Unix.Fstat(arg1, pst^);
RETURN d0 >= 0; RETURN d0 >= 0;
END END

574
src/lib/ulm/x86/ulmSysConversions.Mod Normal file
View file

@ -0,0 +1,574 @@
(* Ulm's Oberon Library
Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: SysConversi.om,v 1.2 1997/07/30 09:38:16 borchert Exp $
----------------------------------------------------------------------------
$Log: SysConversi.om,v $
Revision 1.2 1997/07/30 09:38:16 borchert
bug in ReadConv fixed: cv.flags was used but not set for
counts > 1
Revision 1.1 1994/02/23 07:58:28 borchert
Initial revision
----------------------------------------------------------------------------
AFB 8/90
adapted to linux cae 02/01
----------------------------------------------------------------------------
*)
MODULE ulmSysConversions;
(* convert Oberon records to/from C structures *)
IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Streams := ulmStreams, Strings := ulmStrings,
SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts;
TYPE
Address* = SysTypes.Address;
Size* = Address;
(* format:
Format = Conversion { "/" Conversion } .
Conversion = [ Factors ] ConvChars [ Comment ] .
Factors = Array | Factor | Array Factor | Factor Array .
Array = Integer ":" .
Factor = Integer "*" .
ConvChars = OberonType CType | Skip CType | OberonType Skip .
OberonType = "a" | "b" | "c" | "s" | "i" | "l" | "S" .
CType = "a" | "c" | "s" | "i" | "l" .
Integer = Digit { Digit } .
Digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" .
Skip = "-" .
Comment = "=" { AnyChar } .
AnyChar = (* all characters except "/" *) .
Oberon data types:
a: Address
b: SYS.BYTE
B: BOOLEAN
c: CHAR
s: SHORTINT
i: INTEGER
l: LONGINT
S: SET
C data types:
a: char *
c: /* signed */ char
C: unsigned char
s: short int
S: unsigned short int
i: int
I: unsigned int
u: unsigned int
l: long int
L: unsigned long int
example:
conversion from
Rec =
RECORD
a, b: INTEGER;
c: CHAR;
s: SET;
f: ARRAY 3 OF INTEGER;
END;
to
struct rec {
short a, b;
char c;
int xx; /* to be skipped on conversion */
int s;
int f[3];
};
or vice versa:
"2*is=a,b/cc=c/-i=xx/Si=s/3:ii=f"
The comments allow to give the field names.
*)
CONST
(* conversion flags *)
unsigned = 0; (* suppress sign extension *)
boolean = 1; (* convert anything # 0 to 1 *)
TYPE
Flags = SET;
Event* = POINTER TO EventRec;
EventRec* =
RECORD
(Events.EventRec)
format*: Events.Message;
END;
ConvStream = POINTER TO ConvStreamRec;
ConvStreamRec =
RECORD
fmt: Texts.Text;
char: CHAR;
eof: BOOLEAN;
(* 1: Oberon type
2: C type
*)
type1, type2: CHAR; length: INTEGER; left: INTEGER;
offset1, offset2: Address;
size1, size2: Address; elementsleft: INTEGER; flags: Flags;
END;
Format* = POINTER TO FormatRec;
FormatRec* =
RECORD
(Objects.ObjectRec)
offset1, offset2: Address;
size1, size2: Address;
flags: Flags;
next: Format;
END;
VAR
badformat*: Events.EventType;
PROCEDURE Error(cv: ConvStream; msg: ARRAY OF CHAR);
VAR
event: Event;
BEGIN
NEW(event);
event.type := badformat;
event.message := "SysConversions: ";
Strings.Concatenate(event.message, msg);
Strings.Read(event.format, cv.fmt);
Events.Raise(event);
cv.eof := TRUE;
cv.char := 0X;
cv.left := 0;
cv.elementsleft := 0;
END Error;
PROCEDURE SizeError(msg, format: ARRAY OF CHAR);
VAR
event: Event;
BEGIN
NEW(event);
event.type := badformat;
event.message := "SysConversions: ";
Strings.Concatenate(event.message, msg);
COPY(format, event.format);
Events.Raise(event);
END SizeError;
PROCEDURE NextCh(cv: ConvStream);
BEGIN
cv.eof := cv.eof OR ~Streams.ReadByte(cv.fmt, cv.char) OR (cv.char = 0X);
IF cv.eof THEN
cv.char := 0X;
END;
END NextCh;
PROCEDURE IsDigit(ch: CHAR) : BOOLEAN;
BEGIN
RETURN (ch >= "0") & (ch <= "9")
END IsDigit;
PROCEDURE ReadInt(cv: ConvStream; VAR i: INTEGER);
BEGIN
i := 0;
REPEAT
i := 10 * i + ORD(cv.char) - ORD("0");
NextCh(cv);
UNTIL ~IsDigit(cv.char);
END ReadInt;
PROCEDURE Open(VAR cv: ConvStream; format: ARRAY OF CHAR);
BEGIN
NEW(cv);
Texts.Open(SYS.VAL(Streams.Stream, cv.fmt));
Strings.Write(cv.fmt, format);
cv.left := 0; cv.elementsleft := 0;
cv.offset1 := 0; cv.offset2 := 0;
cv.eof := FALSE;
NextCh(cv);
END Open;
PROCEDURE Close(VAR cv: ConvStream);
BEGIN
IF ~Streams.Close(cv.fmt) THEN END;
END Close;
PROCEDURE ScanConv(cv: ConvStream;
VAR type1, type2: CHAR;
VAR length: INTEGER) : BOOLEAN;
VAR
i: INTEGER;
factor: INTEGER;
BEGIN
IF cv.left > 0 THEN
type1 := cv.type1;
type2 := cv.type2;
length := cv.length;
DEC(cv.left);
RETURN TRUE
END;
IF cv.char = "/" THEN
NextCh(cv);
END;
IF cv.eof THEN
RETURN FALSE
END;
factor := 0; length := 0;
WHILE IsDigit(cv.char) DO
ReadInt(cv, i);
IF i <= 0 THEN
Error(cv, "integer must be positive"); RETURN FALSE
END;
IF cv.char = ":" THEN
IF length # 0 THEN
Error(cv, "multiple length specification"); RETURN FALSE
END;
length := i;
NextCh(cv);
ELSIF cv.char = "*" THEN
IF factor # 0 THEN
Error(cv, "multiple factor specification"); RETURN FALSE
END;
factor := i; cv.left := factor - 1;
NextCh(cv);
ELSE
Error(cv, "factor or length expected"); RETURN FALSE
END;
END;
type1 := cv.char; NextCh(cv);
type2 := cv.char; NextCh(cv);
IF cv.left > 0 THEN
cv.type1 := type1; cv.type2 := type2; cv.length := length;
END;
IF cv.char = "=" THEN (* comment *)
REPEAT
NextCh(cv);
UNTIL cv.eof OR (cv.char = "/");
END;
RETURN TRUE
END ScanConv;
PROCEDURE Align(VAR offset: Address; boundary: Address);
BEGIN
IF SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary) # 0 THEN
offset := SYS.VAL (INTEGER, offset) + (SYS.VAL (INTEGER, boundary) - SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary));
END;
END Align;
PROCEDURE ReadConv(cv: ConvStream;
VAR offset1, offset2: Address;
VAR size1, size2: Address;
VAR flags: Flags) : BOOLEAN;
VAR
type1, type2: CHAR;
length: INTEGER;
align: BOOLEAN;
boundary: INTEGER;
BEGIN
IF cv.elementsleft > 0 THEN
DEC(cv.elementsleft);
(* Oberon type *)
IF size1 > SIZE(SYS.BYTE) THEN
Align(cv.offset1, SIZE(INTEGER));
END;
offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1;
size1 := cv.size1; size2 := cv.size2; flags := cv.flags;
IF (size1 > 0) & (cv.elementsleft = 0) THEN
Align(cv.offset1, SIZE(INTEGER));
END;
(* C type *)
IF size2 > 1 THEN
Align(cv.offset2, 2);
END;
offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2);
RETURN TRUE
END;
IF ScanConv(cv, type1, type2, length) THEN
flags := {};
(* Oberon type *)
CASE type1 OF
| "a": size1 := SIZE(Address); INCL(flags, unsigned);
| "b": size1 := SIZE(SYS.BYTE); INCL(flags, unsigned);
| "B": size1 := SIZE(BOOLEAN); INCL(flags, boolean);
| "c": size1 := SIZE(CHAR); INCL(flags, unsigned);
| "s": size1 := SIZE(SHORTINT);
| "i": size1 := SIZE(INTEGER);
| "l": size1 := SIZE(LONGINT);
| "S": size1 := SIZE(SET); INCL(flags, unsigned);
| "-": size1 := 0;
ELSE Error(cv, "bad Oberon type specifier"); RETURN FALSE
END;
IF size1 > 0 THEN
IF length > 0 THEN
Align(cv.offset1, SIZE(INTEGER));
ELSIF size1 > SIZE(SYS.BYTE) THEN
Align(cv.offset1, SIZE(INTEGER));
END;
END;
offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1;
(* C type *)
CASE type2 OF
| "a": size2 := 4; 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 := 4; (* long int *)
| "L": size2 := 4; INCL(flags, unsigned); (* long int *)
| "-": size2 := 0;
ELSE Error(cv, "bad C type specifier"); RETURN FALSE
END;
IF size2 > 1 THEN
Align(cv.offset2, size2);
END;
offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2);
cv.size1 := size1; cv.size2 := size2;
IF length > 0 THEN
cv.elementsleft := length - 1;
cv.flags := flags;
END;
RETURN TRUE
ELSE
RETURN FALSE
END;
END ReadConv;
PROCEDURE Convert(from, to: Address; ssize, dsize: Address; flags: Flags);
TYPE
Bytes = ARRAY 8 OF CHAR;
Pointer = POINTER TO Bytes;
VAR
dest, source: Pointer;
dindex, sindex: INTEGER;
nonzero: BOOLEAN;
fill : CHAR;
BEGIN
IF ssize > 0 THEN
dest := SYS.VAL(Pointer, to);
source := SYS.VAL(Pointer, from);
dindex := 0; sindex := 0;
IF boolean IN flags THEN
nonzero := FALSE;
WHILE ssize > 0 DO
nonzero := nonzero OR (source[sindex] # 0X);
INC(sindex); ssize := SYS.VAL (INTEGER, ssize) - 1;
END;
IF dsize > 0 THEN
IF nonzero THEN
dest[dindex] := 1X;
ELSE
dest[dindex] := 0X;
END;
dsize := dsize - 1; INC (dindex);
END;
WHILE dsize > 0 DO
dest[dindex] := 0X;
dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex);
END;
ELSE
WHILE (dsize > 0) & (ssize > 0) DO
dest[dindex] := source[sindex];
ssize := SYS.VAL (INTEGER, ssize) - 1;
dsize := dsize - 1;
INC(dindex); INC(sindex);
END;
IF dsize > 0 THEN
(* sindex has been incremented at least once because
* ssize and dsize were greater than 0, i.e. sindex-1
* is a valid inex. *)
fill := 0X;
IF ~(unsigned IN flags) & (source[sindex-1] >= 080X) THEN
fill := 0FFX;
END;
END;
WHILE dsize > 0 DO
dest[dindex] := fill;
dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex);
END;
END;
END;
END Convert;
PROCEDURE ByAddrToC*(from, to: Address; format: ARRAY OF CHAR);
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO
Convert(from + offset1, to + offset2, size1, size2, flags);
END;
Close(cv);
END ByAddrToC;
PROCEDURE ByAddrFromC*(from, to: Address; format: ARRAY OF CHAR);
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO
Convert(from + offset2, to + offset1, size2, size1, flags);
END;
Close(cv);
END ByAddrFromC;
PROCEDURE CSize*(format: ARRAY OF CHAR) : Size;
(* returns the size of the C-structure described by `format' *)
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
size: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END;
Close(cv);
size := offset2 + size2;
Align(size, 2);
RETURN size
END CSize;
PROCEDURE OberonSize*(format: ARRAY OF CHAR) : Size;
(* returns the size of the Oberon-structure described by `format' *)
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
size: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END;
Close(cv);
size := offset1 + size1;
Align(size, SIZE(INTEGER));
RETURN size
END OberonSize;
PROCEDURE ToC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR);
BEGIN
IF OberonSize(format) > LEN(from) THEN
SizeError("Oberon record is too small", format); RETURN
END;
IF CSize(format) > LEN(to) THEN
SizeError("C structure is too small", format); RETURN
END;
ByAddrToC(SYS.ADR(from), SYS.ADR(to), format);
END ToC;
PROCEDURE FromC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR);
BEGIN
IF OberonSize(format) > LEN(to) THEN
SizeError("Oberon record is too small", format); RETURN
END;
IF CSize(format) > LEN(from) THEN
SizeError("C structure is too small", format); RETURN
END;
ByAddrFromC(SYS.ADR(from), SYS.ADR(to), format);
END FromC;
PROCEDURE Compile*(VAR fmt: Format; format: ARRAY OF CHAR);
(* translate format into an internal representation
which is later referenced by fmt;
ByFmtToC and ByFmtFromC are faster than ToC and FromC
*)
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
flags: Flags;
element: Format;
head, tail: Format;
BEGIN
Open(cv, format);
head := NIL; tail := NIL;
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO
NEW(element);
element.offset1 := offset1;
element.offset2 := offset2;
element.size1 := size1;
element.size2 := size2;
element.flags := flags;
element.next := NIL;
IF tail # NIL THEN
tail.next := element;
ELSE
head := element;
END;
tail := element;
END;
fmt := head;
Close(cv);
END Compile;
PROCEDURE ByFmtAndAddrToC*(from, to: Address; format: Format);
VAR
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
WHILE format # NIL DO
Convert(from + format.offset1, to + format.offset2,
format.size1, format.size2, format.flags);
format := format.next;
END;
END ByFmtAndAddrToC;
PROCEDURE ByFmtAndAddrFromC*(from, to: Address; format: Format);
VAR
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
WHILE format # NIL DO
Convert(from + format.offset2, to + format.offset1,
format.size2, format.size1, format.flags);
format := format.next;
END;
END ByFmtAndAddrFromC;
PROCEDURE ByFmtToC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format);
BEGIN
ByFmtAndAddrToC(SYS.ADR(from), SYS.ADR(to), format);
END ByFmtToC;
PROCEDURE ByFmtFromC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format);
BEGIN
ByFmtAndAddrFromC(SYS.ADR(from), SYS.ADR(to), format);
END ByFmtFromC;
BEGIN
Events.Define(badformat);
Events.SetPriority(badformat, Priorities.liberrors);
END ulmSysConversions.

200
src/lib/ulm/x86/ulmSysStat.Mod Normal file
View file

@ -0,0 +1,200 @@
(* Ulm's Oberon Library
Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: SysStat.om,v 1.3 2000/11/12 13:02:09 borchert Exp $
----------------------------------------------------------------------------
$Log: SysStat.om,v $
Revision 1.3 2000/11/12 13:02:09 borchert
door file type added
Revision 1.2 2000/11/12 12:48:07 borchert
- conversion adapted to Solaris 2.x
- Lstat added
Revision 1.1 1994/02/23 08:00:48 borchert
Initial revision
----------------------------------------------------------------------------
AFB 9/89
----------------------------------------------------------------------------
*)
MODULE ulmSysStat;
(* examine inode: stat(2) and fstat(2) *)
IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, SysConversions := ulmSysConversions, SysError := ulmSysErrors,
SysTypes := ulmSysTypes;
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 |
+--------+------+-----+-----+-----+-----+
*)
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 *)
(* special *)
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 *)
(* example for "r-xr-x---": (read + exec) * (owner + group) *)
owner* = {uread, uwrite, uexec};
group* = {gread, gwrite, gexec};
other* = {oread, owrite, oexec};
read* = {uread, gread, oread};
write* = {uwrite, gwrite, owrite};
exec* = {uexec, gexec, oexec};
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 *)
mode*: SET; (* file mode; see mknod(2) *)
nlinks*: INTEGER; (* number of links *)
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;
(* 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 = 88(*64*); (* see <sys/stat.h> *) (* sizeof struct stat gives us 144 on x86_64 and 88 on x86 *)
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";*)
"ls=dev/-s=pad1/lL=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/lL=size/2*lL=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l";
VAR
statbuffmt: SysConversions.Format;
PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
d0, d1, d2: LONGINT;
origbuf: UnixStatRec;
BEGIN
IF SYS.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;
END Stat;
PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
d0, d1: INTEGER;
origbuf: UnixStatRec;
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: INTEGER;
origbuf: UnixStatRec;
BEGIN
IF SYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf)) THEN
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
RETURN TRUE
ELSE
SysErrors.Raise(errors, d0, Sys.newfstat, "");
RETURN FALSE
END;
END Fstat;
BEGIN
SysConversions.Compile(statbuffmt, statbufconv);
END ulmSysStat.

574
src/lib/ulm/x86_64/ulmSysConversions.Mod Normal file
View file

@ -0,0 +1,574 @@
(* Ulm's Oberon Library
Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: SysConversi.om,v 1.2 1997/07/30 09:38:16 borchert Exp $
----------------------------------------------------------------------------
$Log: SysConversi.om,v $
Revision 1.2 1997/07/30 09:38:16 borchert
bug in ReadConv fixed: cv.flags was used but not set for
counts > 1
Revision 1.1 1994/02/23 07:58:28 borchert
Initial revision
----------------------------------------------------------------------------
AFB 8/90
adapted to linux cae 02/01
----------------------------------------------------------------------------
*)
MODULE ulmSysConversions;
(* convert Oberon records to/from C structures *)
IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Streams := ulmStreams, Strings := ulmStrings,
SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts;
TYPE
Address* = SysTypes.Address;
Size* = Address;
(* format:
Format = Conversion { "/" Conversion } .
Conversion = [ Factors ] ConvChars [ Comment ] .
Factors = Array | Factor | Array Factor | Factor Array .
Array = Integer ":" .
Factor = Integer "*" .
ConvChars = OberonType CType | Skip CType | OberonType Skip .
OberonType = "a" | "b" | "c" | "s" | "i" | "l" | "S" .
CType = "a" | "c" | "s" | "i" | "l" .
Integer = Digit { Digit } .
Digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" .
Skip = "-" .
Comment = "=" { AnyChar } .
AnyChar = (* all characters except "/" *) .
Oberon data types:
a: Address
b: SYS.BYTE
B: BOOLEAN
c: CHAR
s: SHORTINT
i: INTEGER
l: LONGINT
S: SET
C data types:
a: char *
c: /* signed */ char
C: unsigned char
s: short int
S: unsigned short int
i: int
I: unsigned int
u: unsigned int
l: long int
L: unsigned long int
example:
conversion from
Rec =
RECORD
a, b: INTEGER;
c: CHAR;
s: SET;
f: ARRAY 3 OF INTEGER;
END;
to
struct rec {
short a, b;
char c;
int xx; /* to be skipped on conversion */
int s;
int f[3];
};
or vice versa:
"2*is=a,b/cc=c/-i=xx/Si=s/3:ii=f"
The comments allow to give the field names.
*)
CONST
(* conversion flags *)
unsigned = 0; (* suppress sign extension *)
boolean = 1; (* convert anything # 0 to 1 *)
TYPE
Flags = SET;
Event* = POINTER TO EventRec;
EventRec* =
RECORD
(Events.EventRec)
format*: Events.Message;
END;
ConvStream = POINTER TO ConvStreamRec;
ConvStreamRec =
RECORD
fmt: Texts.Text;
char: CHAR;
eof: BOOLEAN;
(* 1: Oberon type
2: C type
*)
type1, type2: CHAR; length: INTEGER; left: INTEGER;
offset1, offset2: Address;
size1, size2: Address; elementsleft: INTEGER; flags: Flags;
END;
Format* = POINTER TO FormatRec;
FormatRec* =
RECORD
(Objects.ObjectRec)
offset1, offset2: Address;
size1, size2: Address;
flags: Flags;
next: Format;
END;
VAR
badformat*: Events.EventType;
PROCEDURE Error(cv: ConvStream; msg: ARRAY OF CHAR);
VAR
event: Event;
BEGIN
NEW(event);
event.type := badformat;
event.message := "SysConversions: ";
Strings.Concatenate(event.message, msg);
Strings.Read(event.format, cv.fmt);
Events.Raise(event);
cv.eof := TRUE;
cv.char := 0X;
cv.left := 0;
cv.elementsleft := 0;
END Error;
PROCEDURE SizeError(msg, format: ARRAY OF CHAR);
VAR
event: Event;
BEGIN
NEW(event);
event.type := badformat;
event.message := "SysConversions: ";
Strings.Concatenate(event.message, msg);
COPY(format, event.format);
Events.Raise(event);
END SizeError;
PROCEDURE NextCh(cv: ConvStream);
BEGIN
cv.eof := cv.eof OR ~Streams.ReadByte(cv.fmt, cv.char) OR (cv.char = 0X);
IF cv.eof THEN
cv.char := 0X;
END;
END NextCh;
PROCEDURE IsDigit(ch: CHAR) : BOOLEAN;
BEGIN
RETURN (ch >= "0") & (ch <= "9")
END IsDigit;
PROCEDURE ReadInt(cv: ConvStream; VAR i: INTEGER);
BEGIN
i := 0;
REPEAT
i := 10 * i + ORD(cv.char) - ORD("0");
NextCh(cv);
UNTIL ~IsDigit(cv.char);
END ReadInt;
PROCEDURE Open(VAR cv: ConvStream; format: ARRAY OF CHAR);
BEGIN
NEW(cv);
Texts.Open(SYS.VAL(Streams.Stream, cv.fmt));
Strings.Write(cv.fmt, format);
cv.left := 0; cv.elementsleft := 0;
cv.offset1 := 0; cv.offset2 := 0;
cv.eof := FALSE;
NextCh(cv);
END Open;
PROCEDURE Close(VAR cv: ConvStream);
BEGIN
IF ~Streams.Close(cv.fmt) THEN END;
END Close;
PROCEDURE ScanConv(cv: ConvStream;
VAR type1, type2: CHAR;
VAR length: INTEGER) : BOOLEAN;
VAR
i: INTEGER;
factor: INTEGER;
BEGIN
IF cv.left > 0 THEN
type1 := cv.type1;
type2 := cv.type2;
length := cv.length;
DEC(cv.left);
RETURN TRUE
END;
IF cv.char = "/" THEN
NextCh(cv);
END;
IF cv.eof THEN
RETURN FALSE
END;
factor := 0; length := 0;
WHILE IsDigit(cv.char) DO
ReadInt(cv, i);
IF i <= 0 THEN
Error(cv, "integer must be positive"); RETURN FALSE
END;
IF cv.char = ":" THEN
IF length # 0 THEN
Error(cv, "multiple length specification"); RETURN FALSE
END;
length := i;
NextCh(cv);
ELSIF cv.char = "*" THEN
IF factor # 0 THEN
Error(cv, "multiple factor specification"); RETURN FALSE
END;
factor := i; cv.left := factor - 1;
NextCh(cv);
ELSE
Error(cv, "factor or length expected"); RETURN FALSE
END;
END;
type1 := cv.char; NextCh(cv);
type2 := cv.char; NextCh(cv);
IF cv.left > 0 THEN
cv.type1 := type1; cv.type2 := type2; cv.length := length;
END;
IF cv.char = "=" THEN (* comment *)
REPEAT
NextCh(cv);
UNTIL cv.eof OR (cv.char = "/");
END;
RETURN TRUE
END ScanConv;
PROCEDURE Align(VAR offset: Address; boundary: Address);
BEGIN
IF SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary) # 0 THEN
offset := SYS.VAL (INTEGER, offset) + (SYS.VAL (INTEGER, boundary) - SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary));
END;
END Align;
PROCEDURE ReadConv(cv: ConvStream;
VAR offset1, offset2: Address;
VAR size1, size2: Address;
VAR flags: Flags) : BOOLEAN;
VAR
type1, type2: CHAR;
length: INTEGER;
align: BOOLEAN;
boundary: INTEGER;
BEGIN
IF cv.elementsleft > 0 THEN
DEC(cv.elementsleft);
(* Oberon type *)
IF size1 > SIZE(SYS.BYTE) THEN
Align(cv.offset1, SIZE(INTEGER));
END;
offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1;
size1 := cv.size1; size2 := cv.size2; flags := cv.flags;
IF (size1 > 0) & (cv.elementsleft = 0) THEN
Align(cv.offset1, SIZE(INTEGER));
END;
(* C type *)
IF size2 > 1 THEN
Align(cv.offset2, 2);
END;
offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2);
RETURN TRUE
END;
IF ScanConv(cv, type1, type2, length) THEN
flags := {};
(* Oberon type *)
CASE type1 OF
| "a": size1 := SIZE(Address); INCL(flags, unsigned);
| "b": size1 := SIZE(SYS.BYTE); INCL(flags, unsigned);
| "B": size1 := SIZE(BOOLEAN); INCL(flags, boolean);
| "c": size1 := SIZE(CHAR); INCL(flags, unsigned);
| "s": size1 := SIZE(SHORTINT);
| "i": size1 := SIZE(INTEGER);
| "l": size1 := SIZE(LONGINT);
| "S": size1 := SIZE(SET); INCL(flags, unsigned);
| "-": size1 := 0;
ELSE Error(cv, "bad Oberon type specifier"); RETURN FALSE
END;
IF size1 > 0 THEN
IF length > 0 THEN
Align(cv.offset1, SIZE(INTEGER));
ELSIF size1 > SIZE(SYS.BYTE) THEN
Align(cv.offset1, SIZE(INTEGER));
END;
END;
offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1;
(* 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;
ELSE Error(cv, "bad C type specifier"); RETURN FALSE
END;
IF size2 > 1 THEN
Align(cv.offset2, size2);
END;
offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2);
cv.size1 := size1; cv.size2 := size2;
IF length > 0 THEN
cv.elementsleft := length - 1;
cv.flags := flags;
END;
RETURN TRUE
ELSE
RETURN FALSE
END;
END ReadConv;
PROCEDURE Convert(from, to: Address; ssize, dsize: Address; flags: Flags);
TYPE
Bytes = ARRAY 8 OF CHAR;
Pointer = POINTER TO Bytes;
VAR
dest, source: Pointer;
dindex, sindex: INTEGER;
nonzero: BOOLEAN;
fill : CHAR;
BEGIN
IF ssize > 0 THEN
dest := SYS.VAL(Pointer, to);
source := SYS.VAL(Pointer, from);
dindex := 0; sindex := 0;
IF boolean IN flags THEN
nonzero := FALSE;
WHILE ssize > 0 DO
nonzero := nonzero OR (source[sindex] # 0X);
INC(sindex); ssize := SYS.VAL (INTEGER, ssize) - 1;
END;
IF dsize > 0 THEN
IF nonzero THEN
dest[dindex] := 1X;
ELSE
dest[dindex] := 0X;
END;
dsize := dsize - 1; INC (dindex);
END;
WHILE dsize > 0 DO
dest[dindex] := 0X;
dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex);
END;
ELSE
WHILE (dsize > 0) & (ssize > 0) DO
dest[dindex] := source[sindex];
ssize := SYS.VAL (INTEGER, ssize) - 1;
dsize := dsize - 1;
INC(dindex); INC(sindex);
END;
IF dsize > 0 THEN
(* sindex has been incremented at least once because
* ssize and dsize were greater than 0, i.e. sindex-1
* is a valid inex. *)
fill := 0X;
IF ~(unsigned IN flags) & (source[sindex-1] >= 080X) THEN
fill := 0FFX;
END;
END;
WHILE dsize > 0 DO
dest[dindex] := fill;
dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex);
END;
END;
END;
END Convert;
PROCEDURE ByAddrToC*(from, to: Address; format: ARRAY OF CHAR);
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO
Convert(from + offset1, to + offset2, size1, size2, flags);
END;
Close(cv);
END ByAddrToC;
PROCEDURE ByAddrFromC*(from, to: Address; format: ARRAY OF CHAR);
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO
Convert(from + offset2, to + offset1, size2, size1, flags);
END;
Close(cv);
END ByAddrFromC;
PROCEDURE CSize*(format: ARRAY OF CHAR) : Size;
(* returns the size of the C-structure described by `format' *)
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
size: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END;
Close(cv);
size := offset2 + size2;
Align(size, 2);
RETURN size
END CSize;
PROCEDURE OberonSize*(format: ARRAY OF CHAR) : Size;
(* returns the size of the Oberon-structure described by `format' *)
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
size: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END;
Close(cv);
size := offset1 + size1;
Align(size, SIZE(INTEGER));
RETURN size
END OberonSize;
PROCEDURE ToC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR);
BEGIN
IF OberonSize(format) > LEN(from) THEN
SizeError("Oberon record is too small", format); RETURN
END;
IF CSize(format) > LEN(to) THEN
SizeError("C structure is too small", format); RETURN
END;
ByAddrToC(SYS.ADR(from), SYS.ADR(to), format);
END ToC;
PROCEDURE FromC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR);
BEGIN
IF OberonSize(format) > LEN(to) THEN
SizeError("Oberon record is too small", format); RETURN
END;
IF CSize(format) > LEN(from) THEN
SizeError("C structure is too small", format); RETURN
END;
ByAddrFromC(SYS.ADR(from), SYS.ADR(to), format);
END FromC;
PROCEDURE Compile*(VAR fmt: Format; format: ARRAY OF CHAR);
(* translate format into an internal representation
which is later referenced by fmt;
ByFmtToC and ByFmtFromC are faster than ToC and FromC
*)
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
flags: Flags;
element: Format;
head, tail: Format;
BEGIN
Open(cv, format);
head := NIL; tail := NIL;
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO
NEW(element);
element.offset1 := offset1;
element.offset2 := offset2;
element.size1 := size1;
element.size2 := size2;
element.flags := flags;
element.next := NIL;
IF tail # NIL THEN
tail.next := element;
ELSE
head := element;
END;
tail := element;
END;
fmt := head;
Close(cv);
END Compile;
PROCEDURE ByFmtAndAddrToC*(from, to: Address; format: Format);
VAR
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
WHILE format # NIL DO
Convert(from + format.offset1, to + format.offset2,
format.size1, format.size2, format.flags);
format := format.next;
END;
END ByFmtAndAddrToC;
PROCEDURE ByFmtAndAddrFromC*(from, to: Address; format: Format);
VAR
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
WHILE format # NIL DO
Convert(from + format.offset2, to + format.offset1,
format.size2, format.size1, format.flags);
format := format.next;
END;
END ByFmtAndAddrFromC;
PROCEDURE ByFmtToC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format);
BEGIN
ByFmtAndAddrToC(SYS.ADR(from), SYS.ADR(to), format);
END ByFmtToC;
PROCEDURE ByFmtFromC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format);
BEGIN
ByFmtAndAddrFromC(SYS.ADR(from), SYS.ADR(to), format);
END ByFmtFromC;
BEGIN
Events.Define(badformat);
Events.SetPriority(badformat, Priorities.liberrors);
END ulmSysConversions.

227
src/lib/ulm/x86_64/ulmSysStat.Mod Normal file
View file

@ -0,0 +1,227 @@
(* Ulm's Oberon Library
Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: SysStat.om,v 1.3 2000/11/12 13:02:09 borchert Exp $
----------------------------------------------------------------------------
$Log: SysStat.om,v $
Revision 1.3 2000/11/12 13:02:09 borchert
door file type added
Revision 1.2 2000/11/12 12:48:07 borchert
- conversion adapted to Solaris 2.x
- Lstat added
Revision 1.1 1994/02/23 08:00:48 borchert
Initial revision
----------------------------------------------------------------------------
AFB 9/89
----------------------------------------------------------------------------
*)
MODULE ulmSysStat;
(* examine inode: stat(2) and fstat(2) *)
IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, uSYS := ulmSYSTEM, SysConversions := ulmSysConversions, SysErrors := ulmSysErrors,
SysTypes := ulmSysTypes;
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 |
+--------+------+-----+-----+-----+-----+
*)
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 *)
(* special *)
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 *)
(* example for "r-xr-x---": (read + exec) * (owner + group) *)
owner* = {uread, uwrite, uexec};
group* = {gread, gwrite, gexec};
other* = {oread, owrite, oexec};
read* = {uread, gread, oread};
write* = {uwrite, gwrite, owrite};
exec* = {uexec, gexec, oexec};
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* = (* 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 Stat*(path: ARRAY OF CHAR; VAR buf: StatRec;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
d0, d1, d2: LONGINT;
origbuf: UnixStatRec;
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;
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;
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;
END Fstat;
BEGIN
SysConversions.Compile(statbuffmt, statbufconv);
END ulmSysStat.