From 13ea84f2cd1bb296fc4bdfff369dc1660eb9098b Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Tue, 5 Nov 2013 22:05:20 +0400 Subject: [PATCH] SysStat, SysConversions ported Former-commit-id: d2c954e16f4b0b7b4a09c88b04588803e12c7566 --- makefile | 1 + .../ulm/{ => armv6j}/ulmSysConversions.Mod | 0 src/lib/ulm/armv6j/ulmSysStat.Mod | 200 ++++++ src/lib/ulm/armv6j/ulmSysTypes.Mod | 2 +- .../ulm/armv6j_hardfp/ulmSysConversions.Mod | 574 ++++++++++++++++++ src/lib/ulm/armv6j_hardfp/ulmSysStat.Mod | 200 ++++++ src/lib/ulm/armv6j_hardfp/ulmSysTypes.Mod | 2 +- .../ulm/armv7a_hardfp/ulmSysConversions.Mod | 574 ++++++++++++++++++ src/lib/ulm/armv7a_hardfp/ulmSysStat.Mod | 200 ++++++ src/lib/ulm/armv7a_hardfp/ulmSysTypes.Mod | 2 +- src/lib/ulm/ulmSYSTEM.Mod | 10 +- src/lib/ulm/x86/ulmSysConversions.Mod | 574 ++++++++++++++++++ src/lib/ulm/x86/ulmSysStat.Mod | 200 ++++++ src/lib/ulm/x86_64/ulmSysConversions.Mod | 574 ++++++++++++++++++ src/lib/ulm/x86_64/ulmSysStat.Mod | 227 +++++++ 15 files changed, 3336 insertions(+), 4 deletions(-) rename src/lib/ulm/{ => armv6j}/ulmSysConversions.Mod (100%) create mode 100644 src/lib/ulm/armv6j/ulmSysStat.Mod create mode 100644 src/lib/ulm/armv6j_hardfp/ulmSysConversions.Mod create mode 100644 src/lib/ulm/armv6j_hardfp/ulmSysStat.Mod create mode 100644 src/lib/ulm/armv7a_hardfp/ulmSysConversions.Mod create mode 100644 src/lib/ulm/armv7a_hardfp/ulmSysStat.Mod create mode 100644 src/lib/ulm/x86/ulmSysConversions.Mod create mode 100644 src/lib/ulm/x86/ulmSysStat.Mod create mode 100644 src/lib/ulm/x86_64/ulmSysConversions.Mod create mode 100644 src/lib/ulm/x86_64/ulmSysStat.Mod diff --git a/makefile b/makefile index 7663424d..69a01dfa 100644 --- a/makefile +++ b/makefile @@ -204,6 +204,7 @@ stage6: $(VOCSTATIC) -sP ulmStreamConditions.Mod $(VOCSTATIC) -sP ulmTimeConditions.Mod $(VOCSTATIC) -sP ulmSysConversions.Mod + $(VOCSTATIC) -sP ulmSysStat.Mod #pow32 libs diff --git a/src/lib/ulm/ulmSysConversions.Mod b/src/lib/ulm/armv6j/ulmSysConversions.Mod similarity index 100% rename from src/lib/ulm/ulmSysConversions.Mod rename to src/lib/ulm/armv6j/ulmSysConversions.Mod diff --git a/src/lib/ulm/armv6j/ulmSysStat.Mod b/src/lib/ulm/armv6j/ulmSysStat.Mod new file mode 100644 index 00000000..d995779e --- /dev/null +++ b/src/lib/ulm/armv6j/ulmSysStat.Mod @@ -0,0 +1,200 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: SysStat.om,v 1.3 2000/11/12 13:02:09 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: SysStat.om,v $ + Revision 1.3 2000/11/12 13:02:09 borchert + door file type added + + Revision 1.2 2000/11/12 12:48:07 borchert + - conversion adapted to Solaris 2.x + - Lstat added + + Revision 1.1 1994/02/23 08:00:48 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 9/89 + ---------------------------------------------------------------------------- +*) + +MODULE ulmSysStat; + + (* examine inode: stat(2) and fstat(2) *) + + IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, SysConversions := ulmSysConversions, SysError := ulmSysErrors, + SysTypes := ulmSysTypes; + + CONST + (* file mode: + bit 0 = 1<<0 bit 31 = 1<<31 + + user group other + 3 1 1111 11 + 1 ... 6 5432 109 876 543 210 + +--------+------+-----+-----+-----+-----+ + | unused | type | sst | rwx | rwx | rwx | + +--------+------+-----+-----+-----+-----+ + *) + + type* = {12..15}; + prot* = {0..8}; + + (* file types; example: (stat.mode * type = dir) *) + reg* = {15}; (* regular *) + dir* = {14}; (* directory *) + chr* = {13}; (* character special *) + fifo* = {12}; (* fifo *) + blk* = {13..14}; (* block special *) + symlink* = {13, 15}; (* symbolic link *) + socket* = {14, 15}; (* socket *) + + (* special *) + setuid* = 11; (* set user id on execution *) + setgid* = 10; (* set group id on execution *) + savetext* = 9; (* save swapped text even after use *) + + (* protection *) + uread* = 8; (* read permission owner *) + uwrite* = 7; (* write permission owner *) + uexec* = 6; (* execute/search permission owner *) + gread* = 5; (* read permission group *) + gwrite* = 4; (* write permission group *) + gexec* = 3; (* execute/search permission group *) + oread* = 2; (* read permission other *) + owrite* = 1; (* write permission other *) + oexec* = 0; (* execute/search permission other *) + + (* example for "r-xr-x---": (read + exec) * (owner + group) *) + owner* = {uread, uwrite, uexec}; + group* = {gread, gwrite, gexec}; + other* = {oread, owrite, oexec}; + read* = {uread, gread, oread}; + write* = {uwrite, gwrite, owrite}; + exec* = {uexec, gexec, oexec}; + rwx* = prot; + + TYPE + StatRec* = (* result of stat(2) and fstat(2) *) + RECORD + device*: SysTypes.Device; (* ID of device containing + a directory entry for this file *) + inode*: SysTypes.Inode; (* inode number *) + mode*: SET; (* file mode; see mknod(2) *) + nlinks*: INTEGER; (* number of links *) + uid*: INTEGER; (* user id of the file's owner *) + gid*: INTEGER; (* group id of the file's group *) + rdev*: SysTypes.Device; (* ID of device + this entry is defined only for + character special or block + special files + *) + size*: SysTypes.Offset; (* file size in bytes *) + blksize*: LONGINT; (* preferred blocksize *) + blocks*: LONGINT; (* # of blocks allocated *) + atime*: SysTypes.Time; (* time of last access *) + mtime*: SysTypes.Time; (* time of last data modification *) + ctime*: SysTypes.Time; (* time of last file status change *) + END; + +(* Linux kernel struct stat (2.2.17) + struct stat { + unsigned short st_dev; + unsigned short __pad1; + unsigned long st_ino; + unsigned short st_mode; + unsigned short st_nlink; + unsigned short st_uid; + unsigned short st_gid; + unsigned short st_rdev; + unsigned short __pad2; + unsigned long st_size; + unsigned long st_blksize; + unsigned long st_blocks; + unsigned long st_atime; + unsigned long __unused1; + unsigned long st_mtime; + unsigned long __unused2; + unsigned long st_ctime; + unsigned long __unused3; + unsigned long __unused4; + unsigned long __unused5; + }; +*) + + CONST + statbufsize = 88(*64*); (* see *) (* sizeof struct stat gives us 144 on x86_64 and 88 on x86 *) + TYPE + UnixStatRec = ARRAY statbufsize OF SYS.BYTE; + CONST + statbufconv = + (*"is=dev/-s=pad1/ll=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/ll=size/2*ll=blksize,blocks/il=atime/-l/il=mtime/-l/il=ctime/3*-l";*) + "ls=dev/-s=pad1/lL=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/lL=size/2*lL=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l"; + VAR + statbuffmt: SysConversions.Format; + + PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1, d2: LONGINT; + origbuf: UnixStatRec; + BEGIN + IF SYS.UNIXCALL(Sys.newstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf), d2) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newstat, path); + RETURN FALSE + END; + END Stat; + + PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1: INTEGER; + origbuf: UnixStatRec; + BEGIN + IF SYS.UNIXCALL(Sys.newlstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf)) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newlstat, path); + RETURN FALSE + END; + END Lstat; + + PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1: INTEGER; + origbuf: UnixStatRec; + BEGIN + IF SYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf)) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newfstat, ""); + RETURN FALSE + END; + END Fstat; + +BEGIN + SysConversions.Compile(statbuffmt, statbufconv); +END ulmSysStat. diff --git a/src/lib/ulm/armv6j/ulmSysTypes.Mod b/src/lib/ulm/armv6j/ulmSysTypes.Mod index a614c67b..174140e7 100644 --- a/src/lib/ulm/armv6j/ulmSysTypes.Mod +++ b/src/lib/ulm/armv6j/ulmSysTypes.Mod @@ -41,7 +41,7 @@ MODULE ulmSysTypes; File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *) Offset* = LONGINT; - Device* = INTEGER; + Device* = LONGINT; Inode* = LONGINT; Time* = LONGINT; diff --git a/src/lib/ulm/armv6j_hardfp/ulmSysConversions.Mod b/src/lib/ulm/armv6j_hardfp/ulmSysConversions.Mod new file mode 100644 index 00000000..f8ea3fbb --- /dev/null +++ b/src/lib/ulm/armv6j_hardfp/ulmSysConversions.Mod @@ -0,0 +1,574 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: SysConversi.om,v 1.2 1997/07/30 09:38:16 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: SysConversi.om,v $ + Revision 1.2 1997/07/30 09:38:16 borchert + bug in ReadConv fixed: cv.flags was used but not set for + counts > 1 + + Revision 1.1 1994/02/23 07:58:28 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 8/90 + adapted to linux cae 02/01 + ---------------------------------------------------------------------------- +*) + +MODULE ulmSysConversions; + + (* convert Oberon records to/from C structures *) + + IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Streams := ulmStreams, Strings := ulmStrings, + SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts; + + TYPE + Address* = SysTypes.Address; + Size* = Address; + + (* format: + + Format = Conversion { "/" Conversion } . + Conversion = [ Factors ] ConvChars [ Comment ] . + Factors = Array | Factor | Array Factor | Factor Array . + Array = Integer ":" . + Factor = Integer "*" . + ConvChars = OberonType CType | Skip CType | OberonType Skip . + OberonType = "a" | "b" | "c" | "s" | "i" | "l" | "S" . + CType = "a" | "c" | "s" | "i" | "l" . + Integer = Digit { Digit } . + Digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" . + Skip = "-" . + Comment = "=" { AnyChar } . + AnyChar = (* all characters except "/" *) . + + Oberon data types: + + a: Address + b: SYS.BYTE + B: BOOLEAN + c: CHAR + s: SHORTINT + i: INTEGER + l: LONGINT + S: SET + + C data types: + + a: char * + c: /* signed */ char + C: unsigned char + s: short int + S: unsigned short int + i: int + I: unsigned int + u: unsigned int + l: long int + L: unsigned long int + + example: + + conversion from + + Rec = + RECORD + a, b: INTEGER; + c: CHAR; + s: SET; + f: ARRAY 3 OF INTEGER; + END; + + to + + struct rec { + short a, b; + char c; + int xx; /* to be skipped on conversion */ + int s; + int f[3]; + }; + + or vice versa: + + "2*is=a,b/cc=c/-i=xx/Si=s/3:ii=f" + + The comments allow to give the field names. + *) + + CONST + (* conversion flags *) + unsigned = 0; (* suppress sign extension *) + boolean = 1; (* convert anything # 0 to 1 *) + TYPE + Flags = SET; + Event* = POINTER TO EventRec; + EventRec* = + RECORD + (Events.EventRec) + format*: Events.Message; + END; + ConvStream = POINTER TO ConvStreamRec; + ConvStreamRec = + RECORD + fmt: Texts.Text; + char: CHAR; + eof: BOOLEAN; + (* 1: Oberon type + 2: C type + *) + type1, type2: CHAR; length: INTEGER; left: INTEGER; + offset1, offset2: Address; + size1, size2: Address; elementsleft: INTEGER; flags: Flags; + END; + + Format* = POINTER TO FormatRec; + FormatRec* = + RECORD + (Objects.ObjectRec) + offset1, offset2: Address; + size1, size2: Address; + flags: Flags; + next: Format; + END; + VAR + badformat*: Events.EventType; + + PROCEDURE Error(cv: ConvStream; msg: ARRAY OF CHAR); + VAR + event: Event; + BEGIN + NEW(event); + event.type := badformat; + event.message := "SysConversions: "; + Strings.Concatenate(event.message, msg); + Strings.Read(event.format, cv.fmt); + Events.Raise(event); + cv.eof := TRUE; + cv.char := 0X; + cv.left := 0; + cv.elementsleft := 0; + END Error; + + PROCEDURE SizeError(msg, format: ARRAY OF CHAR); + VAR + event: Event; + BEGIN + NEW(event); + event.type := badformat; + event.message := "SysConversions: "; + Strings.Concatenate(event.message, msg); + COPY(format, event.format); + Events.Raise(event); + END SizeError; + + PROCEDURE NextCh(cv: ConvStream); + BEGIN + cv.eof := cv.eof OR ~Streams.ReadByte(cv.fmt, cv.char) OR (cv.char = 0X); + IF cv.eof THEN + cv.char := 0X; + END; + END NextCh; + + PROCEDURE IsDigit(ch: CHAR) : BOOLEAN; + BEGIN + RETURN (ch >= "0") & (ch <= "9") + END IsDigit; + + PROCEDURE ReadInt(cv: ConvStream; VAR i: INTEGER); + BEGIN + i := 0; + REPEAT + i := 10 * i + ORD(cv.char) - ORD("0"); + NextCh(cv); + UNTIL ~IsDigit(cv.char); + END ReadInt; + + PROCEDURE Open(VAR cv: ConvStream; format: ARRAY OF CHAR); + BEGIN + NEW(cv); + Texts.Open(SYS.VAL(Streams.Stream, cv.fmt)); + Strings.Write(cv.fmt, format); + cv.left := 0; cv.elementsleft := 0; + cv.offset1 := 0; cv.offset2 := 0; + cv.eof := FALSE; + NextCh(cv); + END Open; + + PROCEDURE Close(VAR cv: ConvStream); + BEGIN + IF ~Streams.Close(cv.fmt) THEN END; + END Close; + + PROCEDURE ScanConv(cv: ConvStream; + VAR type1, type2: CHAR; + VAR length: INTEGER) : BOOLEAN; + VAR + i: INTEGER; + factor: INTEGER; + BEGIN + IF cv.left > 0 THEN + type1 := cv.type1; + type2 := cv.type2; + length := cv.length; + DEC(cv.left); + RETURN TRUE + END; + IF cv.char = "/" THEN + NextCh(cv); + END; + IF cv.eof THEN + RETURN FALSE + END; + factor := 0; length := 0; + WHILE IsDigit(cv.char) DO + ReadInt(cv, i); + IF i <= 0 THEN + Error(cv, "integer must be positive"); RETURN FALSE + END; + IF cv.char = ":" THEN + IF length # 0 THEN + Error(cv, "multiple length specification"); RETURN FALSE + END; + length := i; + NextCh(cv); + ELSIF cv.char = "*" THEN + IF factor # 0 THEN + Error(cv, "multiple factor specification"); RETURN FALSE + END; + factor := i; cv.left := factor - 1; + NextCh(cv); + ELSE + Error(cv, "factor or length expected"); RETURN FALSE + END; + END; + type1 := cv.char; NextCh(cv); + type2 := cv.char; NextCh(cv); + IF cv.left > 0 THEN + cv.type1 := type1; cv.type2 := type2; cv.length := length; + END; + IF cv.char = "=" THEN (* comment *) + REPEAT + NextCh(cv); + UNTIL cv.eof OR (cv.char = "/"); + END; + RETURN TRUE + END ScanConv; + + PROCEDURE Align(VAR offset: Address; boundary: Address); + BEGIN + IF SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary) # 0 THEN + offset := SYS.VAL (INTEGER, offset) + (SYS.VAL (INTEGER, boundary) - SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary)); + END; + END Align; + + PROCEDURE ReadConv(cv: ConvStream; + VAR offset1, offset2: Address; + VAR size1, size2: Address; + VAR flags: Flags) : BOOLEAN; + VAR + type1, type2: CHAR; + length: INTEGER; + align: BOOLEAN; + boundary: INTEGER; + BEGIN + IF cv.elementsleft > 0 THEN + DEC(cv.elementsleft); + + (* Oberon type *) + IF size1 > SIZE(SYS.BYTE) THEN + Align(cv.offset1, SIZE(INTEGER)); + END; + offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; + size1 := cv.size1; size2 := cv.size2; flags := cv.flags; + IF (size1 > 0) & (cv.elementsleft = 0) THEN + Align(cv.offset1, SIZE(INTEGER)); + END; + + (* C type *) + IF size2 > 1 THEN + Align(cv.offset2, 2); + END; + offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); + + RETURN TRUE + END; + IF ScanConv(cv, type1, type2, length) THEN + flags := {}; + (* Oberon type *) + CASE type1 OF + | "a": size1 := SIZE(Address); INCL(flags, unsigned); + | "b": size1 := SIZE(SYS.BYTE); INCL(flags, unsigned); + | "B": size1 := SIZE(BOOLEAN); INCL(flags, boolean); + | "c": size1 := SIZE(CHAR); INCL(flags, unsigned); + | "s": size1 := SIZE(SHORTINT); + | "i": size1 := SIZE(INTEGER); + | "l": size1 := SIZE(LONGINT); + | "S": size1 := SIZE(SET); INCL(flags, unsigned); + | "-": size1 := 0; + ELSE Error(cv, "bad Oberon type specifier"); RETURN FALSE + END; + IF size1 > 0 THEN + IF length > 0 THEN + Align(cv.offset1, SIZE(INTEGER)); + ELSIF size1 > SIZE(SYS.BYTE) THEN + Align(cv.offset1, SIZE(INTEGER)); + END; + END; + offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; + + (* C type *) + CASE type2 OF + | "a": size2 := 4; INCL(flags, unsigned); (* char* *) + | "c": size2 := 1; (* /* signed */ char *) + | "C": size2 := 1; INCL(flags, unsigned); (* unsigned char *) + | "s": size2 := 2; (* short int *) + | "S": size2 := 2; INCL(flags, unsigned); (* unsigned short int *) + | "i": size2 := 4; (* int *) + | "I": size2 := 4; INCL(flags, unsigned); (* unsigned int *) + | "u": size2 := 4; INCL(flags, unsigned); (* unsigned int *) + | "l": size2 := 4; (* long int *) + | "L": size2 := 4; INCL(flags, unsigned); (* long int *) + | "-": size2 := 0; + ELSE Error(cv, "bad C type specifier"); RETURN FALSE + END; + IF size2 > 1 THEN + Align(cv.offset2, size2); + END; + offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); + + cv.size1 := size1; cv.size2 := size2; + IF length > 0 THEN + cv.elementsleft := length - 1; + cv.flags := flags; + END; + RETURN TRUE + ELSE + RETURN FALSE + END; + END ReadConv; + + PROCEDURE Convert(from, to: Address; ssize, dsize: Address; flags: Flags); + TYPE + Bytes = ARRAY 8 OF CHAR; + Pointer = POINTER TO Bytes; + VAR + dest, source: Pointer; + dindex, sindex: INTEGER; + nonzero: BOOLEAN; + fill : CHAR; + BEGIN + IF ssize > 0 THEN + dest := SYS.VAL(Pointer, to); + source := SYS.VAL(Pointer, from); + dindex := 0; sindex := 0; + IF boolean IN flags THEN + nonzero := FALSE; + WHILE ssize > 0 DO + nonzero := nonzero OR (source[sindex] # 0X); + INC(sindex); ssize := SYS.VAL (INTEGER, ssize) - 1; + END; + IF dsize > 0 THEN + IF nonzero THEN + dest[dindex] := 1X; + ELSE + dest[dindex] := 0X; + END; + dsize := dsize - 1; INC (dindex); + END; + WHILE dsize > 0 DO + dest[dindex] := 0X; + dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); + END; + ELSE + WHILE (dsize > 0) & (ssize > 0) DO + dest[dindex] := source[sindex]; + ssize := SYS.VAL (INTEGER, ssize) - 1; + dsize := dsize - 1; + INC(dindex); INC(sindex); + END; + IF dsize > 0 THEN + (* sindex has been incremented at least once because + * ssize and dsize were greater than 0, i.e. sindex-1 + * is a valid inex. *) + fill := 0X; + IF ~(unsigned IN flags) & (source[sindex-1] >= 080X) THEN + fill := 0FFX; + END; + END; + WHILE dsize > 0 DO + dest[dindex] := fill; + dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); + END; + END; + END; + END Convert; + + PROCEDURE ByAddrToC*(from, to: Address; format: ARRAY OF CHAR); + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO + Convert(from + offset1, to + offset2, size1, size2, flags); + END; + Close(cv); + END ByAddrToC; + + PROCEDURE ByAddrFromC*(from, to: Address; format: ARRAY OF CHAR); + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO + Convert(from + offset2, to + offset1, size2, size1, flags); + END; + Close(cv); + END ByAddrFromC; + + PROCEDURE CSize*(format: ARRAY OF CHAR) : Size; + (* returns the size of the C-structure described by `format' *) + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + size: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END; + Close(cv); + size := offset2 + size2; + Align(size, 2); + RETURN size + END CSize; + + PROCEDURE OberonSize*(format: ARRAY OF CHAR) : Size; + (* returns the size of the Oberon-structure described by `format' *) + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + size: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END; + Close(cv); + size := offset1 + size1; + Align(size, SIZE(INTEGER)); + RETURN size + END OberonSize; + + PROCEDURE ToC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR); + BEGIN + IF OberonSize(format) > LEN(from) THEN + SizeError("Oberon record is too small", format); RETURN + END; + IF CSize(format) > LEN(to) THEN + SizeError("C structure is too small", format); RETURN + END; + ByAddrToC(SYS.ADR(from), SYS.ADR(to), format); + END ToC; + + PROCEDURE FromC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR); + BEGIN + IF OberonSize(format) > LEN(to) THEN + SizeError("Oberon record is too small", format); RETURN + END; + IF CSize(format) > LEN(from) THEN + SizeError("C structure is too small", format); RETURN + END; + ByAddrFromC(SYS.ADR(from), SYS.ADR(to), format); + END FromC; + + PROCEDURE Compile*(VAR fmt: Format; format: ARRAY OF CHAR); + (* translate format into an internal representation + which is later referenced by fmt; + ByFmtToC and ByFmtFromC are faster than ToC and FromC + *) + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + flags: Flags; + element: Format; + head, tail: Format; + BEGIN + Open(cv, format); + head := NIL; tail := NIL; + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO + NEW(element); + element.offset1 := offset1; + element.offset2 := offset2; + element.size1 := size1; + element.size2 := size2; + element.flags := flags; + element.next := NIL; + IF tail # NIL THEN + tail.next := element; + ELSE + head := element; + END; + tail := element; + END; + fmt := head; + Close(cv); + END Compile; + + PROCEDURE ByFmtAndAddrToC*(from, to: Address; format: Format); + VAR + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + WHILE format # NIL DO + Convert(from + format.offset1, to + format.offset2, + format.size1, format.size2, format.flags); + format := format.next; + END; + END ByFmtAndAddrToC; + + PROCEDURE ByFmtAndAddrFromC*(from, to: Address; format: Format); + VAR + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + WHILE format # NIL DO + Convert(from + format.offset2, to + format.offset1, + format.size2, format.size1, format.flags); + format := format.next; + END; + END ByFmtAndAddrFromC; + + PROCEDURE ByFmtToC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format); + BEGIN + ByFmtAndAddrToC(SYS.ADR(from), SYS.ADR(to), format); + END ByFmtToC; + + PROCEDURE ByFmtFromC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format); + BEGIN + ByFmtAndAddrFromC(SYS.ADR(from), SYS.ADR(to), format); + END ByFmtFromC; + +BEGIN + Events.Define(badformat); + Events.SetPriority(badformat, Priorities.liberrors); +END ulmSysConversions. diff --git a/src/lib/ulm/armv6j_hardfp/ulmSysStat.Mod b/src/lib/ulm/armv6j_hardfp/ulmSysStat.Mod new file mode 100644 index 00000000..d995779e --- /dev/null +++ b/src/lib/ulm/armv6j_hardfp/ulmSysStat.Mod @@ -0,0 +1,200 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: SysStat.om,v 1.3 2000/11/12 13:02:09 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: SysStat.om,v $ + Revision 1.3 2000/11/12 13:02:09 borchert + door file type added + + Revision 1.2 2000/11/12 12:48:07 borchert + - conversion adapted to Solaris 2.x + - Lstat added + + Revision 1.1 1994/02/23 08:00:48 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 9/89 + ---------------------------------------------------------------------------- +*) + +MODULE ulmSysStat; + + (* examine inode: stat(2) and fstat(2) *) + + IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, SysConversions := ulmSysConversions, SysError := ulmSysErrors, + SysTypes := ulmSysTypes; + + CONST + (* file mode: + bit 0 = 1<<0 bit 31 = 1<<31 + + user group other + 3 1 1111 11 + 1 ... 6 5432 109 876 543 210 + +--------+------+-----+-----+-----+-----+ + | unused | type | sst | rwx | rwx | rwx | + +--------+------+-----+-----+-----+-----+ + *) + + type* = {12..15}; + prot* = {0..8}; + + (* file types; example: (stat.mode * type = dir) *) + reg* = {15}; (* regular *) + dir* = {14}; (* directory *) + chr* = {13}; (* character special *) + fifo* = {12}; (* fifo *) + blk* = {13..14}; (* block special *) + symlink* = {13, 15}; (* symbolic link *) + socket* = {14, 15}; (* socket *) + + (* special *) + setuid* = 11; (* set user id on execution *) + setgid* = 10; (* set group id on execution *) + savetext* = 9; (* save swapped text even after use *) + + (* protection *) + uread* = 8; (* read permission owner *) + uwrite* = 7; (* write permission owner *) + uexec* = 6; (* execute/search permission owner *) + gread* = 5; (* read permission group *) + gwrite* = 4; (* write permission group *) + gexec* = 3; (* execute/search permission group *) + oread* = 2; (* read permission other *) + owrite* = 1; (* write permission other *) + oexec* = 0; (* execute/search permission other *) + + (* example for "r-xr-x---": (read + exec) * (owner + group) *) + owner* = {uread, uwrite, uexec}; + group* = {gread, gwrite, gexec}; + other* = {oread, owrite, oexec}; + read* = {uread, gread, oread}; + write* = {uwrite, gwrite, owrite}; + exec* = {uexec, gexec, oexec}; + rwx* = prot; + + TYPE + StatRec* = (* result of stat(2) and fstat(2) *) + RECORD + device*: SysTypes.Device; (* ID of device containing + a directory entry for this file *) + inode*: SysTypes.Inode; (* inode number *) + mode*: SET; (* file mode; see mknod(2) *) + nlinks*: INTEGER; (* number of links *) + uid*: INTEGER; (* user id of the file's owner *) + gid*: INTEGER; (* group id of the file's group *) + rdev*: SysTypes.Device; (* ID of device + this entry is defined only for + character special or block + special files + *) + size*: SysTypes.Offset; (* file size in bytes *) + blksize*: LONGINT; (* preferred blocksize *) + blocks*: LONGINT; (* # of blocks allocated *) + atime*: SysTypes.Time; (* time of last access *) + mtime*: SysTypes.Time; (* time of last data modification *) + ctime*: SysTypes.Time; (* time of last file status change *) + END; + +(* Linux kernel struct stat (2.2.17) + struct stat { + unsigned short st_dev; + unsigned short __pad1; + unsigned long st_ino; + unsigned short st_mode; + unsigned short st_nlink; + unsigned short st_uid; + unsigned short st_gid; + unsigned short st_rdev; + unsigned short __pad2; + unsigned long st_size; + unsigned long st_blksize; + unsigned long st_blocks; + unsigned long st_atime; + unsigned long __unused1; + unsigned long st_mtime; + unsigned long __unused2; + unsigned long st_ctime; + unsigned long __unused3; + unsigned long __unused4; + unsigned long __unused5; + }; +*) + + CONST + statbufsize = 88(*64*); (* see *) (* sizeof struct stat gives us 144 on x86_64 and 88 on x86 *) + TYPE + UnixStatRec = ARRAY statbufsize OF SYS.BYTE; + CONST + statbufconv = + (*"is=dev/-s=pad1/ll=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/ll=size/2*ll=blksize,blocks/il=atime/-l/il=mtime/-l/il=ctime/3*-l";*) + "ls=dev/-s=pad1/lL=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/lL=size/2*lL=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l"; + VAR + statbuffmt: SysConversions.Format; + + PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1, d2: LONGINT; + origbuf: UnixStatRec; + BEGIN + IF SYS.UNIXCALL(Sys.newstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf), d2) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newstat, path); + RETURN FALSE + END; + END Stat; + + PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1: INTEGER; + origbuf: UnixStatRec; + BEGIN + IF SYS.UNIXCALL(Sys.newlstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf)) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newlstat, path); + RETURN FALSE + END; + END Lstat; + + PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1: INTEGER; + origbuf: UnixStatRec; + BEGIN + IF SYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf)) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newfstat, ""); + RETURN FALSE + END; + END Fstat; + +BEGIN + SysConversions.Compile(statbuffmt, statbufconv); +END ulmSysStat. diff --git a/src/lib/ulm/armv6j_hardfp/ulmSysTypes.Mod b/src/lib/ulm/armv6j_hardfp/ulmSysTypes.Mod index a614c67b..174140e7 100644 --- a/src/lib/ulm/armv6j_hardfp/ulmSysTypes.Mod +++ b/src/lib/ulm/armv6j_hardfp/ulmSysTypes.Mod @@ -41,7 +41,7 @@ MODULE ulmSysTypes; File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *) Offset* = LONGINT; - Device* = INTEGER; + Device* = LONGINT; Inode* = LONGINT; Time* = LONGINT; diff --git a/src/lib/ulm/armv7a_hardfp/ulmSysConversions.Mod b/src/lib/ulm/armv7a_hardfp/ulmSysConversions.Mod new file mode 100644 index 00000000..f8ea3fbb --- /dev/null +++ b/src/lib/ulm/armv7a_hardfp/ulmSysConversions.Mod @@ -0,0 +1,574 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: SysConversi.om,v 1.2 1997/07/30 09:38:16 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: SysConversi.om,v $ + Revision 1.2 1997/07/30 09:38:16 borchert + bug in ReadConv fixed: cv.flags was used but not set for + counts > 1 + + Revision 1.1 1994/02/23 07:58:28 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 8/90 + adapted to linux cae 02/01 + ---------------------------------------------------------------------------- +*) + +MODULE ulmSysConversions; + + (* convert Oberon records to/from C structures *) + + IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Streams := ulmStreams, Strings := ulmStrings, + SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts; + + TYPE + Address* = SysTypes.Address; + Size* = Address; + + (* format: + + Format = Conversion { "/" Conversion } . + Conversion = [ Factors ] ConvChars [ Comment ] . + Factors = Array | Factor | Array Factor | Factor Array . + Array = Integer ":" . + Factor = Integer "*" . + ConvChars = OberonType CType | Skip CType | OberonType Skip . + OberonType = "a" | "b" | "c" | "s" | "i" | "l" | "S" . + CType = "a" | "c" | "s" | "i" | "l" . + Integer = Digit { Digit } . + Digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" . + Skip = "-" . + Comment = "=" { AnyChar } . + AnyChar = (* all characters except "/" *) . + + Oberon data types: + + a: Address + b: SYS.BYTE + B: BOOLEAN + c: CHAR + s: SHORTINT + i: INTEGER + l: LONGINT + S: SET + + C data types: + + a: char * + c: /* signed */ char + C: unsigned char + s: short int + S: unsigned short int + i: int + I: unsigned int + u: unsigned int + l: long int + L: unsigned long int + + example: + + conversion from + + Rec = + RECORD + a, b: INTEGER; + c: CHAR; + s: SET; + f: ARRAY 3 OF INTEGER; + END; + + to + + struct rec { + short a, b; + char c; + int xx; /* to be skipped on conversion */ + int s; + int f[3]; + }; + + or vice versa: + + "2*is=a,b/cc=c/-i=xx/Si=s/3:ii=f" + + The comments allow to give the field names. + *) + + CONST + (* conversion flags *) + unsigned = 0; (* suppress sign extension *) + boolean = 1; (* convert anything # 0 to 1 *) + TYPE + Flags = SET; + Event* = POINTER TO EventRec; + EventRec* = + RECORD + (Events.EventRec) + format*: Events.Message; + END; + ConvStream = POINTER TO ConvStreamRec; + ConvStreamRec = + RECORD + fmt: Texts.Text; + char: CHAR; + eof: BOOLEAN; + (* 1: Oberon type + 2: C type + *) + type1, type2: CHAR; length: INTEGER; left: INTEGER; + offset1, offset2: Address; + size1, size2: Address; elementsleft: INTEGER; flags: Flags; + END; + + Format* = POINTER TO FormatRec; + FormatRec* = + RECORD + (Objects.ObjectRec) + offset1, offset2: Address; + size1, size2: Address; + flags: Flags; + next: Format; + END; + VAR + badformat*: Events.EventType; + + PROCEDURE Error(cv: ConvStream; msg: ARRAY OF CHAR); + VAR + event: Event; + BEGIN + NEW(event); + event.type := badformat; + event.message := "SysConversions: "; + Strings.Concatenate(event.message, msg); + Strings.Read(event.format, cv.fmt); + Events.Raise(event); + cv.eof := TRUE; + cv.char := 0X; + cv.left := 0; + cv.elementsleft := 0; + END Error; + + PROCEDURE SizeError(msg, format: ARRAY OF CHAR); + VAR + event: Event; + BEGIN + NEW(event); + event.type := badformat; + event.message := "SysConversions: "; + Strings.Concatenate(event.message, msg); + COPY(format, event.format); + Events.Raise(event); + END SizeError; + + PROCEDURE NextCh(cv: ConvStream); + BEGIN + cv.eof := cv.eof OR ~Streams.ReadByte(cv.fmt, cv.char) OR (cv.char = 0X); + IF cv.eof THEN + cv.char := 0X; + END; + END NextCh; + + PROCEDURE IsDigit(ch: CHAR) : BOOLEAN; + BEGIN + RETURN (ch >= "0") & (ch <= "9") + END IsDigit; + + PROCEDURE ReadInt(cv: ConvStream; VAR i: INTEGER); + BEGIN + i := 0; + REPEAT + i := 10 * i + ORD(cv.char) - ORD("0"); + NextCh(cv); + UNTIL ~IsDigit(cv.char); + END ReadInt; + + PROCEDURE Open(VAR cv: ConvStream; format: ARRAY OF CHAR); + BEGIN + NEW(cv); + Texts.Open(SYS.VAL(Streams.Stream, cv.fmt)); + Strings.Write(cv.fmt, format); + cv.left := 0; cv.elementsleft := 0; + cv.offset1 := 0; cv.offset2 := 0; + cv.eof := FALSE; + NextCh(cv); + END Open; + + PROCEDURE Close(VAR cv: ConvStream); + BEGIN + IF ~Streams.Close(cv.fmt) THEN END; + END Close; + + PROCEDURE ScanConv(cv: ConvStream; + VAR type1, type2: CHAR; + VAR length: INTEGER) : BOOLEAN; + VAR + i: INTEGER; + factor: INTEGER; + BEGIN + IF cv.left > 0 THEN + type1 := cv.type1; + type2 := cv.type2; + length := cv.length; + DEC(cv.left); + RETURN TRUE + END; + IF cv.char = "/" THEN + NextCh(cv); + END; + IF cv.eof THEN + RETURN FALSE + END; + factor := 0; length := 0; + WHILE IsDigit(cv.char) DO + ReadInt(cv, i); + IF i <= 0 THEN + Error(cv, "integer must be positive"); RETURN FALSE + END; + IF cv.char = ":" THEN + IF length # 0 THEN + Error(cv, "multiple length specification"); RETURN FALSE + END; + length := i; + NextCh(cv); + ELSIF cv.char = "*" THEN + IF factor # 0 THEN + Error(cv, "multiple factor specification"); RETURN FALSE + END; + factor := i; cv.left := factor - 1; + NextCh(cv); + ELSE + Error(cv, "factor or length expected"); RETURN FALSE + END; + END; + type1 := cv.char; NextCh(cv); + type2 := cv.char; NextCh(cv); + IF cv.left > 0 THEN + cv.type1 := type1; cv.type2 := type2; cv.length := length; + END; + IF cv.char = "=" THEN (* comment *) + REPEAT + NextCh(cv); + UNTIL cv.eof OR (cv.char = "/"); + END; + RETURN TRUE + END ScanConv; + + PROCEDURE Align(VAR offset: Address; boundary: Address); + BEGIN + IF SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary) # 0 THEN + offset := SYS.VAL (INTEGER, offset) + (SYS.VAL (INTEGER, boundary) - SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary)); + END; + END Align; + + PROCEDURE ReadConv(cv: ConvStream; + VAR offset1, offset2: Address; + VAR size1, size2: Address; + VAR flags: Flags) : BOOLEAN; + VAR + type1, type2: CHAR; + length: INTEGER; + align: BOOLEAN; + boundary: INTEGER; + BEGIN + IF cv.elementsleft > 0 THEN + DEC(cv.elementsleft); + + (* Oberon type *) + IF size1 > SIZE(SYS.BYTE) THEN + Align(cv.offset1, SIZE(INTEGER)); + END; + offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; + size1 := cv.size1; size2 := cv.size2; flags := cv.flags; + IF (size1 > 0) & (cv.elementsleft = 0) THEN + Align(cv.offset1, SIZE(INTEGER)); + END; + + (* C type *) + IF size2 > 1 THEN + Align(cv.offset2, 2); + END; + offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); + + RETURN TRUE + END; + IF ScanConv(cv, type1, type2, length) THEN + flags := {}; + (* Oberon type *) + CASE type1 OF + | "a": size1 := SIZE(Address); INCL(flags, unsigned); + | "b": size1 := SIZE(SYS.BYTE); INCL(flags, unsigned); + | "B": size1 := SIZE(BOOLEAN); INCL(flags, boolean); + | "c": size1 := SIZE(CHAR); INCL(flags, unsigned); + | "s": size1 := SIZE(SHORTINT); + | "i": size1 := SIZE(INTEGER); + | "l": size1 := SIZE(LONGINT); + | "S": size1 := SIZE(SET); INCL(flags, unsigned); + | "-": size1 := 0; + ELSE Error(cv, "bad Oberon type specifier"); RETURN FALSE + END; + IF size1 > 0 THEN + IF length > 0 THEN + Align(cv.offset1, SIZE(INTEGER)); + ELSIF size1 > SIZE(SYS.BYTE) THEN + Align(cv.offset1, SIZE(INTEGER)); + END; + END; + offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; + + (* C type *) + CASE type2 OF + | "a": size2 := 4; INCL(flags, unsigned); (* char* *) + | "c": size2 := 1; (* /* signed */ char *) + | "C": size2 := 1; INCL(flags, unsigned); (* unsigned char *) + | "s": size2 := 2; (* short int *) + | "S": size2 := 2; INCL(flags, unsigned); (* unsigned short int *) + | "i": size2 := 4; (* int *) + | "I": size2 := 4; INCL(flags, unsigned); (* unsigned int *) + | "u": size2 := 4; INCL(flags, unsigned); (* unsigned int *) + | "l": size2 := 4; (* long int *) + | "L": size2 := 4; INCL(flags, unsigned); (* long int *) + | "-": size2 := 0; + ELSE Error(cv, "bad C type specifier"); RETURN FALSE + END; + IF size2 > 1 THEN + Align(cv.offset2, size2); + END; + offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); + + cv.size1 := size1; cv.size2 := size2; + IF length > 0 THEN + cv.elementsleft := length - 1; + cv.flags := flags; + END; + RETURN TRUE + ELSE + RETURN FALSE + END; + END ReadConv; + + PROCEDURE Convert(from, to: Address; ssize, dsize: Address; flags: Flags); + TYPE + Bytes = ARRAY 8 OF CHAR; + Pointer = POINTER TO Bytes; + VAR + dest, source: Pointer; + dindex, sindex: INTEGER; + nonzero: BOOLEAN; + fill : CHAR; + BEGIN + IF ssize > 0 THEN + dest := SYS.VAL(Pointer, to); + source := SYS.VAL(Pointer, from); + dindex := 0; sindex := 0; + IF boolean IN flags THEN + nonzero := FALSE; + WHILE ssize > 0 DO + nonzero := nonzero OR (source[sindex] # 0X); + INC(sindex); ssize := SYS.VAL (INTEGER, ssize) - 1; + END; + IF dsize > 0 THEN + IF nonzero THEN + dest[dindex] := 1X; + ELSE + dest[dindex] := 0X; + END; + dsize := dsize - 1; INC (dindex); + END; + WHILE dsize > 0 DO + dest[dindex] := 0X; + dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); + END; + ELSE + WHILE (dsize > 0) & (ssize > 0) DO + dest[dindex] := source[sindex]; + ssize := SYS.VAL (INTEGER, ssize) - 1; + dsize := dsize - 1; + INC(dindex); INC(sindex); + END; + IF dsize > 0 THEN + (* sindex has been incremented at least once because + * ssize and dsize were greater than 0, i.e. sindex-1 + * is a valid inex. *) + fill := 0X; + IF ~(unsigned IN flags) & (source[sindex-1] >= 080X) THEN + fill := 0FFX; + END; + END; + WHILE dsize > 0 DO + dest[dindex] := fill; + dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); + END; + END; + END; + END Convert; + + PROCEDURE ByAddrToC*(from, to: Address; format: ARRAY OF CHAR); + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO + Convert(from + offset1, to + offset2, size1, size2, flags); + END; + Close(cv); + END ByAddrToC; + + PROCEDURE ByAddrFromC*(from, to: Address; format: ARRAY OF CHAR); + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO + Convert(from + offset2, to + offset1, size2, size1, flags); + END; + Close(cv); + END ByAddrFromC; + + PROCEDURE CSize*(format: ARRAY OF CHAR) : Size; + (* returns the size of the C-structure described by `format' *) + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + size: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END; + Close(cv); + size := offset2 + size2; + Align(size, 2); + RETURN size + END CSize; + + PROCEDURE OberonSize*(format: ARRAY OF CHAR) : Size; + (* returns the size of the Oberon-structure described by `format' *) + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + size: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END; + Close(cv); + size := offset1 + size1; + Align(size, SIZE(INTEGER)); + RETURN size + END OberonSize; + + PROCEDURE ToC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR); + BEGIN + IF OberonSize(format) > LEN(from) THEN + SizeError("Oberon record is too small", format); RETURN + END; + IF CSize(format) > LEN(to) THEN + SizeError("C structure is too small", format); RETURN + END; + ByAddrToC(SYS.ADR(from), SYS.ADR(to), format); + END ToC; + + PROCEDURE FromC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR); + BEGIN + IF OberonSize(format) > LEN(to) THEN + SizeError("Oberon record is too small", format); RETURN + END; + IF CSize(format) > LEN(from) THEN + SizeError("C structure is too small", format); RETURN + END; + ByAddrFromC(SYS.ADR(from), SYS.ADR(to), format); + END FromC; + + PROCEDURE Compile*(VAR fmt: Format; format: ARRAY OF CHAR); + (* translate format into an internal representation + which is later referenced by fmt; + ByFmtToC and ByFmtFromC are faster than ToC and FromC + *) + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + flags: Flags; + element: Format; + head, tail: Format; + BEGIN + Open(cv, format); + head := NIL; tail := NIL; + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO + NEW(element); + element.offset1 := offset1; + element.offset2 := offset2; + element.size1 := size1; + element.size2 := size2; + element.flags := flags; + element.next := NIL; + IF tail # NIL THEN + tail.next := element; + ELSE + head := element; + END; + tail := element; + END; + fmt := head; + Close(cv); + END Compile; + + PROCEDURE ByFmtAndAddrToC*(from, to: Address; format: Format); + VAR + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + WHILE format # NIL DO + Convert(from + format.offset1, to + format.offset2, + format.size1, format.size2, format.flags); + format := format.next; + END; + END ByFmtAndAddrToC; + + PROCEDURE ByFmtAndAddrFromC*(from, to: Address; format: Format); + VAR + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + WHILE format # NIL DO + Convert(from + format.offset2, to + format.offset1, + format.size2, format.size1, format.flags); + format := format.next; + END; + END ByFmtAndAddrFromC; + + PROCEDURE ByFmtToC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format); + BEGIN + ByFmtAndAddrToC(SYS.ADR(from), SYS.ADR(to), format); + END ByFmtToC; + + PROCEDURE ByFmtFromC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format); + BEGIN + ByFmtAndAddrFromC(SYS.ADR(from), SYS.ADR(to), format); + END ByFmtFromC; + +BEGIN + Events.Define(badformat); + Events.SetPriority(badformat, Priorities.liberrors); +END ulmSysConversions. diff --git a/src/lib/ulm/armv7a_hardfp/ulmSysStat.Mod b/src/lib/ulm/armv7a_hardfp/ulmSysStat.Mod new file mode 100644 index 00000000..d995779e --- /dev/null +++ b/src/lib/ulm/armv7a_hardfp/ulmSysStat.Mod @@ -0,0 +1,200 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: SysStat.om,v 1.3 2000/11/12 13:02:09 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: SysStat.om,v $ + Revision 1.3 2000/11/12 13:02:09 borchert + door file type added + + Revision 1.2 2000/11/12 12:48:07 borchert + - conversion adapted to Solaris 2.x + - Lstat added + + Revision 1.1 1994/02/23 08:00:48 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 9/89 + ---------------------------------------------------------------------------- +*) + +MODULE ulmSysStat; + + (* examine inode: stat(2) and fstat(2) *) + + IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, SysConversions := ulmSysConversions, SysError := ulmSysErrors, + SysTypes := ulmSysTypes; + + CONST + (* file mode: + bit 0 = 1<<0 bit 31 = 1<<31 + + user group other + 3 1 1111 11 + 1 ... 6 5432 109 876 543 210 + +--------+------+-----+-----+-----+-----+ + | unused | type | sst | rwx | rwx | rwx | + +--------+------+-----+-----+-----+-----+ + *) + + type* = {12..15}; + prot* = {0..8}; + + (* file types; example: (stat.mode * type = dir) *) + reg* = {15}; (* regular *) + dir* = {14}; (* directory *) + chr* = {13}; (* character special *) + fifo* = {12}; (* fifo *) + blk* = {13..14}; (* block special *) + symlink* = {13, 15}; (* symbolic link *) + socket* = {14, 15}; (* socket *) + + (* special *) + setuid* = 11; (* set user id on execution *) + setgid* = 10; (* set group id on execution *) + savetext* = 9; (* save swapped text even after use *) + + (* protection *) + uread* = 8; (* read permission owner *) + uwrite* = 7; (* write permission owner *) + uexec* = 6; (* execute/search permission owner *) + gread* = 5; (* read permission group *) + gwrite* = 4; (* write permission group *) + gexec* = 3; (* execute/search permission group *) + oread* = 2; (* read permission other *) + owrite* = 1; (* write permission other *) + oexec* = 0; (* execute/search permission other *) + + (* example for "r-xr-x---": (read + exec) * (owner + group) *) + owner* = {uread, uwrite, uexec}; + group* = {gread, gwrite, gexec}; + other* = {oread, owrite, oexec}; + read* = {uread, gread, oread}; + write* = {uwrite, gwrite, owrite}; + exec* = {uexec, gexec, oexec}; + rwx* = prot; + + TYPE + StatRec* = (* result of stat(2) and fstat(2) *) + RECORD + device*: SysTypes.Device; (* ID of device containing + a directory entry for this file *) + inode*: SysTypes.Inode; (* inode number *) + mode*: SET; (* file mode; see mknod(2) *) + nlinks*: INTEGER; (* number of links *) + uid*: INTEGER; (* user id of the file's owner *) + gid*: INTEGER; (* group id of the file's group *) + rdev*: SysTypes.Device; (* ID of device + this entry is defined only for + character special or block + special files + *) + size*: SysTypes.Offset; (* file size in bytes *) + blksize*: LONGINT; (* preferred blocksize *) + blocks*: LONGINT; (* # of blocks allocated *) + atime*: SysTypes.Time; (* time of last access *) + mtime*: SysTypes.Time; (* time of last data modification *) + ctime*: SysTypes.Time; (* time of last file status change *) + END; + +(* Linux kernel struct stat (2.2.17) + struct stat { + unsigned short st_dev; + unsigned short __pad1; + unsigned long st_ino; + unsigned short st_mode; + unsigned short st_nlink; + unsigned short st_uid; + unsigned short st_gid; + unsigned short st_rdev; + unsigned short __pad2; + unsigned long st_size; + unsigned long st_blksize; + unsigned long st_blocks; + unsigned long st_atime; + unsigned long __unused1; + unsigned long st_mtime; + unsigned long __unused2; + unsigned long st_ctime; + unsigned long __unused3; + unsigned long __unused4; + unsigned long __unused5; + }; +*) + + CONST + statbufsize = 88(*64*); (* see *) (* sizeof struct stat gives us 144 on x86_64 and 88 on x86 *) + TYPE + UnixStatRec = ARRAY statbufsize OF SYS.BYTE; + CONST + statbufconv = + (*"is=dev/-s=pad1/ll=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/ll=size/2*ll=blksize,blocks/il=atime/-l/il=mtime/-l/il=ctime/3*-l";*) + "ls=dev/-s=pad1/lL=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/lL=size/2*lL=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l"; + VAR + statbuffmt: SysConversions.Format; + + PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1, d2: LONGINT; + origbuf: UnixStatRec; + BEGIN + IF SYS.UNIXCALL(Sys.newstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf), d2) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newstat, path); + RETURN FALSE + END; + END Stat; + + PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1: INTEGER; + origbuf: UnixStatRec; + BEGIN + IF SYS.UNIXCALL(Sys.newlstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf)) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newlstat, path); + RETURN FALSE + END; + END Lstat; + + PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1: INTEGER; + origbuf: UnixStatRec; + BEGIN + IF SYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf)) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newfstat, ""); + RETURN FALSE + END; + END Fstat; + +BEGIN + SysConversions.Compile(statbuffmt, statbufconv); +END ulmSysStat. diff --git a/src/lib/ulm/armv7a_hardfp/ulmSysTypes.Mod b/src/lib/ulm/armv7a_hardfp/ulmSysTypes.Mod index a614c67b..174140e7 100644 --- a/src/lib/ulm/armv7a_hardfp/ulmSysTypes.Mod +++ b/src/lib/ulm/armv7a_hardfp/ulmSysTypes.Mod @@ -41,7 +41,7 @@ MODULE ulmSysTypes; File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *) Offset* = LONGINT; - Device* = INTEGER; + Device* = LONGINT; Inode* = LONGINT; Time* = LONGINT; diff --git a/src/lib/ulm/ulmSYSTEM.Mod b/src/lib/ulm/ulmSYSTEM.Mod index 379e5837..814c0607 100644 --- a/src/lib/ulm/ulmSYSTEM.Mod +++ b/src/lib/ulm/ulmSYSTEM.Mod @@ -3,6 +3,7 @@ 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; @@ -55,6 +56,7 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR; ch : CHAR; pch : pchar; pstr : pstring; + pst : pstatus; BEGIN IF syscall = Sys.read THEN @@ -103,7 +105,13 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR; d0 := Unix.Pipe(arg1); RETURN d0 >= 0; ELSIF syscall = Sys.newstat THEN - (*d0 := Unix.Stat(arg1, arg2);*) + pst := SYSTEM.VAL(pstatus, arg2); + pstr := SYSTEM.VAL(pstring, arg1); + d0 := Unix.Stat(pstr^, pst^); + RETURN d0 >= 0 + ELSIF syscall = Sys.newfstat THEN + pst := SYSTEM.VAL(pstatus, arg2); + d0 := Unix.Fstat(arg1, pst^); RETURN d0 >= 0; END diff --git a/src/lib/ulm/x86/ulmSysConversions.Mod b/src/lib/ulm/x86/ulmSysConversions.Mod new file mode 100644 index 00000000..f8ea3fbb --- /dev/null +++ b/src/lib/ulm/x86/ulmSysConversions.Mod @@ -0,0 +1,574 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: SysConversi.om,v 1.2 1997/07/30 09:38:16 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: SysConversi.om,v $ + Revision 1.2 1997/07/30 09:38:16 borchert + bug in ReadConv fixed: cv.flags was used but not set for + counts > 1 + + Revision 1.1 1994/02/23 07:58:28 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 8/90 + adapted to linux cae 02/01 + ---------------------------------------------------------------------------- +*) + +MODULE ulmSysConversions; + + (* convert Oberon records to/from C structures *) + + IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Streams := ulmStreams, Strings := ulmStrings, + SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts; + + TYPE + Address* = SysTypes.Address; + Size* = Address; + + (* format: + + Format = Conversion { "/" Conversion } . + Conversion = [ Factors ] ConvChars [ Comment ] . + Factors = Array | Factor | Array Factor | Factor Array . + Array = Integer ":" . + Factor = Integer "*" . + ConvChars = OberonType CType | Skip CType | OberonType Skip . + OberonType = "a" | "b" | "c" | "s" | "i" | "l" | "S" . + CType = "a" | "c" | "s" | "i" | "l" . + Integer = Digit { Digit } . + Digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" . + Skip = "-" . + Comment = "=" { AnyChar } . + AnyChar = (* all characters except "/" *) . + + Oberon data types: + + a: Address + b: SYS.BYTE + B: BOOLEAN + c: CHAR + s: SHORTINT + i: INTEGER + l: LONGINT + S: SET + + C data types: + + a: char * + c: /* signed */ char + C: unsigned char + s: short int + S: unsigned short int + i: int + I: unsigned int + u: unsigned int + l: long int + L: unsigned long int + + example: + + conversion from + + Rec = + RECORD + a, b: INTEGER; + c: CHAR; + s: SET; + f: ARRAY 3 OF INTEGER; + END; + + to + + struct rec { + short a, b; + char c; + int xx; /* to be skipped on conversion */ + int s; + int f[3]; + }; + + or vice versa: + + "2*is=a,b/cc=c/-i=xx/Si=s/3:ii=f" + + The comments allow to give the field names. + *) + + CONST + (* conversion flags *) + unsigned = 0; (* suppress sign extension *) + boolean = 1; (* convert anything # 0 to 1 *) + TYPE + Flags = SET; + Event* = POINTER TO EventRec; + EventRec* = + RECORD + (Events.EventRec) + format*: Events.Message; + END; + ConvStream = POINTER TO ConvStreamRec; + ConvStreamRec = + RECORD + fmt: Texts.Text; + char: CHAR; + eof: BOOLEAN; + (* 1: Oberon type + 2: C type + *) + type1, type2: CHAR; length: INTEGER; left: INTEGER; + offset1, offset2: Address; + size1, size2: Address; elementsleft: INTEGER; flags: Flags; + END; + + Format* = POINTER TO FormatRec; + FormatRec* = + RECORD + (Objects.ObjectRec) + offset1, offset2: Address; + size1, size2: Address; + flags: Flags; + next: Format; + END; + VAR + badformat*: Events.EventType; + + PROCEDURE Error(cv: ConvStream; msg: ARRAY OF CHAR); + VAR + event: Event; + BEGIN + NEW(event); + event.type := badformat; + event.message := "SysConversions: "; + Strings.Concatenate(event.message, msg); + Strings.Read(event.format, cv.fmt); + Events.Raise(event); + cv.eof := TRUE; + cv.char := 0X; + cv.left := 0; + cv.elementsleft := 0; + END Error; + + PROCEDURE SizeError(msg, format: ARRAY OF CHAR); + VAR + event: Event; + BEGIN + NEW(event); + event.type := badformat; + event.message := "SysConversions: "; + Strings.Concatenate(event.message, msg); + COPY(format, event.format); + Events.Raise(event); + END SizeError; + + PROCEDURE NextCh(cv: ConvStream); + BEGIN + cv.eof := cv.eof OR ~Streams.ReadByte(cv.fmt, cv.char) OR (cv.char = 0X); + IF cv.eof THEN + cv.char := 0X; + END; + END NextCh; + + PROCEDURE IsDigit(ch: CHAR) : BOOLEAN; + BEGIN + RETURN (ch >= "0") & (ch <= "9") + END IsDigit; + + PROCEDURE ReadInt(cv: ConvStream; VAR i: INTEGER); + BEGIN + i := 0; + REPEAT + i := 10 * i + ORD(cv.char) - ORD("0"); + NextCh(cv); + UNTIL ~IsDigit(cv.char); + END ReadInt; + + PROCEDURE Open(VAR cv: ConvStream; format: ARRAY OF CHAR); + BEGIN + NEW(cv); + Texts.Open(SYS.VAL(Streams.Stream, cv.fmt)); + Strings.Write(cv.fmt, format); + cv.left := 0; cv.elementsleft := 0; + cv.offset1 := 0; cv.offset2 := 0; + cv.eof := FALSE; + NextCh(cv); + END Open; + + PROCEDURE Close(VAR cv: ConvStream); + BEGIN + IF ~Streams.Close(cv.fmt) THEN END; + END Close; + + PROCEDURE ScanConv(cv: ConvStream; + VAR type1, type2: CHAR; + VAR length: INTEGER) : BOOLEAN; + VAR + i: INTEGER; + factor: INTEGER; + BEGIN + IF cv.left > 0 THEN + type1 := cv.type1; + type2 := cv.type2; + length := cv.length; + DEC(cv.left); + RETURN TRUE + END; + IF cv.char = "/" THEN + NextCh(cv); + END; + IF cv.eof THEN + RETURN FALSE + END; + factor := 0; length := 0; + WHILE IsDigit(cv.char) DO + ReadInt(cv, i); + IF i <= 0 THEN + Error(cv, "integer must be positive"); RETURN FALSE + END; + IF cv.char = ":" THEN + IF length # 0 THEN + Error(cv, "multiple length specification"); RETURN FALSE + END; + length := i; + NextCh(cv); + ELSIF cv.char = "*" THEN + IF factor # 0 THEN + Error(cv, "multiple factor specification"); RETURN FALSE + END; + factor := i; cv.left := factor - 1; + NextCh(cv); + ELSE + Error(cv, "factor or length expected"); RETURN FALSE + END; + END; + type1 := cv.char; NextCh(cv); + type2 := cv.char; NextCh(cv); + IF cv.left > 0 THEN + cv.type1 := type1; cv.type2 := type2; cv.length := length; + END; + IF cv.char = "=" THEN (* comment *) + REPEAT + NextCh(cv); + UNTIL cv.eof OR (cv.char = "/"); + END; + RETURN TRUE + END ScanConv; + + PROCEDURE Align(VAR offset: Address; boundary: Address); + BEGIN + IF SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary) # 0 THEN + offset := SYS.VAL (INTEGER, offset) + (SYS.VAL (INTEGER, boundary) - SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary)); + END; + END Align; + + PROCEDURE ReadConv(cv: ConvStream; + VAR offset1, offset2: Address; + VAR size1, size2: Address; + VAR flags: Flags) : BOOLEAN; + VAR + type1, type2: CHAR; + length: INTEGER; + align: BOOLEAN; + boundary: INTEGER; + BEGIN + IF cv.elementsleft > 0 THEN + DEC(cv.elementsleft); + + (* Oberon type *) + IF size1 > SIZE(SYS.BYTE) THEN + Align(cv.offset1, SIZE(INTEGER)); + END; + offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; + size1 := cv.size1; size2 := cv.size2; flags := cv.flags; + IF (size1 > 0) & (cv.elementsleft = 0) THEN + Align(cv.offset1, SIZE(INTEGER)); + END; + + (* C type *) + IF size2 > 1 THEN + Align(cv.offset2, 2); + END; + offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); + + RETURN TRUE + END; + IF ScanConv(cv, type1, type2, length) THEN + flags := {}; + (* Oberon type *) + CASE type1 OF + | "a": size1 := SIZE(Address); INCL(flags, unsigned); + | "b": size1 := SIZE(SYS.BYTE); INCL(flags, unsigned); + | "B": size1 := SIZE(BOOLEAN); INCL(flags, boolean); + | "c": size1 := SIZE(CHAR); INCL(flags, unsigned); + | "s": size1 := SIZE(SHORTINT); + | "i": size1 := SIZE(INTEGER); + | "l": size1 := SIZE(LONGINT); + | "S": size1 := SIZE(SET); INCL(flags, unsigned); + | "-": size1 := 0; + ELSE Error(cv, "bad Oberon type specifier"); RETURN FALSE + END; + IF size1 > 0 THEN + IF length > 0 THEN + Align(cv.offset1, SIZE(INTEGER)); + ELSIF size1 > SIZE(SYS.BYTE) THEN + Align(cv.offset1, SIZE(INTEGER)); + END; + END; + offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; + + (* C type *) + CASE type2 OF + | "a": size2 := 4; INCL(flags, unsigned); (* char* *) + | "c": size2 := 1; (* /* signed */ char *) + | "C": size2 := 1; INCL(flags, unsigned); (* unsigned char *) + | "s": size2 := 2; (* short int *) + | "S": size2 := 2; INCL(flags, unsigned); (* unsigned short int *) + | "i": size2 := 4; (* int *) + | "I": size2 := 4; INCL(flags, unsigned); (* unsigned int *) + | "u": size2 := 4; INCL(flags, unsigned); (* unsigned int *) + | "l": size2 := 4; (* long int *) + | "L": size2 := 4; INCL(flags, unsigned); (* long int *) + | "-": size2 := 0; + ELSE Error(cv, "bad C type specifier"); RETURN FALSE + END; + IF size2 > 1 THEN + Align(cv.offset2, size2); + END; + offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); + + cv.size1 := size1; cv.size2 := size2; + IF length > 0 THEN + cv.elementsleft := length - 1; + cv.flags := flags; + END; + RETURN TRUE + ELSE + RETURN FALSE + END; + END ReadConv; + + PROCEDURE Convert(from, to: Address; ssize, dsize: Address; flags: Flags); + TYPE + Bytes = ARRAY 8 OF CHAR; + Pointer = POINTER TO Bytes; + VAR + dest, source: Pointer; + dindex, sindex: INTEGER; + nonzero: BOOLEAN; + fill : CHAR; + BEGIN + IF ssize > 0 THEN + dest := SYS.VAL(Pointer, to); + source := SYS.VAL(Pointer, from); + dindex := 0; sindex := 0; + IF boolean IN flags THEN + nonzero := FALSE; + WHILE ssize > 0 DO + nonzero := nonzero OR (source[sindex] # 0X); + INC(sindex); ssize := SYS.VAL (INTEGER, ssize) - 1; + END; + IF dsize > 0 THEN + IF nonzero THEN + dest[dindex] := 1X; + ELSE + dest[dindex] := 0X; + END; + dsize := dsize - 1; INC (dindex); + END; + WHILE dsize > 0 DO + dest[dindex] := 0X; + dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); + END; + ELSE + WHILE (dsize > 0) & (ssize > 0) DO + dest[dindex] := source[sindex]; + ssize := SYS.VAL (INTEGER, ssize) - 1; + dsize := dsize - 1; + INC(dindex); INC(sindex); + END; + IF dsize > 0 THEN + (* sindex has been incremented at least once because + * ssize and dsize were greater than 0, i.e. sindex-1 + * is a valid inex. *) + fill := 0X; + IF ~(unsigned IN flags) & (source[sindex-1] >= 080X) THEN + fill := 0FFX; + END; + END; + WHILE dsize > 0 DO + dest[dindex] := fill; + dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); + END; + END; + END; + END Convert; + + PROCEDURE ByAddrToC*(from, to: Address; format: ARRAY OF CHAR); + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO + Convert(from + offset1, to + offset2, size1, size2, flags); + END; + Close(cv); + END ByAddrToC; + + PROCEDURE ByAddrFromC*(from, to: Address; format: ARRAY OF CHAR); + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO + Convert(from + offset2, to + offset1, size2, size1, flags); + END; + Close(cv); + END ByAddrFromC; + + PROCEDURE CSize*(format: ARRAY OF CHAR) : Size; + (* returns the size of the C-structure described by `format' *) + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + size: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END; + Close(cv); + size := offset2 + size2; + Align(size, 2); + RETURN size + END CSize; + + PROCEDURE OberonSize*(format: ARRAY OF CHAR) : Size; + (* returns the size of the Oberon-structure described by `format' *) + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + size: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END; + Close(cv); + size := offset1 + size1; + Align(size, SIZE(INTEGER)); + RETURN size + END OberonSize; + + PROCEDURE ToC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR); + BEGIN + IF OberonSize(format) > LEN(from) THEN + SizeError("Oberon record is too small", format); RETURN + END; + IF CSize(format) > LEN(to) THEN + SizeError("C structure is too small", format); RETURN + END; + ByAddrToC(SYS.ADR(from), SYS.ADR(to), format); + END ToC; + + PROCEDURE FromC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR); + BEGIN + IF OberonSize(format) > LEN(to) THEN + SizeError("Oberon record is too small", format); RETURN + END; + IF CSize(format) > LEN(from) THEN + SizeError("C structure is too small", format); RETURN + END; + ByAddrFromC(SYS.ADR(from), SYS.ADR(to), format); + END FromC; + + PROCEDURE Compile*(VAR fmt: Format; format: ARRAY OF CHAR); + (* translate format into an internal representation + which is later referenced by fmt; + ByFmtToC and ByFmtFromC are faster than ToC and FromC + *) + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + flags: Flags; + element: Format; + head, tail: Format; + BEGIN + Open(cv, format); + head := NIL; tail := NIL; + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO + NEW(element); + element.offset1 := offset1; + element.offset2 := offset2; + element.size1 := size1; + element.size2 := size2; + element.flags := flags; + element.next := NIL; + IF tail # NIL THEN + tail.next := element; + ELSE + head := element; + END; + tail := element; + END; + fmt := head; + Close(cv); + END Compile; + + PROCEDURE ByFmtAndAddrToC*(from, to: Address; format: Format); + VAR + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + WHILE format # NIL DO + Convert(from + format.offset1, to + format.offset2, + format.size1, format.size2, format.flags); + format := format.next; + END; + END ByFmtAndAddrToC; + + PROCEDURE ByFmtAndAddrFromC*(from, to: Address; format: Format); + VAR + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + WHILE format # NIL DO + Convert(from + format.offset2, to + format.offset1, + format.size2, format.size1, format.flags); + format := format.next; + END; + END ByFmtAndAddrFromC; + + PROCEDURE ByFmtToC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format); + BEGIN + ByFmtAndAddrToC(SYS.ADR(from), SYS.ADR(to), format); + END ByFmtToC; + + PROCEDURE ByFmtFromC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format); + BEGIN + ByFmtAndAddrFromC(SYS.ADR(from), SYS.ADR(to), format); + END ByFmtFromC; + +BEGIN + Events.Define(badformat); + Events.SetPriority(badformat, Priorities.liberrors); +END ulmSysConversions. diff --git a/src/lib/ulm/x86/ulmSysStat.Mod b/src/lib/ulm/x86/ulmSysStat.Mod new file mode 100644 index 00000000..d995779e --- /dev/null +++ b/src/lib/ulm/x86/ulmSysStat.Mod @@ -0,0 +1,200 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: SysStat.om,v 1.3 2000/11/12 13:02:09 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: SysStat.om,v $ + Revision 1.3 2000/11/12 13:02:09 borchert + door file type added + + Revision 1.2 2000/11/12 12:48:07 borchert + - conversion adapted to Solaris 2.x + - Lstat added + + Revision 1.1 1994/02/23 08:00:48 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 9/89 + ---------------------------------------------------------------------------- +*) + +MODULE ulmSysStat; + + (* examine inode: stat(2) and fstat(2) *) + + IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, SysConversions := ulmSysConversions, SysError := ulmSysErrors, + SysTypes := ulmSysTypes; + + CONST + (* file mode: + bit 0 = 1<<0 bit 31 = 1<<31 + + user group other + 3 1 1111 11 + 1 ... 6 5432 109 876 543 210 + +--------+------+-----+-----+-----+-----+ + | unused | type | sst | rwx | rwx | rwx | + +--------+------+-----+-----+-----+-----+ + *) + + type* = {12..15}; + prot* = {0..8}; + + (* file types; example: (stat.mode * type = dir) *) + reg* = {15}; (* regular *) + dir* = {14}; (* directory *) + chr* = {13}; (* character special *) + fifo* = {12}; (* fifo *) + blk* = {13..14}; (* block special *) + symlink* = {13, 15}; (* symbolic link *) + socket* = {14, 15}; (* socket *) + + (* special *) + setuid* = 11; (* set user id on execution *) + setgid* = 10; (* set group id on execution *) + savetext* = 9; (* save swapped text even after use *) + + (* protection *) + uread* = 8; (* read permission owner *) + uwrite* = 7; (* write permission owner *) + uexec* = 6; (* execute/search permission owner *) + gread* = 5; (* read permission group *) + gwrite* = 4; (* write permission group *) + gexec* = 3; (* execute/search permission group *) + oread* = 2; (* read permission other *) + owrite* = 1; (* write permission other *) + oexec* = 0; (* execute/search permission other *) + + (* example for "r-xr-x---": (read + exec) * (owner + group) *) + owner* = {uread, uwrite, uexec}; + group* = {gread, gwrite, gexec}; + other* = {oread, owrite, oexec}; + read* = {uread, gread, oread}; + write* = {uwrite, gwrite, owrite}; + exec* = {uexec, gexec, oexec}; + rwx* = prot; + + TYPE + StatRec* = (* result of stat(2) and fstat(2) *) + RECORD + device*: SysTypes.Device; (* ID of device containing + a directory entry for this file *) + inode*: SysTypes.Inode; (* inode number *) + mode*: SET; (* file mode; see mknod(2) *) + nlinks*: INTEGER; (* number of links *) + uid*: INTEGER; (* user id of the file's owner *) + gid*: INTEGER; (* group id of the file's group *) + rdev*: SysTypes.Device; (* ID of device + this entry is defined only for + character special or block + special files + *) + size*: SysTypes.Offset; (* file size in bytes *) + blksize*: LONGINT; (* preferred blocksize *) + blocks*: LONGINT; (* # of blocks allocated *) + atime*: SysTypes.Time; (* time of last access *) + mtime*: SysTypes.Time; (* time of last data modification *) + ctime*: SysTypes.Time; (* time of last file status change *) + END; + +(* Linux kernel struct stat (2.2.17) + struct stat { + unsigned short st_dev; + unsigned short __pad1; + unsigned long st_ino; + unsigned short st_mode; + unsigned short st_nlink; + unsigned short st_uid; + unsigned short st_gid; + unsigned short st_rdev; + unsigned short __pad2; + unsigned long st_size; + unsigned long st_blksize; + unsigned long st_blocks; + unsigned long st_atime; + unsigned long __unused1; + unsigned long st_mtime; + unsigned long __unused2; + unsigned long st_ctime; + unsigned long __unused3; + unsigned long __unused4; + unsigned long __unused5; + }; +*) + + CONST + statbufsize = 88(*64*); (* see *) (* sizeof struct stat gives us 144 on x86_64 and 88 on x86 *) + TYPE + UnixStatRec = ARRAY statbufsize OF SYS.BYTE; + CONST + statbufconv = + (*"is=dev/-s=pad1/ll=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/ll=size/2*ll=blksize,blocks/il=atime/-l/il=mtime/-l/il=ctime/3*-l";*) + "ls=dev/-s=pad1/lL=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/lL=size/2*lL=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l"; + VAR + statbuffmt: SysConversions.Format; + + PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1, d2: LONGINT; + origbuf: UnixStatRec; + BEGIN + IF SYS.UNIXCALL(Sys.newstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf), d2) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newstat, path); + RETURN FALSE + END; + END Stat; + + PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1: INTEGER; + origbuf: UnixStatRec; + BEGIN + IF SYS.UNIXCALL(Sys.newlstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf)) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newlstat, path); + RETURN FALSE + END; + END Lstat; + + PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1: INTEGER; + origbuf: UnixStatRec; + BEGIN + IF SYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf)) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newfstat, ""); + RETURN FALSE + END; + END Fstat; + +BEGIN + SysConversions.Compile(statbuffmt, statbufconv); +END ulmSysStat. diff --git a/src/lib/ulm/x86_64/ulmSysConversions.Mod b/src/lib/ulm/x86_64/ulmSysConversions.Mod new file mode 100644 index 00000000..e1047a58 --- /dev/null +++ b/src/lib/ulm/x86_64/ulmSysConversions.Mod @@ -0,0 +1,574 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: SysConversi.om,v 1.2 1997/07/30 09:38:16 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: SysConversi.om,v $ + Revision 1.2 1997/07/30 09:38:16 borchert + bug in ReadConv fixed: cv.flags was used but not set for + counts > 1 + + Revision 1.1 1994/02/23 07:58:28 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 8/90 + adapted to linux cae 02/01 + ---------------------------------------------------------------------------- +*) + +MODULE ulmSysConversions; + + (* convert Oberon records to/from C structures *) + + IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Streams := ulmStreams, Strings := ulmStrings, + SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts; + + TYPE + Address* = SysTypes.Address; + Size* = Address; + + (* format: + + Format = Conversion { "/" Conversion } . + Conversion = [ Factors ] ConvChars [ Comment ] . + Factors = Array | Factor | Array Factor | Factor Array . + Array = Integer ":" . + Factor = Integer "*" . + ConvChars = OberonType CType | Skip CType | OberonType Skip . + OberonType = "a" | "b" | "c" | "s" | "i" | "l" | "S" . + CType = "a" | "c" | "s" | "i" | "l" . + Integer = Digit { Digit } . + Digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" . + Skip = "-" . + Comment = "=" { AnyChar } . + AnyChar = (* all characters except "/" *) . + + Oberon data types: + + a: Address + b: SYS.BYTE + B: BOOLEAN + c: CHAR + s: SHORTINT + i: INTEGER + l: LONGINT + S: SET + + C data types: + + a: char * + c: /* signed */ char + C: unsigned char + s: short int + S: unsigned short int + i: int + I: unsigned int + u: unsigned int + l: long int + L: unsigned long int + + example: + + conversion from + + Rec = + RECORD + a, b: INTEGER; + c: CHAR; + s: SET; + f: ARRAY 3 OF INTEGER; + END; + + to + + struct rec { + short a, b; + char c; + int xx; /* to be skipped on conversion */ + int s; + int f[3]; + }; + + or vice versa: + + "2*is=a,b/cc=c/-i=xx/Si=s/3:ii=f" + + The comments allow to give the field names. + *) + + CONST + (* conversion flags *) + unsigned = 0; (* suppress sign extension *) + boolean = 1; (* convert anything # 0 to 1 *) + TYPE + Flags = SET; + Event* = POINTER TO EventRec; + EventRec* = + RECORD + (Events.EventRec) + format*: Events.Message; + END; + ConvStream = POINTER TO ConvStreamRec; + ConvStreamRec = + RECORD + fmt: Texts.Text; + char: CHAR; + eof: BOOLEAN; + (* 1: Oberon type + 2: C type + *) + type1, type2: CHAR; length: INTEGER; left: INTEGER; + offset1, offset2: Address; + size1, size2: Address; elementsleft: INTEGER; flags: Flags; + END; + + Format* = POINTER TO FormatRec; + FormatRec* = + RECORD + (Objects.ObjectRec) + offset1, offset2: Address; + size1, size2: Address; + flags: Flags; + next: Format; + END; + VAR + badformat*: Events.EventType; + + PROCEDURE Error(cv: ConvStream; msg: ARRAY OF CHAR); + VAR + event: Event; + BEGIN + NEW(event); + event.type := badformat; + event.message := "SysConversions: "; + Strings.Concatenate(event.message, msg); + Strings.Read(event.format, cv.fmt); + Events.Raise(event); + cv.eof := TRUE; + cv.char := 0X; + cv.left := 0; + cv.elementsleft := 0; + END Error; + + PROCEDURE SizeError(msg, format: ARRAY OF CHAR); + VAR + event: Event; + BEGIN + NEW(event); + event.type := badformat; + event.message := "SysConversions: "; + Strings.Concatenate(event.message, msg); + COPY(format, event.format); + Events.Raise(event); + END SizeError; + + PROCEDURE NextCh(cv: ConvStream); + BEGIN + cv.eof := cv.eof OR ~Streams.ReadByte(cv.fmt, cv.char) OR (cv.char = 0X); + IF cv.eof THEN + cv.char := 0X; + END; + END NextCh; + + PROCEDURE IsDigit(ch: CHAR) : BOOLEAN; + BEGIN + RETURN (ch >= "0") & (ch <= "9") + END IsDigit; + + PROCEDURE ReadInt(cv: ConvStream; VAR i: INTEGER); + BEGIN + i := 0; + REPEAT + i := 10 * i + ORD(cv.char) - ORD("0"); + NextCh(cv); + UNTIL ~IsDigit(cv.char); + END ReadInt; + + PROCEDURE Open(VAR cv: ConvStream; format: ARRAY OF CHAR); + BEGIN + NEW(cv); + Texts.Open(SYS.VAL(Streams.Stream, cv.fmt)); + Strings.Write(cv.fmt, format); + cv.left := 0; cv.elementsleft := 0; + cv.offset1 := 0; cv.offset2 := 0; + cv.eof := FALSE; + NextCh(cv); + END Open; + + PROCEDURE Close(VAR cv: ConvStream); + BEGIN + IF ~Streams.Close(cv.fmt) THEN END; + END Close; + + PROCEDURE ScanConv(cv: ConvStream; + VAR type1, type2: CHAR; + VAR length: INTEGER) : BOOLEAN; + VAR + i: INTEGER; + factor: INTEGER; + BEGIN + IF cv.left > 0 THEN + type1 := cv.type1; + type2 := cv.type2; + length := cv.length; + DEC(cv.left); + RETURN TRUE + END; + IF cv.char = "/" THEN + NextCh(cv); + END; + IF cv.eof THEN + RETURN FALSE + END; + factor := 0; length := 0; + WHILE IsDigit(cv.char) DO + ReadInt(cv, i); + IF i <= 0 THEN + Error(cv, "integer must be positive"); RETURN FALSE + END; + IF cv.char = ":" THEN + IF length # 0 THEN + Error(cv, "multiple length specification"); RETURN FALSE + END; + length := i; + NextCh(cv); + ELSIF cv.char = "*" THEN + IF factor # 0 THEN + Error(cv, "multiple factor specification"); RETURN FALSE + END; + factor := i; cv.left := factor - 1; + NextCh(cv); + ELSE + Error(cv, "factor or length expected"); RETURN FALSE + END; + END; + type1 := cv.char; NextCh(cv); + type2 := cv.char; NextCh(cv); + IF cv.left > 0 THEN + cv.type1 := type1; cv.type2 := type2; cv.length := length; + END; + IF cv.char = "=" THEN (* comment *) + REPEAT + NextCh(cv); + UNTIL cv.eof OR (cv.char = "/"); + END; + RETURN TRUE + END ScanConv; + + PROCEDURE Align(VAR offset: Address; boundary: Address); + BEGIN + IF SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary) # 0 THEN + offset := SYS.VAL (INTEGER, offset) + (SYS.VAL (INTEGER, boundary) - SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary)); + END; + END Align; + + PROCEDURE ReadConv(cv: ConvStream; + VAR offset1, offset2: Address; + VAR size1, size2: Address; + VAR flags: Flags) : BOOLEAN; + VAR + type1, type2: CHAR; + length: INTEGER; + align: BOOLEAN; + boundary: INTEGER; + BEGIN + IF cv.elementsleft > 0 THEN + DEC(cv.elementsleft); + + (* Oberon type *) + IF size1 > SIZE(SYS.BYTE) THEN + Align(cv.offset1, SIZE(INTEGER)); + END; + offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; + size1 := cv.size1; size2 := cv.size2; flags := cv.flags; + IF (size1 > 0) & (cv.elementsleft = 0) THEN + Align(cv.offset1, SIZE(INTEGER)); + END; + + (* C type *) + IF size2 > 1 THEN + Align(cv.offset2, 2); + END; + offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); + + RETURN TRUE + END; + IF ScanConv(cv, type1, type2, length) THEN + flags := {}; + (* Oberon type *) + CASE type1 OF + | "a": size1 := SIZE(Address); INCL(flags, unsigned); + | "b": size1 := SIZE(SYS.BYTE); INCL(flags, unsigned); + | "B": size1 := SIZE(BOOLEAN); INCL(flags, boolean); + | "c": size1 := SIZE(CHAR); INCL(flags, unsigned); + | "s": size1 := SIZE(SHORTINT); + | "i": size1 := SIZE(INTEGER); + | "l": size1 := SIZE(LONGINT); + | "S": size1 := SIZE(SET); INCL(flags, unsigned); + | "-": size1 := 0; + ELSE Error(cv, "bad Oberon type specifier"); RETURN FALSE + END; + IF size1 > 0 THEN + IF length > 0 THEN + Align(cv.offset1, SIZE(INTEGER)); + ELSIF size1 > SIZE(SYS.BYTE) THEN + Align(cv.offset1, SIZE(INTEGER)); + END; + END; + offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; + + (* C type *) + CASE type2 OF + | "a": size2 := 8; INCL(flags, unsigned); (* char* *) + | "c": size2 := 1; (* /* signed */ char *) + | "C": size2 := 1; INCL(flags, unsigned); (* unsigned char *) + | "s": size2 := 2; (* short int *) + | "S": size2 := 2; INCL(flags, unsigned); (* unsigned short int *) + | "i": size2 := 4; (* int *) + | "I": size2 := 4; INCL(flags, unsigned); (* unsigned int *) + | "u": size2 := 4; INCL(flags, unsigned); (* unsigned int *) + | "l": size2 := 8; (* long int *) + | "L": size2 := 8; INCL(flags, unsigned); (* long int *) + | "-": size2 := 0; + ELSE Error(cv, "bad C type specifier"); RETURN FALSE + END; + IF size2 > 1 THEN + Align(cv.offset2, size2); + END; + offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); + + cv.size1 := size1; cv.size2 := size2; + IF length > 0 THEN + cv.elementsleft := length - 1; + cv.flags := flags; + END; + RETURN TRUE + ELSE + RETURN FALSE + END; + END ReadConv; + + PROCEDURE Convert(from, to: Address; ssize, dsize: Address; flags: Flags); + TYPE + Bytes = ARRAY 8 OF CHAR; + Pointer = POINTER TO Bytes; + VAR + dest, source: Pointer; + dindex, sindex: INTEGER; + nonzero: BOOLEAN; + fill : CHAR; + BEGIN + IF ssize > 0 THEN + dest := SYS.VAL(Pointer, to); + source := SYS.VAL(Pointer, from); + dindex := 0; sindex := 0; + IF boolean IN flags THEN + nonzero := FALSE; + WHILE ssize > 0 DO + nonzero := nonzero OR (source[sindex] # 0X); + INC(sindex); ssize := SYS.VAL (INTEGER, ssize) - 1; + END; + IF dsize > 0 THEN + IF nonzero THEN + dest[dindex] := 1X; + ELSE + dest[dindex] := 0X; + END; + dsize := dsize - 1; INC (dindex); + END; + WHILE dsize > 0 DO + dest[dindex] := 0X; + dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); + END; + ELSE + WHILE (dsize > 0) & (ssize > 0) DO + dest[dindex] := source[sindex]; + ssize := SYS.VAL (INTEGER, ssize) - 1; + dsize := dsize - 1; + INC(dindex); INC(sindex); + END; + IF dsize > 0 THEN + (* sindex has been incremented at least once because + * ssize and dsize were greater than 0, i.e. sindex-1 + * is a valid inex. *) + fill := 0X; + IF ~(unsigned IN flags) & (source[sindex-1] >= 080X) THEN + fill := 0FFX; + END; + END; + WHILE dsize > 0 DO + dest[dindex] := fill; + dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); + END; + END; + END; + END Convert; + + PROCEDURE ByAddrToC*(from, to: Address; format: ARRAY OF CHAR); + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO + Convert(from + offset1, to + offset2, size1, size2, flags); + END; + Close(cv); + END ByAddrToC; + + PROCEDURE ByAddrFromC*(from, to: Address; format: ARRAY OF CHAR); + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO + Convert(from + offset2, to + offset1, size2, size1, flags); + END; + Close(cv); + END ByAddrFromC; + + PROCEDURE CSize*(format: ARRAY OF CHAR) : Size; + (* returns the size of the C-structure described by `format' *) + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + size: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END; + Close(cv); + size := offset2 + size2; + Align(size, 2); + RETURN size + END CSize; + + PROCEDURE OberonSize*(format: ARRAY OF CHAR) : Size; + (* returns the size of the Oberon-structure described by `format' *) + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + size: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END; + Close(cv); + size := offset1 + size1; + Align(size, SIZE(INTEGER)); + RETURN size + END OberonSize; + + PROCEDURE ToC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR); + BEGIN + IF OberonSize(format) > LEN(from) THEN + SizeError("Oberon record is too small", format); RETURN + END; + IF CSize(format) > LEN(to) THEN + SizeError("C structure is too small", format); RETURN + END; + ByAddrToC(SYS.ADR(from), SYS.ADR(to), format); + END ToC; + + PROCEDURE FromC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR); + BEGIN + IF OberonSize(format) > LEN(to) THEN + SizeError("Oberon record is too small", format); RETURN + END; + IF CSize(format) > LEN(from) THEN + SizeError("C structure is too small", format); RETURN + END; + ByAddrFromC(SYS.ADR(from), SYS.ADR(to), format); + END FromC; + + PROCEDURE Compile*(VAR fmt: Format; format: ARRAY OF CHAR); + (* translate format into an internal representation + which is later referenced by fmt; + ByFmtToC and ByFmtFromC are faster than ToC and FromC + *) + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + flags: Flags; + element: Format; + head, tail: Format; + BEGIN + Open(cv, format); + head := NIL; tail := NIL; + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO + NEW(element); + element.offset1 := offset1; + element.offset2 := offset2; + element.size1 := size1; + element.size2 := size2; + element.flags := flags; + element.next := NIL; + IF tail # NIL THEN + tail.next := element; + ELSE + head := element; + END; + tail := element; + END; + fmt := head; + Close(cv); + END Compile; + + PROCEDURE ByFmtAndAddrToC*(from, to: Address; format: Format); + VAR + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + WHILE format # NIL DO + Convert(from + format.offset1, to + format.offset2, + format.size1, format.size2, format.flags); + format := format.next; + END; + END ByFmtAndAddrToC; + + PROCEDURE ByFmtAndAddrFromC*(from, to: Address; format: Format); + VAR + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + WHILE format # NIL DO + Convert(from + format.offset2, to + format.offset1, + format.size2, format.size1, format.flags); + format := format.next; + END; + END ByFmtAndAddrFromC; + + PROCEDURE ByFmtToC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format); + BEGIN + ByFmtAndAddrToC(SYS.ADR(from), SYS.ADR(to), format); + END ByFmtToC; + + PROCEDURE ByFmtFromC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format); + BEGIN + ByFmtAndAddrFromC(SYS.ADR(from), SYS.ADR(to), format); + END ByFmtFromC; + +BEGIN + Events.Define(badformat); + Events.SetPriority(badformat, Priorities.liberrors); +END ulmSysConversions. diff --git a/src/lib/ulm/x86_64/ulmSysStat.Mod b/src/lib/ulm/x86_64/ulmSysStat.Mod new file mode 100644 index 00000000..54d1fc41 --- /dev/null +++ b/src/lib/ulm/x86_64/ulmSysStat.Mod @@ -0,0 +1,227 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: SysStat.om,v 1.3 2000/11/12 13:02:09 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: SysStat.om,v $ + Revision 1.3 2000/11/12 13:02:09 borchert + door file type added + + Revision 1.2 2000/11/12 12:48:07 borchert + - conversion adapted to Solaris 2.x + - Lstat added + + Revision 1.1 1994/02/23 08:00:48 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 9/89 + ---------------------------------------------------------------------------- +*) + +MODULE ulmSysStat; + + (* examine inode: stat(2) and fstat(2) *) + + IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, uSYS := ulmSYSTEM, SysConversions := ulmSysConversions, SysErrors := ulmSysErrors, + SysTypes := ulmSysTypes; + + CONST + (* file mode: + bit 0 = 1<<0 bit 31 = 1<<31 + + user group other + 3 1 1111 11 + 1 ... 6 5432 109 876 543 210 + +--------+------+-----+-----+-----+-----+ + | unused | type | sst | rwx | rwx | rwx | + +--------+------+-----+-----+-----+-----+ + *) + + type* = {12..15}; + prot* = {0..8}; + + (* file types; example: (stat.mode * type = dir) *) + reg* = {15}; (* regular *) + dir* = {14}; (* directory *) + chr* = {13}; (* character special *) + fifo* = {12}; (* fifo *) + blk* = {13..14}; (* block special *) + symlink* = {13, 15}; (* symbolic link *) + socket* = {14, 15}; (* socket *) + + (* special *) + setuid* = 11; (* set user id on execution *) + setgid* = 10; (* set group id on execution *) + savetext* = 9; (* save swapped text even after use *) + + (* protection *) + uread* = 8; (* read permission owner *) + uwrite* = 7; (* write permission owner *) + uexec* = 6; (* execute/search permission owner *) + gread* = 5; (* read permission group *) + gwrite* = 4; (* write permission group *) + gexec* = 3; (* execute/search permission group *) + oread* = 2; (* read permission other *) + owrite* = 1; (* write permission other *) + oexec* = 0; (* execute/search permission other *) + + (* example for "r-xr-x---": (read + exec) * (owner + group) *) + owner* = {uread, uwrite, uexec}; + group* = {gread, gwrite, gexec}; + other* = {oread, owrite, oexec}; + read* = {uread, gread, oread}; + write* = {uwrite, gwrite, owrite}; + exec* = {uexec, gexec, oexec}; + rwx* = prot; + + TYPE + StatRec* = (* result of stat(2) and fstat(2) *) + RECORD + device*: SysTypes.Device; (* ID of device containing + a directory entry for this file *) + inode*: SysTypes.Inode; (* inode number *) + nlinks*: LONGINT(*INTEGER*); (* number of links *) + mode*: SET; (* file mode; see mknod(2) *) + uid*: INTEGER; (* user id of the file's owner *) + gid*: INTEGER; (* group id of the file's group *) + rdev*: SysTypes.Device; (* ID of device + this entry is defined only for + character special or block + special files + *) + size*: SysTypes.Offset; (* file size in bytes *) + blksize*: LONGINT; (* preferred blocksize *) + blocks*: LONGINT; (* # of blocks allocated *) + atime*: SysTypes.Time; (* time of last access *) + mtime*: SysTypes.Time; (* time of last data modification *) + ctime*: SysTypes.Time; (* time of last file status change *) + END; + +(* StatRec* = (* result of stat(2) and fstat(2) *) + RECORD + device*: SysTypes.Device; (* ID of device containing + a directory entry for this file *) + inode*: SysTypes.Inode; (* inode number *) + nlinks*: LONGINT; (* number of links *) + mode*: INTEGER(*SET*); (* file mode; see mknod(2) *) + uid*: INTEGER; (* user id of the file's owner *) + gid*: INTEGER; (* group id of the file's group *) + pad0: INTEGER; + rdev*: SysTypes.Device; (* ID of device + this entry is defined only for + character special or block + special files + *) + size*: SysTypes.Offset; (* file size in bytes *) + blksize*: LONGINT; (* preferred blocksize *) + blocks*: LONGINT; (* # of blocks allocated *) + atime*: SysTypes.Time; (* time of last access *) + atimences* : LONGINT; + mtime*: SysTypes.Time; (* time of last data modification *) + mtimensec* : LONGINT; + ctime*: SysTypes.Time; (* time of last file status change *) + ctimensec* : LONGINT; + unused0*, unused1*, unused2*: LONGINT; + END; +*) +(* Linux kernel struct stat (2.2.17) + struct stat { + unsigned short st_dev; + unsigned short __pad1; + unsigned long st_ino; + unsigned short st_mode; + unsigned short st_nlink; + unsigned short st_uid; + unsigned short st_gid; + unsigned short st_rdev; + unsigned short __pad2; + unsigned long st_size; + unsigned long st_blksize; + unsigned long st_blocks; + unsigned long st_atime; + unsigned long __unused1; + unsigned long st_mtime; + unsigned long __unused2; + unsigned long st_ctime; + unsigned long __unused3; + unsigned long __unused4; + unsigned long __unused5; + }; +*) + + CONST + statbufsize = 144(*64*); (* see *) (* sizeof struct stat gives us 144 on x86_64 and 88 or x86; -- noch *) + TYPE + UnixStatRec = ARRAY statbufsize OF SYS.BYTE; + CONST + statbufconv = + (*"is=dev/-s=pad1/ll=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/ll=size/2*ll=blksize,blocks/il=atime/-l/il=mtime/-l/il=ctime/3*-l";*) + "lL=dev/lL=ino/lL=nlink/Su=mode/2*iu=uid+gid/-i=pad0/lL=rdev/ll=size/2*ll=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l"; (* noch *) + VAR + statbuffmt: SysConversions.Format; + + PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1, d2: LONGINT; + origbuf: UnixStatRec; + BEGIN + IF uSYS.UNIXCALL(Sys.newstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf), d2) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newstat, path); + RETURN FALSE + END; + END Stat; +(* commented temporarily, it is used only in FTPUnixDirLister module *) (* + PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1: INTEGER; + origbuf: UnixStatRec; + BEGIN + IF SYS.UNIXCALL(Sys.newlstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf)) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newlstat, path); + RETURN FALSE + END; + END Lstat; +*) + PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1, d2: LONGINT; + origbuf: UnixStatRec; + BEGIN + IF uSYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf), d2) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newfstat, ""); + RETURN FALSE + END; + END Fstat; + +BEGIN + SysConversions.Compile(statbuffmt, statbufconv); +END ulmSysStat.