mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 06:22:25 +00:00
Consolidate ulm library files.
This commit is contained in:
David Brown
parent
e4309559f3
commit
d6d9666713
20 changed files with 0 additions and 3345 deletions
|
|
@ -1,137 +0,0 @@
|
||||||
MODULE ulmSYSTEM;
|
|
||||||
IMPORT SYSTEM, Unix, Sys := ulmSys;
|
|
||||||
|
|
||||||
TYPE pchar = POINTER TO ARRAY 1 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 *)
|
|
||||||
pbytearray* = POINTER TO bytearray;
|
|
||||||
TYPE longrealarray* = ARRAY SIZE(LONGREAL) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *)
|
|
||||||
plongrealarray* = POINTER TO bytearray;
|
|
||||||
|
|
||||||
PROCEDURE LongToByteArr* ( l : LONGINT; VAR bar : bytearray); (* noch *)
|
|
||||||
VAR b : SYSTEM.BYTE;
|
|
||||||
p : pbytearray;
|
|
||||||
i : LONGINT;
|
|
||||||
BEGIN
|
|
||||||
p := SYSTEM.VAL(pbytearray, SYSTEM.ADR(l));
|
|
||||||
FOR i := 0 TO SIZE(LONGINT) -1 DO
|
|
||||||
b := p^[i]; bar[i] := b;
|
|
||||||
END
|
|
||||||
END LongToByteArr;
|
|
||||||
|
|
||||||
PROCEDURE LRealToByteArr* ( l : LONGREAL; VAR lar : longrealarray); (* noch *)
|
|
||||||
VAR b : SYSTEM.BYTE;
|
|
||||||
p : plongrealarray;
|
|
||||||
i : LONGINT;
|
|
||||||
BEGIN
|
|
||||||
p := SYSTEM.VAL(plongrealarray, SYSTEM.ADR(l));
|
|
||||||
FOR i := 0 TO SIZE(LONGREAL) -1 DO
|
|
||||||
b := p^[i]; lar[i] := b;
|
|
||||||
END
|
|
||||||
END LRealToByteArr;
|
|
||||||
|
|
||||||
|
|
||||||
(*
|
|
||||||
PROCEDURE -Write(adr, n: LONGINT): LONGINT
|
|
||||||
"write(1/*stdout*/, adr, n)";
|
|
||||||
|
|
||||||
PROCEDURE -read(VAR ch: CHAR): LONGINT
|
|
||||||
"read(0/*stdin*/, ch, 1)";
|
|
||||||
*)
|
|
||||||
|
|
||||||
PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *)
|
|
||||||
VAR oldflag : BOOLEAN;
|
|
||||||
BEGIN
|
|
||||||
oldflag := flag;
|
|
||||||
flag := TRUE;
|
|
||||||
RETURN oldflag;
|
|
||||||
END TAS;
|
|
||||||
|
|
||||||
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;
|
|
||||||
BEGIN
|
|
||||||
|
|
||||||
IF syscall = Sys.read THEN
|
|
||||||
d0 := Unix.Read(arg1, arg2, arg3);
|
|
||||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
|
||||||
(*NEW(pch);
|
|
||||||
pch := SYSTEM.VAL(pchar, arg2);
|
|
||||||
ch := pch^[0];
|
|
||||||
n := read(ch);
|
|
||||||
IF n # 1 THEN
|
|
||||||
ch := 0X;
|
|
||||||
RETURN FALSE
|
|
||||||
ELSE
|
|
||||||
pch^[0] := ch;
|
|
||||||
RETURN TRUE
|
|
||||||
END;
|
|
||||||
*)
|
|
||||||
ELSIF syscall = Sys.write THEN
|
|
||||||
d0 := Unix.Write(arg1, arg2, arg3);
|
|
||||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
|
||||||
(*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^, SYSTEM.VAL(SET, arg3), SYSTEM.VAL(SET, arg2));
|
|
||||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
|
||||||
ELSIF syscall = Sys.close THEN
|
|
||||||
d0 := Unix.Close(arg1);
|
|
||||||
IF d0 = 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
|
||||||
ELSIF syscall = Sys.lseek THEN
|
|
||||||
d0 := Unix.Lseek(arg1, arg2, arg3);
|
|
||||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
|
||||||
ELSIF syscall = Sys.ioctl THEN
|
|
||||||
d0 := Unix.Ioctl(arg1, arg2, arg3);
|
|
||||||
RETURN d0 >= 0;
|
|
||||||
ELSIF syscall = Sys.fcntl THEN
|
|
||||||
d0 := Unix.Fcntl (arg1, arg2, arg3);
|
|
||||||
RETURN d0 >= 0;
|
|
||||||
ELSIF syscall = Sys.dup THEN
|
|
||||||
d0 := Unix.Dup(arg1);
|
|
||||||
RETURN d0 > 0;
|
|
||||||
ELSIF syscall = Sys.pipe THEN
|
|
||||||
d0 := Unix.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^);
|
|
||||||
RETURN d0 >= 0
|
|
||||||
ELSIF syscall = Sys.newfstat THEN
|
|
||||||
pst := SYSTEM.VAL(pstatus, arg2);
|
|
||||||
d0 := Unix.Fstat(arg1, pst^);
|
|
||||||
RETURN d0 >= 0;
|
|
||||||
END
|
|
||||||
|
|
||||||
END UNIXCALL;
|
|
||||||
|
|
||||||
|
|
||||||
PROCEDURE UNIXFORK(VAR pid: LONGINT) : BOOLEAN;
|
|
||||||
BEGIN
|
|
||||||
|
|
||||||
END UNIXFORK;
|
|
||||||
|
|
||||||
PROCEDURE UNIXSIGNAL(signo: INTEGER; p: PROCEDURE;
|
|
||||||
VAR old: PROCEDURE; VAR error: INTEGER) : BOOLEAN;
|
|
||||||
BEGIN
|
|
||||||
|
|
||||||
END UNIXSIGNAL;
|
|
||||||
|
|
||||||
PROCEDURE WMOVE*(from, to, n : LONGINT);
|
|
||||||
VAR l : LONGINT;
|
|
||||||
BEGIN
|
|
||||||
SYSTEM.MOVE(from, to, n);
|
|
||||||
END WMOVE;
|
|
||||||
END ulmSYSTEM.
|
|
||||||
|
|
@ -1,574 +0,0 @@
|
||||||
(* 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.
|
|
||||||
|
|
@ -1,201 +0,0 @@
|
||||||
(* 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 *)
|
|
||||||
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 *)
|
|
||||||
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";*)
|
|
||||||
"ll=dev/-l=devx/-s=pad1/ll=ino/Sl=mode/ll=nlink/ll=uid/ll=gid/ll=rdev/-l=rdevx/-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 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;
|
|
||||||
(*
|
|
||||||
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.
|
|
||||||
|
|
@ -1,133 +0,0 @@
|
||||||
(* Ulm's Oberon Library
|
|
||||||
Copyright (C) 1989-2000 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: Types.om,v 1.5 2000/12/13 10:03:00 borchert Exp $
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
$Log: Types.om,v $
|
|
||||||
Revision 1.5 2000/12/13 10:03:00 borchert
|
|
||||||
SetInt type used in msb constant
|
|
||||||
|
|
||||||
Revision 1.4 2000/12/13 09:51:57 borchert
|
|
||||||
constants and types for the relationship of INTEGER and SET added
|
|
||||||
|
|
||||||
Revision 1.3 1998/09/25 15:23:09 borchert
|
|
||||||
Real32..Real128 added
|
|
||||||
|
|
||||||
Revision 1.2 1994/07/01 11:08:04 borchert
|
|
||||||
IntAddress, Int8/16/32, ToInt8/16/32 and bit/little endian stuff added
|
|
||||||
|
|
||||||
Revision 1.1 1994/02/22 20:12:14 borchert
|
|
||||||
Initial revision
|
|
||||||
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
AFB 9/93
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
*)
|
|
||||||
|
|
||||||
MODULE ulmTypes;
|
|
||||||
|
|
||||||
(* compiler-dependent type definitions;
|
|
||||||
this version works for Ulm's Oberon Compilers on
|
|
||||||
following architectures: m68k and sparc
|
|
||||||
*)
|
|
||||||
|
|
||||||
IMPORT SYS := SYSTEM;
|
|
||||||
|
|
||||||
TYPE
|
|
||||||
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;*)
|
|
||||||
UntracedAddressDesc* = RECORD[1] END;
|
|
||||||
Count* = LONGINT;
|
|
||||||
Size* = Count;
|
|
||||||
Byte* = SYS.BYTE;
|
|
||||||
IntAddress* = LONGINT;
|
|
||||||
Int8* = SHORTINT;
|
|
||||||
Int16* = INTEGER;
|
|
||||||
Int32* = LONGINT;
|
|
||||||
Real32* = REAL;
|
|
||||||
Real64* = LONGREAL;
|
|
||||||
|
|
||||||
CONST
|
|
||||||
bigEndian* = 0; (* SPARC, M68K etc *)
|
|
||||||
littleEndian* = 1; (* Intel 80x86, VAX etc *)
|
|
||||||
byteorder* = littleEndian; (* machine-dependent constant *)
|
|
||||||
TYPE
|
|
||||||
ByteOrder* = SHORTINT; (* bigEndian or littleEndian *)
|
|
||||||
|
|
||||||
(* following constants and type definitions try to make
|
|
||||||
conversions from INTEGER to SET and vice versa more portable
|
|
||||||
to allow for bit operations on INTEGER values
|
|
||||||
*)
|
|
||||||
TYPE
|
|
||||||
SetInt* = LONGINT; (* INTEGER type that corresponds to SET *)
|
|
||||||
VAR msb* : SET;
|
|
||||||
msbIsMax*, msbIs0*: SHORTINT;
|
|
||||||
msbindex*, lsbindex*, nofbits*: LONGINT;
|
|
||||||
|
|
||||||
PROCEDURE ToInt8*(int: LONGINT) : Int8;
|
|
||||||
BEGIN
|
|
||||||
RETURN SHORT(SHORT(int))
|
|
||||||
END ToInt8;
|
|
||||||
|
|
||||||
PROCEDURE ToInt16*(int: LONGINT) : Int16;
|
|
||||||
BEGIN
|
|
||||||
RETURN SYS.VAL(Int16, int)
|
|
||||||
END ToInt16;
|
|
||||||
|
|
||||||
PROCEDURE ToInt32*(int: LONGINT) : Int32;
|
|
||||||
BEGIN
|
|
||||||
RETURN int
|
|
||||||
END ToInt32;
|
|
||||||
|
|
||||||
PROCEDURE ToReal32*(real: LONGREAL) : Real32;
|
|
||||||
BEGIN
|
|
||||||
RETURN SHORT(real)
|
|
||||||
END ToReal32;
|
|
||||||
|
|
||||||
PROCEDURE ToReal64*(real: LONGREAL) : Real64;
|
|
||||||
BEGIN
|
|
||||||
RETURN real
|
|
||||||
END ToReal64;
|
|
||||||
|
|
||||||
BEGIN
|
|
||||||
msb := SYS.VAL(SET, MIN(SetInt));
|
|
||||||
(* most significant bit, converted to a SET *)
|
|
||||||
(* we expect msbIsMax XOR msbIs0 to be 1;
|
|
||||||
this is checked for by an assertion
|
|
||||||
*)
|
|
||||||
msbIsMax := SYS.VAL(SHORTINT, (msb = {MAX(SET)}));
|
|
||||||
(* is 1, if msb equals {MAX(SET)} *)
|
|
||||||
msbIs0 := SYS.VAL(SHORTINT, (msb = {0}));
|
|
||||||
(* is 0, if msb equals {0} *)
|
|
||||||
msbindex := msbIsMax * MAX(SET);
|
|
||||||
(* set element that corresponds to the most-significant-bit *)
|
|
||||||
lsbindex := MAX(SET) - msbindex;
|
|
||||||
(* set element that corresponds to the lowest-significant-bit *)
|
|
||||||
nofbits := MAX(SET) + 1;
|
|
||||||
(* number of elements in SETs *)
|
|
||||||
|
|
||||||
ASSERT((msbIs0 = 1) & (msbIsMax = 0) OR (msbIs0 = 0) & (msbIsMax = 1));
|
|
||||||
END ulmTypes.
|
|
||||||
|
|
@ -1,137 +0,0 @@
|
||||||
MODULE ulmSYSTEM;
|
|
||||||
IMPORT SYSTEM, Unix, Sys := ulmSys;
|
|
||||||
|
|
||||||
TYPE pchar = POINTER TO ARRAY 1 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 *)
|
|
||||||
pbytearray* = POINTER TO bytearray;
|
|
||||||
TYPE longrealarray* = ARRAY SIZE(LONGREAL) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *)
|
|
||||||
plongrealarray* = POINTER TO bytearray;
|
|
||||||
|
|
||||||
PROCEDURE LongToByteArr* ( l : LONGINT; VAR bar : bytearray); (* noch *)
|
|
||||||
VAR b : SYSTEM.BYTE;
|
|
||||||
p : pbytearray;
|
|
||||||
i : LONGINT;
|
|
||||||
BEGIN
|
|
||||||
p := SYSTEM.VAL(pbytearray, SYSTEM.ADR(l));
|
|
||||||
FOR i := 0 TO SIZE(LONGINT) -1 DO
|
|
||||||
b := p^[i]; bar[i] := b;
|
|
||||||
END
|
|
||||||
END LongToByteArr;
|
|
||||||
|
|
||||||
PROCEDURE LRealToByteArr* ( l : LONGREAL; VAR lar : longrealarray); (* noch *)
|
|
||||||
VAR b : SYSTEM.BYTE;
|
|
||||||
p : plongrealarray;
|
|
||||||
i : LONGINT;
|
|
||||||
BEGIN
|
|
||||||
p := SYSTEM.VAL(plongrealarray, SYSTEM.ADR(l));
|
|
||||||
FOR i := 0 TO SIZE(LONGREAL) -1 DO
|
|
||||||
b := p^[i]; lar[i] := b;
|
|
||||||
END
|
|
||||||
END LRealToByteArr;
|
|
||||||
|
|
||||||
|
|
||||||
(*
|
|
||||||
PROCEDURE -Write(adr, n: LONGINT): LONGINT
|
|
||||||
"write(1/*stdout*/, adr, n)";
|
|
||||||
|
|
||||||
PROCEDURE -read(VAR ch: CHAR): LONGINT
|
|
||||||
"read(0/*stdin*/, ch, 1)";
|
|
||||||
*)
|
|
||||||
|
|
||||||
PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *)
|
|
||||||
VAR oldflag : BOOLEAN;
|
|
||||||
BEGIN
|
|
||||||
oldflag := flag;
|
|
||||||
flag := TRUE;
|
|
||||||
RETURN oldflag;
|
|
||||||
END TAS;
|
|
||||||
|
|
||||||
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;
|
|
||||||
BEGIN
|
|
||||||
|
|
||||||
IF syscall = Sys.read THEN
|
|
||||||
d0 := Unix.Read(arg1, arg2, arg3);
|
|
||||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
|
||||||
(*NEW(pch);
|
|
||||||
pch := SYSTEM.VAL(pchar, arg2);
|
|
||||||
ch := pch^[0];
|
|
||||||
n := read(ch);
|
|
||||||
IF n # 1 THEN
|
|
||||||
ch := 0X;
|
|
||||||
RETURN FALSE
|
|
||||||
ELSE
|
|
||||||
pch^[0] := ch;
|
|
||||||
RETURN TRUE
|
|
||||||
END;
|
|
||||||
*)
|
|
||||||
ELSIF syscall = Sys.write THEN
|
|
||||||
d0 := Unix.Write(arg1, arg2, arg3);
|
|
||||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
|
||||||
(*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^, SYSTEM.VAL(SET, arg3), SYSTEM.VAL(SET, arg2));
|
|
||||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
|
||||||
ELSIF syscall = Sys.close THEN
|
|
||||||
d0 := Unix.Close(arg1);
|
|
||||||
IF d0 = 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
|
||||||
ELSIF syscall = Sys.lseek THEN
|
|
||||||
d0 := Unix.Lseek(arg1, arg2, arg3);
|
|
||||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
|
||||||
ELSIF syscall = Sys.ioctl THEN
|
|
||||||
d0 := Unix.Ioctl(arg1, arg2, arg3);
|
|
||||||
RETURN d0 >= 0;
|
|
||||||
ELSIF syscall = Sys.fcntl THEN
|
|
||||||
d0 := Unix.Fcntl (arg1, arg2, arg3);
|
|
||||||
RETURN d0 >= 0;
|
|
||||||
ELSIF syscall = Sys.dup THEN
|
|
||||||
d0 := Unix.Dup(arg1);
|
|
||||||
RETURN d0 > 0;
|
|
||||||
ELSIF syscall = Sys.pipe THEN
|
|
||||||
d0 := Unix.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^);
|
|
||||||
RETURN d0 >= 0
|
|
||||||
ELSIF syscall = Sys.newfstat THEN
|
|
||||||
pst := SYSTEM.VAL(pstatus, arg2);
|
|
||||||
d0 := Unix.Fstat(arg1, pst^);
|
|
||||||
RETURN d0 >= 0;
|
|
||||||
END
|
|
||||||
|
|
||||||
END UNIXCALL;
|
|
||||||
|
|
||||||
|
|
||||||
PROCEDURE UNIXFORK(VAR pid: LONGINT) : BOOLEAN;
|
|
||||||
BEGIN
|
|
||||||
|
|
||||||
END UNIXFORK;
|
|
||||||
|
|
||||||
PROCEDURE UNIXSIGNAL(signo: INTEGER; p: PROCEDURE;
|
|
||||||
VAR old: PROCEDURE; VAR error: INTEGER) : BOOLEAN;
|
|
||||||
BEGIN
|
|
||||||
|
|
||||||
END UNIXSIGNAL;
|
|
||||||
|
|
||||||
PROCEDURE WMOVE*(from, to, n : LONGINT);
|
|
||||||
VAR l : LONGINT;
|
|
||||||
BEGIN
|
|
||||||
SYSTEM.MOVE(from, to, n);
|
|
||||||
END WMOVE;
|
|
||||||
END ulmSYSTEM.
|
|
||||||
|
|
@ -1,574 +0,0 @@
|
||||||
(* 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.
|
|
||||||
|
|
@ -1,201 +0,0 @@
|
||||||
(* 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 *)
|
|
||||||
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 *)
|
|
||||||
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";*)
|
|
||||||
"ll=dev/-l=devx/-s=pad1/ll=ino/Sl=mode/ll=nlink/ll=uid/ll=gid/ll=rdev/-l=rdevx/-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 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;
|
|
||||||
(*
|
|
||||||
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.
|
|
||||||
|
|
@ -1,70 +0,0 @@
|
||||||
(* 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: SysTypes.om,v 1.1 1994/02/23 08:01:38 borchert Exp $
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
$Log: SysTypes.om,v $
|
|
||||||
Revision 1.1 1994/02/23 08:01:38 borchert
|
|
||||||
Initial revision
|
|
||||||
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
AFB 9/89
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
*)
|
|
||||||
|
|
||||||
MODULE ulmSysTypes;
|
|
||||||
|
|
||||||
IMPORT Types := ulmTypes;
|
|
||||||
|
|
||||||
TYPE
|
|
||||||
Address* = Types.Address;
|
|
||||||
UntracedAddress* = Types.UntracedAddress;
|
|
||||||
Count* = Types.Count;
|
|
||||||
Size* = Types.Size;
|
|
||||||
Byte* = Types.Byte;
|
|
||||||
|
|
||||||
File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *)
|
|
||||||
Offset* = LONGINT;
|
|
||||||
Device* = LONGINT;
|
|
||||||
Inode* = LONGINT;
|
|
||||||
Time* = LONGINT;
|
|
||||||
|
|
||||||
Word* = INTEGER; (* must have the size of C's int-type *)
|
|
||||||
|
|
||||||
(* Note: linux supports wait4 but not waitid, i.e. these
|
|
||||||
* constants aren't needed. *)
|
|
||||||
(*
|
|
||||||
CONST
|
|
||||||
(* possible values of the idtype parameter (4 bytes),
|
|
||||||
see <sys/procset.h>
|
|
||||||
*)
|
|
||||||
idPid = 0; (* a process identifier *)
|
|
||||||
idPpid = 1; (* a parent process identifier *)
|
|
||||||
idPgid = 2; (* a process group (job control group) identifier *)
|
|
||||||
idSid = 3; (* a session identifier *)
|
|
||||||
idCid = 4; (* a scheduling class identifier *)
|
|
||||||
idUid = 5; (* a user identifier *)
|
|
||||||
idGid = 6; (* a group identifier *)
|
|
||||||
idAll = 7; (* all processes *)
|
|
||||||
idLwpid = 8; (* an LWP identifier *)
|
|
||||||
TYPE
|
|
||||||
IdType = INTEGER; (* idPid .. idLwpid *)
|
|
||||||
*)
|
|
||||||
|
|
||||||
END ulmSysTypes.
|
|
||||||
|
|
@ -1,133 +0,0 @@
|
||||||
(* Ulm's Oberon Library
|
|
||||||
Copyright (C) 1989-2000 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: Types.om,v 1.5 2000/12/13 10:03:00 borchert Exp $
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
$Log: Types.om,v $
|
|
||||||
Revision 1.5 2000/12/13 10:03:00 borchert
|
|
||||||
SetInt type used in msb constant
|
|
||||||
|
|
||||||
Revision 1.4 2000/12/13 09:51:57 borchert
|
|
||||||
constants and types for the relationship of INTEGER and SET added
|
|
||||||
|
|
||||||
Revision 1.3 1998/09/25 15:23:09 borchert
|
|
||||||
Real32..Real128 added
|
|
||||||
|
|
||||||
Revision 1.2 1994/07/01 11:08:04 borchert
|
|
||||||
IntAddress, Int8/16/32, ToInt8/16/32 and bit/little endian stuff added
|
|
||||||
|
|
||||||
Revision 1.1 1994/02/22 20:12:14 borchert
|
|
||||||
Initial revision
|
|
||||||
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
AFB 9/93
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
*)
|
|
||||||
|
|
||||||
MODULE ulmTypes;
|
|
||||||
|
|
||||||
(* compiler-dependent type definitions;
|
|
||||||
this version works for Ulm's Oberon Compilers on
|
|
||||||
following architectures: m68k and sparc
|
|
||||||
*)
|
|
||||||
|
|
||||||
IMPORT SYS := SYSTEM;
|
|
||||||
|
|
||||||
TYPE
|
|
||||||
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;*)
|
|
||||||
UntracedAddressDesc* = RECORD[1] END;
|
|
||||||
Count* = LONGINT;
|
|
||||||
Size* = Count;
|
|
||||||
Byte* = SYS.BYTE;
|
|
||||||
IntAddress* = LONGINT;
|
|
||||||
Int8* = SHORTINT;
|
|
||||||
Int16* = INTEGER;
|
|
||||||
Int32* = LONGINT;
|
|
||||||
Real32* = REAL;
|
|
||||||
Real64* = LONGREAL;
|
|
||||||
|
|
||||||
CONST
|
|
||||||
bigEndian* = 0; (* SPARC, M68K etc *)
|
|
||||||
littleEndian* = 1; (* Intel 80x86, VAX etc *)
|
|
||||||
byteorder* = bigEndian; (* machine-dependent constant *)
|
|
||||||
TYPE
|
|
||||||
ByteOrder* = SHORTINT; (* bigEndian or littleEndian *)
|
|
||||||
|
|
||||||
(* following constants and type definitions try to make
|
|
||||||
conversions from INTEGER to SET and vice versa more portable
|
|
||||||
to allow for bit operations on INTEGER values
|
|
||||||
*)
|
|
||||||
TYPE
|
|
||||||
SetInt* = LONGINT; (* INTEGER type that corresponds to SET *)
|
|
||||||
VAR msb* : SET;
|
|
||||||
msbIsMax*, msbIs0*: SHORTINT;
|
|
||||||
msbindex*, lsbindex*, nofbits*: LONGINT;
|
|
||||||
|
|
||||||
PROCEDURE ToInt8*(int: LONGINT) : Int8;
|
|
||||||
BEGIN
|
|
||||||
RETURN SHORT(SHORT(int))
|
|
||||||
END ToInt8;
|
|
||||||
|
|
||||||
PROCEDURE ToInt16*(int: LONGINT) : Int16;
|
|
||||||
BEGIN
|
|
||||||
RETURN SYS.VAL(Int16, int)
|
|
||||||
END ToInt16;
|
|
||||||
|
|
||||||
PROCEDURE ToInt32*(int: LONGINT) : Int32;
|
|
||||||
BEGIN
|
|
||||||
RETURN int
|
|
||||||
END ToInt32;
|
|
||||||
|
|
||||||
PROCEDURE ToReal32*(real: LONGREAL) : Real32;
|
|
||||||
BEGIN
|
|
||||||
RETURN SHORT(real)
|
|
||||||
END ToReal32;
|
|
||||||
|
|
||||||
PROCEDURE ToReal64*(real: LONGREAL) : Real64;
|
|
||||||
BEGIN
|
|
||||||
RETURN real
|
|
||||||
END ToReal64;
|
|
||||||
|
|
||||||
BEGIN
|
|
||||||
msb := SYS.VAL(SET, MIN(SetInt));
|
|
||||||
(* most significant bit, converted to a SET *)
|
|
||||||
(* we expect msbIsMax XOR msbIs0 to be 1;
|
|
||||||
this is checked for by an assertion
|
|
||||||
*)
|
|
||||||
msbIsMax := SYS.VAL(SHORTINT, (msb = {MAX(SET)}));
|
|
||||||
(* is 1, if msb equals {MAX(SET)} *)
|
|
||||||
msbIs0 := SYS.VAL(SHORTINT, (msb = {0}));
|
|
||||||
(* is 0, if msb equals {0} *)
|
|
||||||
msbindex := msbIsMax * MAX(SET);
|
|
||||||
(* set element that corresponds to the most-significant-bit *)
|
|
||||||
lsbindex := MAX(SET) - msbindex;
|
|
||||||
(* set element that corresponds to the lowest-significant-bit *)
|
|
||||||
nofbits := MAX(SET) + 1;
|
|
||||||
(* number of elements in SETs *)
|
|
||||||
|
|
||||||
ASSERT((msbIs0 = 1) & (msbIsMax = 0) OR (msbIs0 = 0) & (msbIsMax = 1));
|
|
||||||
END ulmTypes.
|
|
||||||
|
|
@ -1,137 +0,0 @@
|
||||||
MODULE ulmSYSTEM;
|
|
||||||
IMPORT SYSTEM, Unix, Sys := ulmSys;
|
|
||||||
|
|
||||||
TYPE pchar = POINTER TO ARRAY 1 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 *)
|
|
||||||
pbytearray* = POINTER TO bytearray;
|
|
||||||
TYPE longrealarray* = ARRAY SIZE(LONGREAL) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *)
|
|
||||||
plongrealarray* = POINTER TO bytearray;
|
|
||||||
|
|
||||||
PROCEDURE LongToByteArr* ( l : LONGINT; VAR bar : bytearray); (* noch *)
|
|
||||||
VAR b : SYSTEM.BYTE;
|
|
||||||
p : pbytearray;
|
|
||||||
i : LONGINT;
|
|
||||||
BEGIN
|
|
||||||
p := SYSTEM.VAL(pbytearray, SYSTEM.ADR(l));
|
|
||||||
FOR i := 0 TO SIZE(LONGINT) -1 DO
|
|
||||||
b := p^[i]; bar[i] := b;
|
|
||||||
END
|
|
||||||
END LongToByteArr;
|
|
||||||
|
|
||||||
PROCEDURE LRealToByteArr* ( l : LONGREAL; VAR lar : longrealarray); (* noch *)
|
|
||||||
VAR b : SYSTEM.BYTE;
|
|
||||||
p : plongrealarray;
|
|
||||||
i : LONGINT;
|
|
||||||
BEGIN
|
|
||||||
p := SYSTEM.VAL(plongrealarray, SYSTEM.ADR(l));
|
|
||||||
FOR i := 0 TO SIZE(LONGREAL) -1 DO
|
|
||||||
b := p^[i]; lar[i] := b;
|
|
||||||
END
|
|
||||||
END LRealToByteArr;
|
|
||||||
|
|
||||||
|
|
||||||
(*
|
|
||||||
PROCEDURE -Write(adr, n: LONGINT): LONGINT
|
|
||||||
"write(1/*stdout*/, adr, n)";
|
|
||||||
|
|
||||||
PROCEDURE -read(VAR ch: CHAR): LONGINT
|
|
||||||
"read(0/*stdin*/, ch, 1)";
|
|
||||||
*)
|
|
||||||
|
|
||||||
PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *)
|
|
||||||
VAR oldflag : BOOLEAN;
|
|
||||||
BEGIN
|
|
||||||
oldflag := flag;
|
|
||||||
flag := TRUE;
|
|
||||||
RETURN oldflag;
|
|
||||||
END TAS;
|
|
||||||
|
|
||||||
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;
|
|
||||||
BEGIN
|
|
||||||
|
|
||||||
IF syscall = Sys.read THEN
|
|
||||||
d0 := Unix.Read(arg1, arg2, arg3);
|
|
||||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
|
||||||
(*NEW(pch);
|
|
||||||
pch := SYSTEM.VAL(pchar, arg2);
|
|
||||||
ch := pch^[0];
|
|
||||||
n := read(ch);
|
|
||||||
IF n # 1 THEN
|
|
||||||
ch := 0X;
|
|
||||||
RETURN FALSE
|
|
||||||
ELSE
|
|
||||||
pch^[0] := ch;
|
|
||||||
RETURN TRUE
|
|
||||||
END;
|
|
||||||
*)
|
|
||||||
ELSIF syscall = Sys.write THEN
|
|
||||||
d0 := Unix.Write(arg1, arg2, arg3);
|
|
||||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
|
||||||
(*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^, SYSTEM.VAL(SET, arg3), SYSTEM.VAL(SET, arg2));
|
|
||||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
|
||||||
ELSIF syscall = Sys.close THEN
|
|
||||||
d0 := Unix.Close(arg1);
|
|
||||||
IF d0 = 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
|
||||||
ELSIF syscall = Sys.lseek THEN
|
|
||||||
d0 := Unix.Lseek(arg1, arg2, arg3);
|
|
||||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
|
||||||
ELSIF syscall = Sys.ioctl THEN
|
|
||||||
d0 := Unix.Ioctl(arg1, arg2, arg3);
|
|
||||||
RETURN d0 >= 0;
|
|
||||||
ELSIF syscall = Sys.fcntl THEN
|
|
||||||
d0 := Unix.Fcntl (arg1, arg2, arg3);
|
|
||||||
RETURN d0 >= 0;
|
|
||||||
ELSIF syscall = Sys.dup THEN
|
|
||||||
d0 := Unix.Dup(arg1);
|
|
||||||
RETURN d0 > 0;
|
|
||||||
ELSIF syscall = Sys.pipe THEN
|
|
||||||
d0 := Unix.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^);
|
|
||||||
RETURN d0 >= 0
|
|
||||||
ELSIF syscall = Sys.newfstat THEN
|
|
||||||
pst := SYSTEM.VAL(pstatus, arg2);
|
|
||||||
d0 := Unix.Fstat(arg1, pst^);
|
|
||||||
RETURN d0 >= 0;
|
|
||||||
END
|
|
||||||
|
|
||||||
END UNIXCALL;
|
|
||||||
|
|
||||||
|
|
||||||
PROCEDURE UNIXFORK(VAR pid: LONGINT) : BOOLEAN;
|
|
||||||
BEGIN
|
|
||||||
|
|
||||||
END UNIXFORK;
|
|
||||||
|
|
||||||
PROCEDURE UNIXSIGNAL(signo: INTEGER; p: PROCEDURE;
|
|
||||||
VAR old: PROCEDURE; VAR error: INTEGER) : BOOLEAN;
|
|
||||||
BEGIN
|
|
||||||
|
|
||||||
END UNIXSIGNAL;
|
|
||||||
|
|
||||||
PROCEDURE WMOVE*(from, to, n : LONGINT);
|
|
||||||
VAR l : LONGINT;
|
|
||||||
BEGIN
|
|
||||||
SYSTEM.MOVE(from, to, n);
|
|
||||||
END WMOVE;
|
|
||||||
END ulmSYSTEM.
|
|
||||||
|
|
@ -1,574 +0,0 @@
|
||||||
(* 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.
|
|
||||||
|
|
@ -1,201 +0,0 @@
|
||||||
(* 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 *)
|
|
||||||
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 *)
|
|
||||||
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";*)
|
|
||||||
"ll=dev/-l=devx/-s=pad1/ll=ino/Sl=mode/ll=nlink/ll=uid/ll=gid/ll=rdev/-l=rdevx/-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 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;
|
|
||||||
(*
|
|
||||||
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.
|
|
||||||
|
|
@ -1,70 +0,0 @@
|
||||||
(* 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: SysTypes.om,v 1.1 1994/02/23 08:01:38 borchert Exp $
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
$Log: SysTypes.om,v $
|
|
||||||
Revision 1.1 1994/02/23 08:01:38 borchert
|
|
||||||
Initial revision
|
|
||||||
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
AFB 9/89
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
*)
|
|
||||||
|
|
||||||
MODULE ulmSysTypes;
|
|
||||||
|
|
||||||
IMPORT Types := ulmTypes;
|
|
||||||
|
|
||||||
TYPE
|
|
||||||
Address* = Types.Address;
|
|
||||||
UntracedAddress* = Types.UntracedAddress;
|
|
||||||
Count* = Types.Count;
|
|
||||||
Size* = Types.Size;
|
|
||||||
Byte* = Types.Byte;
|
|
||||||
|
|
||||||
File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *)
|
|
||||||
Offset* = LONGINT;
|
|
||||||
Device* = LONGINT;
|
|
||||||
Inode* = LONGINT;
|
|
||||||
Time* = LONGINT;
|
|
||||||
|
|
||||||
Word* = INTEGER; (* must have the size of C's int-type *)
|
|
||||||
|
|
||||||
(* Note: linux supports wait4 but not waitid, i.e. these
|
|
||||||
* constants aren't needed. *)
|
|
||||||
(*
|
|
||||||
CONST
|
|
||||||
(* possible values of the idtype parameter (4 bytes),
|
|
||||||
see <sys/procset.h>
|
|
||||||
*)
|
|
||||||
idPid = 0; (* a process identifier *)
|
|
||||||
idPpid = 1; (* a parent process identifier *)
|
|
||||||
idPgid = 2; (* a process group (job control group) identifier *)
|
|
||||||
idSid = 3; (* a session identifier *)
|
|
||||||
idCid = 4; (* a scheduling class identifier *)
|
|
||||||
idUid = 5; (* a user identifier *)
|
|
||||||
idGid = 6; (* a group identifier *)
|
|
||||||
idAll = 7; (* all processes *)
|
|
||||||
idLwpid = 8; (* an LWP identifier *)
|
|
||||||
TYPE
|
|
||||||
IdType = INTEGER; (* idPid .. idLwpid *)
|
|
||||||
*)
|
|
||||||
|
|
||||||
END ulmSysTypes.
|
|
||||||
|
|
@ -1,133 +0,0 @@
|
||||||
(* Ulm's Oberon Library
|
|
||||||
Copyright (C) 1989-2000 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: Types.om,v 1.5 2000/12/13 10:03:00 borchert Exp $
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
$Log: Types.om,v $
|
|
||||||
Revision 1.5 2000/12/13 10:03:00 borchert
|
|
||||||
SetInt type used in msb constant
|
|
||||||
|
|
||||||
Revision 1.4 2000/12/13 09:51:57 borchert
|
|
||||||
constants and types for the relationship of INTEGER and SET added
|
|
||||||
|
|
||||||
Revision 1.3 1998/09/25 15:23:09 borchert
|
|
||||||
Real32..Real128 added
|
|
||||||
|
|
||||||
Revision 1.2 1994/07/01 11:08:04 borchert
|
|
||||||
IntAddress, Int8/16/32, ToInt8/16/32 and bit/little endian stuff added
|
|
||||||
|
|
||||||
Revision 1.1 1994/02/22 20:12:14 borchert
|
|
||||||
Initial revision
|
|
||||||
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
AFB 9/93
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
*)
|
|
||||||
|
|
||||||
MODULE ulmTypes;
|
|
||||||
|
|
||||||
(* compiler-dependent type definitions;
|
|
||||||
this version works for Ulm's Oberon Compilers on
|
|
||||||
following architectures: m68k and sparc
|
|
||||||
*)
|
|
||||||
|
|
||||||
IMPORT SYS := SYSTEM;
|
|
||||||
|
|
||||||
TYPE
|
|
||||||
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;*)
|
|
||||||
UntracedAddressDesc* = RECORD[1] END;
|
|
||||||
Count* = LONGINT;
|
|
||||||
Size* = Count;
|
|
||||||
Byte* = SYS.BYTE;
|
|
||||||
IntAddress* = LONGINT;
|
|
||||||
Int8* = SHORTINT;
|
|
||||||
Int16* = INTEGER;
|
|
||||||
Int32* = LONGINT;
|
|
||||||
Real32* = REAL;
|
|
||||||
Real64* = LONGREAL;
|
|
||||||
|
|
||||||
CONST
|
|
||||||
bigEndian* = 0; (* SPARC, M68K etc *)
|
|
||||||
littleEndian* = 1; (* Intel 80x86, VAX etc *)
|
|
||||||
byteorder* = littleEndian; (* machine-dependent constant *)
|
|
||||||
TYPE
|
|
||||||
ByteOrder* = SHORTINT; (* bigEndian or littleEndian *)
|
|
||||||
|
|
||||||
(* following constants and type definitions try to make
|
|
||||||
conversions from INTEGER to SET and vice versa more portable
|
|
||||||
to allow for bit operations on INTEGER values
|
|
||||||
*)
|
|
||||||
TYPE
|
|
||||||
SetInt* = LONGINT; (* INTEGER type that corresponds to SET *)
|
|
||||||
VAR msb* : SET;
|
|
||||||
msbIsMax*, msbIs0*: SHORTINT;
|
|
||||||
msbindex*, lsbindex*, nofbits*: LONGINT;
|
|
||||||
|
|
||||||
PROCEDURE ToInt8*(int: LONGINT) : Int8;
|
|
||||||
BEGIN
|
|
||||||
RETURN SHORT(SHORT(int))
|
|
||||||
END ToInt8;
|
|
||||||
|
|
||||||
PROCEDURE ToInt16*(int: LONGINT) : Int16;
|
|
||||||
BEGIN
|
|
||||||
RETURN SYS.VAL(Int16, int)
|
|
||||||
END ToInt16;
|
|
||||||
|
|
||||||
PROCEDURE ToInt32*(int: LONGINT) : Int32;
|
|
||||||
BEGIN
|
|
||||||
RETURN int
|
|
||||||
END ToInt32;
|
|
||||||
|
|
||||||
PROCEDURE ToReal32*(real: LONGREAL) : Real32;
|
|
||||||
BEGIN
|
|
||||||
RETURN SHORT(real)
|
|
||||||
END ToReal32;
|
|
||||||
|
|
||||||
PROCEDURE ToReal64*(real: LONGREAL) : Real64;
|
|
||||||
BEGIN
|
|
||||||
RETURN real
|
|
||||||
END ToReal64;
|
|
||||||
|
|
||||||
BEGIN
|
|
||||||
msb := SYS.VAL(SET, MIN(SetInt));
|
|
||||||
(* most significant bit, converted to a SET *)
|
|
||||||
(* we expect msbIsMax XOR msbIs0 to be 1;
|
|
||||||
this is checked for by an assertion
|
|
||||||
*)
|
|
||||||
msbIsMax := SYS.VAL(SHORTINT, (msb = {MAX(SET)}));
|
|
||||||
(* is 1, if msb equals {MAX(SET)} *)
|
|
||||||
msbIs0 := SYS.VAL(SHORTINT, (msb = {0}));
|
|
||||||
(* is 0, if msb equals {0} *)
|
|
||||||
msbindex := msbIsMax * MAX(SET);
|
|
||||||
(* set element that corresponds to the most-significant-bit *)
|
|
||||||
lsbindex := MAX(SET) - msbindex;
|
|
||||||
(* set element that corresponds to the lowest-significant-bit *)
|
|
||||||
nofbits := MAX(SET) + 1;
|
|
||||||
(* number of elements in SETs *)
|
|
||||||
|
|
||||||
ASSERT((msbIs0 = 1) & (msbIsMax = 0) OR (msbIs0 = 0) & (msbIsMax = 1));
|
|
||||||
END ulmTypes.
|
|
||||||
|
|
@ -1,70 +0,0 @@
|
||||||
(* 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: SysTypes.om,v 1.1 1994/02/23 08:01:38 borchert Exp $
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
$Log: SysTypes.om,v $
|
|
||||||
Revision 1.1 1994/02/23 08:01:38 borchert
|
|
||||||
Initial revision
|
|
||||||
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
AFB 9/89
|
|
||||||
----------------------------------------------------------------------------
|
|
||||||
*)
|
|
||||||
|
|
||||||
MODULE ulmSysTypes;
|
|
||||||
|
|
||||||
IMPORT Types := ulmTypes;
|
|
||||||
|
|
||||||
TYPE
|
|
||||||
Address* = Types.Address;
|
|
||||||
UntracedAddress* = Types.UntracedAddress;
|
|
||||||
Count* = Types.Count;
|
|
||||||
Size* = Types.Size;
|
|
||||||
Byte* = Types.Byte;
|
|
||||||
|
|
||||||
File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *)
|
|
||||||
Offset* = LONGINT;
|
|
||||||
Device* = LONGINT;
|
|
||||||
Inode* = LONGINT;
|
|
||||||
Time* = LONGINT;
|
|
||||||
|
|
||||||
Word* = INTEGER; (* must have the size of C's int-type *)
|
|
||||||
|
|
||||||
(* Note: linux supports wait4 but not waitid, i.e. these
|
|
||||||
* constants aren't needed. *)
|
|
||||||
(*
|
|
||||||
CONST
|
|
||||||
(* possible values of the idtype parameter (4 bytes),
|
|
||||||
see <sys/procset.h>
|
|
||||||
*)
|
|
||||||
idPid = 0; (* a process identifier *)
|
|
||||||
idPpid = 1; (* a parent process identifier *)
|
|
||||||
idPgid = 2; (* a process group (job control group) identifier *)
|
|
||||||
idSid = 3; (* a session identifier *)
|
|
||||||
idCid = 4; (* a scheduling class identifier *)
|
|
||||||
idUid = 5; (* a user identifier *)
|
|
||||||
idGid = 6; (* a group identifier *)
|
|
||||||
idAll = 7; (* all processes *)
|
|
||||||
idLwpid = 8; (* an LWP identifier *)
|
|
||||||
TYPE
|
|
||||||
IdType = INTEGER; (* idPid .. idLwpid *)
|
|
||||||
*)
|
|
||||||
|
|
||||||
END ulmSysTypes.
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue