x86_86 gcc/clang low level modules update, types clarified. -- noch

This commit is contained in:
Norayr Chilingarian 2015-02-10 15:06:04 +04:00
parent 305c759d79
commit 59e489ea43
42 changed files with 8324 additions and 2078 deletions

View file

@ -7,10 +7,6 @@ MODULE Console; (* J. Templ, 29-June-96 *)
VAR line: ARRAY 128 OF CHAR;
pos: INTEGER;
(* for read(), write() *)
PROCEDURE -includeUnistd()
"#include <unistd.h>";
PROCEDURE -Write(adr, n: LONGINT)
"write(1/*stdout*/, adr, n)";

View file

@ -20,7 +20,7 @@
#include "varargs.h"
#endif
extern void *malloc(unsigned int size);
extern void *malloc(long size);
extern void exit(int status);
void (*SYSTEM_Halt)();

View file

@ -15,7 +15,7 @@ uses double # as concatenation operator
//extern void *memcpy(void *dest, const void *src, long n);
extern void *memcpy(void *dest, const void *src, size_t n);
extern void *malloc(unsigned int size);
extern void *malloc(long size);
extern void exit(int status);
#define export

View file

@ -20,7 +20,7 @@
#include "varargs.h"
#endif
extern void *malloc(unsigned int size);
extern void *malloc(long size);
extern void exit(int status);
void (*SYSTEM_Halt)();

View file

@ -15,7 +15,7 @@ uses double # as concatenation operator
//extern void *memcpy(void *dest, const void *src, long n);
extern void *memcpy(void *dest, const void *src, size_t n);
extern void *malloc(unsigned int size);
extern void *malloc(long size);
extern void exit(int status);
#define export

View file

@ -0,0 +1,663 @@
MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
(* modified version of Files, which opens only the file provided and does not scan any path in any environment variable, also ReadLine procedure added; -- noch *)
IMPORT SYSTEM, Unix, Kernel, Args, Console;
(* standard data type I/O
little endian,
Sint:1, Int:2, Lint:4
ORD({0}) = 1,
false = 0, true =1
IEEE real format,
null terminated strings,
compact numbers according to M.Odersky *)
CONST
nofbufs = 4;
bufsize = 4096;
fileTabSize = 64;
noDesc = -1;
notDone = -1;
(* file states *)
open = 0; create = 1; close = 2;
TYPE
FileName = ARRAY 101 OF CHAR;
File* = POINTER TO Handle;
Buffer = POINTER TO BufDesc;
Handle = RECORD
workName, registerName: FileName;
tempFile: BOOLEAN;
dev, ino, mtime: LONGINT;
fd-, len, pos: LONGINT;
bufs: ARRAY nofbufs OF Buffer;
swapper, state: INTEGER
END ;
BufDesc = RECORD
f: File;
chg: BOOLEAN;
org, size: LONGINT;
data: ARRAY bufsize OF SYSTEM.BYTE
END ;
Rider* = RECORD
res*: LONGINT;
eof*: BOOLEAN;
buf: Buffer;
org, offset: LONGINT
END ;
Time = POINTER TO TimeDesc;
TimeDesc = RECORD
sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
END ;
VAR
fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
tempno: INTEGER;
(* for localtime *)
PROCEDURE -includetime()
'#include "time.h"';
PROCEDURE -localtime(VAR clock: LONGINT): Time
"(Files_Time) localtime(clock)";
PROCEDURE -getcwd(VAR cwd: Unix.Name)
"getcwd(cwd, cwd__len)";
PROCEDURE -IdxTrap "__HALT(-1)";
PROCEDURE^ Finalize(o: SYSTEM.PTR);
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
BEGIN
Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
IF f # NIL THEN
IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
END ;
IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
Console.Ln;
HALT(99)
END Err;
PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN i := 0; j := 0;
WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ;
IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ;
WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ;
dest[i] := 0X
END MakeFileName;
PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
VAR n, i, j: LONGINT;
BEGIN
INC(tempno); n := tempno; i := 0;
IF finalName[0] # "/" THEN (* relative pathname *)
WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END
END;
j := 0;
WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END;
DEC(i);
WHILE name[i] # "/" DO DEC(i) END;
name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6);
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := "."; INC(i); n := SHORT(Unix.Getpid());
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := 0X
END GetTempName;
PROCEDURE Create(f: File);
VAR stat: Unix.Status; done: BOOLEAN;
errno: LONGINT; err: ARRAY 32 OF CHAR;
BEGIN
IF f.fd = noDesc THEN
IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
ELSIF f.state = close THEN
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END ;
errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
Kernel.GC(TRUE);
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0
END ;
IF done THEN
IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
END
ELSE errno := Unix.errno();
IF errno = Unix.ENOENT THEN err := "no such directory"
ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
ELSE err := "file not created"
END ;
Err(err, f, errno)
END
END
END Create;
PROCEDURE Flush(buf: Buffer);
VAR res: LONGINT; f: File; stat: Unix.Status;
BEGIN
IF buf.chg THEN f := buf.f; Create(f);
IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
f.pos := buf.org + buf.size;
buf.chg := FALSE;
res := Unix.Fstat(f.fd, stat);
f.mtime := stat.mtime
END
END Flush;
PROCEDURE Close* (f: File);
VAR i, res: LONGINT;
BEGIN
IF (f.state # create) OR (f.registerName # "") THEN
Create(f); i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
res := Unix.Fsync(f.fd);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
END
END Close;
PROCEDURE Length* (f: File): LONGINT;
BEGIN RETURN f.len
END Length;
PROCEDURE New* (name: ARRAY OF CHAR): File;
VAR f: File;
BEGIN
NEW(f); f.workName := ""; COPY(name, f.registerName);
f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
RETURN f
END New;
(*
PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
BEGIN
i := 0; ch := Kernel.OBERON[pos];
WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
IF ch = "~" THEN
INC(pos); ch := Kernel.OBERON[pos];
home := ""; Args.GetEnv("HOME", home);
WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
END
END ;
WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
dir[i] := 0X
END ScanPath;
*)
PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0; ch := name[0];
WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
RETURN ch = "/"
END HasDir;
PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < fileTabSize DO
f := SYSTEM.VAL(File, fileTab[i]);
IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
IF mtime # f.mtime THEN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
f.swapper := -1; f.mtime := mtime;
res := Unix.Fstat(f.fd, stat); f.len := stat.size
END ;
RETURN f
END ;
INC(i)
END ;
RETURN NIL
END CacheEntry;
PROCEDURE Old* (name: ARRAY OF CHAR): File;
VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN;
dir, path: ARRAY 256 OF CHAR;
stat: Unix.Status;
BEGIN
IF name # "" THEN
IF HasDir(name) THEN dir := ""; COPY(name, path)
ELSE
pos := 0;
COPY(name, path); (* -- noch *)
(*ScanPath(pos, dir);*) (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
END ;
LOOP
fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
Kernel.GC(TRUE);
fd := Unix.Open(path, Unix.rdwr, {});
done := fd >= 0; errno := Unix.errno();
IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
END ;
IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
(* errno EAGAIN observed on Solaris 2.4 *)
fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno()
END ;
IF (~done) & (errno # Unix.ENOENT) THEN
Console.String("warning Files.Old "); Console.String(name);
Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
END ;
IF done THEN
res := Unix.Fstat(fd, stat);
f := CacheEntry(stat.dev, stat.ino, stat.mtime);
IF f # NIL THEN res := Unix.Close(fd); RETURN f
ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
RETURN f
END
ELSIF dir = "" THEN RETURN NIL
ELSE (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
RETURN NIL
END
END
ELSE RETURN NIL
END
END Old;
PROCEDURE Purge* (f: File);
VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
f.pos := 0; f.len := 0; f.swapper := -1;
res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
END Purge;
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
BEGIN
Create(f); res := Unix.Fstat(f.fd, stat);
time := localtime(stat.mtime);
t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
END GetDate;
PROCEDURE Pos* (VAR r: Rider): LONGINT;
BEGIN RETURN r.org + r.offset
END Pos;
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
VAR org, offset, i, n, res: LONGINT; buf: Buffer;
BEGIN
IF f # NIL THEN
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
offset := pos MOD bufsize; org := pos - offset; i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
IF i < nofbufs THEN
IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
ELSE buf := f.bufs[i]
END
ELSE
f.swapper := (f.swapper + 1) MOD nofbufs;
buf := f.bufs[f.swapper];
Flush(buf)
END ;
IF buf.org # org THEN
IF org = f.len THEN buf.size := 0
ELSE Create(f);
IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
n := Unix.ReadBlk(f.fd, buf.data);
IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
f.pos := org + n;
buf.size := n
END ;
buf.org := org; buf.chg := FALSE
END
ELSE buf := NIL; org := 0; offset := 0
END ;
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
END Set;
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
IF (offset < buf.size) THEN
x := buf.data[offset]; r.offset := offset + 1
ELSIF r.org + offset < buf.f.len THEN
Set(r, r.buf.f, r.org + offset);
x := r.buf.data[0]; r.offset := 1
ELSE
x := 0X; r.eof := TRUE
END
END Read;
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := buf.size - offset;
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
END ;
r.res := 0; r.eof := FALSE
END ReadBytes;
PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
BEGIN
ReadBytes(r, x, 1);
END ReadByte;
PROCEDURE Base* (VAR r: Rider): File;
BEGIN RETURN r.buf.f
END Base;
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
buf.data[offset] := x;
buf.chg := TRUE;
IF offset = buf.size THEN
INC(buf.size); INC(buf.f.len)
END ;
r.offset := offset + 1; r.res := 0
END Write;
PROCEDURE WriteByte* (VAR r : Rider; x : SYSTEM.BYTE); (* added for compatibility with PO 2013, -- noch *)
BEGIN
Write(r, x);
END WriteByte;
PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := bufsize - offset;
IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
INC(offset, min); r.offset := offset;
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
INC(xpos, min); DEC(n, min); buf.chg := TRUE
END ;
r.res := 0
END WriteBytes;
(* another solution would be one that is similar to ReadBytes, WriteBytes.
No code duplication, more symmetric, only two ifs for
Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
must be made consistent with offset (if offset > buf.size) in a lazy way.
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= bufsize) OR (r.org # buf.org) THEN
Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
END ;
buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
END Write;
PROCEDURE WriteBytes ...
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= buf.size) OR (r.org # buf.org) THEN
IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
END
END ;
x := buf.data[offset]; r.offset := offset + 1
END Read;
but this would also affect Set, Length, and Flush.
Especially Length would become fairly complex.
*)
PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Unlink(name));
res := SHORT(Unix.errno())
END Delete;
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
VAR fdold, fdnew, n, errno, r: LONGINT;
ostat, nstat: Unix.Status;
buf: ARRAY 4096 OF CHAR;
BEGIN
r := Unix.Stat(old, ostat);
IF r >= 0 THEN
r := Unix.Stat(new, nstat);
IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
Delete(new, res); (* work around stale nfs handles *)
END ;
r := Unix.Rename(old, new);
IF r < 0 THEN res := SHORT(Unix.errno());
IF res = Unix.EXDEV THEN (* cross device link, move the file *)
fdold := Unix.Open(old, Unix.rdonly, {});
IF fdold < 0 THEN res := 2; RETURN END ;
fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
WHILE n > 0 DO
r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
Err("cannot move file", NIL, errno)
END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
END ;
errno := Unix.errno();
r := Unix.Close(fdold); r := Unix.Close(fdnew);
IF n = 0 THEN r := Unix.Unlink(old); res := 0
ELSE Err("cannot move file", NIL, errno)
END ;
ELSE RETURN (* res is Unix.Rename return code *)
END
END ;
res := 0
ELSE res := 2 (* old file not found *)
END
END Rename;
PROCEDURE Register* (f: File);
VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
BEGIN
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
Close(f);
IF f.registerName # "" THEN
Rename(f.workName, f.registerName, errno);
IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END
END Register;
PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Chdir(path));
getcwd(Kernel.CWD)
END ChangeDirectory;
PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
VAR i, j: LONGINT;
BEGIN
IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
END
END FlipBytes;
PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
BEGIN Read(R, SYSTEM.VAL(CHAR, x))
END ReadBool;
PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN ReadBytes(R, b, 2);
x := ORD(b[0]) + ORD(b[1])*256
END ReadInt;
PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
END ReadLInt;
PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
END ReadSet;
PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
END ReadReal;
PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
END ReadLReal;
PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
END ReadString;
(* need to read line; -- noch *)
PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR; b : BOOLEAN;
BEGIN i := 0;
b := FALSE;
REPEAT
Read(R, ch);
IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN
b := TRUE
ELSE
x[i] := ch;
INC(i);
END;
UNTIL b
END ReadLine;
PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
BEGIN s := 0; n := 0; Read(R, ch);
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
x := n
END ReadNum;
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
END WriteBool;
PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
WriteBytes(R, b, 2);
END WriteInt;
PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN
b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
WriteBytes(R, b, 4);
END WriteLInt;
PROCEDURE WriteSet* (VAR R: Rider; x: SET);
VAR b: ARRAY 4 OF CHAR; i: LONGINT;
BEGIN i := SYSTEM.VAL(LONGINT, x);
b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H);
WriteBytes(R, b, 4);
END WriteSet;
PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
END WriteReal;
PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
END WriteLReal;
PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE x[i] # 0X DO INC(i) END ;
WriteBytes(R, x, i+1)
END WriteString;
PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
BEGIN
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
Write(R, CHR(x MOD 128))
END WriteNum;
PROCEDURE GetName*(f: File; VAR name: ARRAY OF CHAR);
BEGIN
COPY (f.workName, name);
END GetName;
PROCEDURE Finalize(o: SYSTEM.PTR);
VAR f: File; res: LONGINT;
BEGIN
f := SYSTEM.VAL(File, o);
IF f.fd >= 0 THEN
fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
IF f.tempFile THEN res := Unix.Unlink(f.workName) END
END
END Finalize;
PROCEDURE Init;
VAR i: LONGINT;
BEGIN
i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
tempno := -1; Kernel.nofiles := 0
END Init;
BEGIN Init
END Files.

View file

@ -0,0 +1,635 @@
MODULE Files0; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
(* this module is not for use by developers and inteded to bootstrap voc *)
(* for general use import Files module *)
IMPORT SYSTEM, Unix, Kernel := Kernel0, Args, Console;
(* standard data type I/O
little endian,
Sint:1, Int:2, Lint:4
ORD({0}) = 1,
false = 0, true =1
IEEE real format,
null terminated strings,
compact numbers according to M.Odersky *)
CONST
nofbufs = 4;
bufsize = 4096;
fileTabSize = 64;
noDesc = -1;
notDone = -1;
(* file states *)
open = 0; create = 1; close = 2;
TYPE
FileName = ARRAY 101 OF CHAR;
File* = POINTER TO Handle;
Buffer = POINTER TO BufDesc;
Handle = RECORD
workName, registerName: FileName;
tempFile: BOOLEAN;
dev, ino, mtime: LONGINT;
fd-, len, pos: LONGINT;
bufs: ARRAY nofbufs OF Buffer;
swapper, state: INTEGER
END ;
BufDesc = RECORD
f: File;
chg: BOOLEAN;
org, size: LONGINT;
data: ARRAY bufsize OF SYSTEM.BYTE
END ;
Rider* = RECORD
res*: LONGINT;
eof*: BOOLEAN;
buf: Buffer;
org, offset: LONGINT
END ;
Time = POINTER TO TimeDesc;
TimeDesc = RECORD
sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
END ;
VAR
fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
tempno: INTEGER;
(* for localtime *)
PROCEDURE -includetime()
'#include "time.h"';
PROCEDURE -localtime(VAR clock: LONGINT): Time
"(Files0_Time) localtime(clock)";
PROCEDURE -getcwd(VAR cwd: Unix.Name)
"getcwd(cwd, cwd__len)";
PROCEDURE -IdxTrap "__HALT(-1)";
PROCEDURE^ Finalize(o: SYSTEM.PTR);
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
BEGIN
Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
IF f # NIL THEN
IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
END ;
IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
Console.Ln;
HALT(99)
END Err;
PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN i := 0; j := 0;
WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ;
IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ;
WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ;
dest[i] := 0X
END MakeFileName;
PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
VAR n, i, j: LONGINT;
BEGIN
INC(tempno); n := tempno; i := 0;
IF finalName[0] # "/" THEN (* relative pathname *)
WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END
END;
j := 0;
WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END;
DEC(i);
WHILE name[i] # "/" DO DEC(i) END;
name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6);
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := "."; INC(i); n := SHORT(Unix.Getpid());
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := 0X
END GetTempName;
PROCEDURE Create(f: File);
VAR stat: Unix.Status; done: BOOLEAN;
errno: LONGINT; err: ARRAY 32 OF CHAR;
BEGIN
IF f.fd = noDesc THEN
IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
ELSIF f.state = close THEN
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END ;
errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
Kernel.GC(TRUE);
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0
END ;
IF done THEN
IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
END
ELSE errno := Unix.errno();
IF errno = Unix.ENOENT THEN err := "no such directory"
ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
ELSE err := "file not created"
END ;
Err(err, f, errno)
END
END
END Create;
PROCEDURE Flush(buf: Buffer);
VAR res: LONGINT; f: File; stat: Unix.Status;
BEGIN
IF buf.chg THEN f := buf.f; Create(f);
IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
f.pos := buf.org + buf.size;
buf.chg := FALSE;
res := Unix.Fstat(f.fd, stat);
f.mtime := stat.mtime
END
END Flush;
PROCEDURE Close* (f: File);
VAR i, res: LONGINT;
BEGIN
IF (f.state # create) OR (f.registerName # "") THEN
Create(f); i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
res := Unix.Fsync(f.fd);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
END
END Close;
PROCEDURE Length* (f: File): LONGINT;
BEGIN RETURN f.len
END Length;
PROCEDURE New* (name: ARRAY OF CHAR): File;
VAR f: File;
BEGIN
NEW(f); f.workName := ""; COPY(name, f.registerName);
f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
RETURN f
END New;
PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
BEGIN
i := 0; ch := Kernel.OBERON[pos];
WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
IF ch = "~" THEN
INC(pos); ch := Kernel.OBERON[pos];
home := ""; Args.GetEnv("HOME", home);
WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
END
END ;
WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
dir[i] := 0X
END ScanPath;
PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0; ch := name[0];
WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
RETURN ch = "/"
END HasDir;
PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < fileTabSize DO
f := SYSTEM.VAL(File, fileTab[i]);
IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
IF mtime # f.mtime THEN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
f.swapper := -1; f.mtime := mtime;
res := Unix.Fstat(f.fd, stat); f.len := stat.size
END ;
RETURN f
END ;
INC(i)
END ;
RETURN NIL
END CacheEntry;
PROCEDURE Old* (name: ARRAY OF CHAR): File;
VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN;
dir, path: ARRAY 256 OF CHAR;
stat: Unix.Status;
BEGIN
IF name # "" THEN
IF HasDir(name) THEN dir := ""; COPY(name, path)
ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir)
END ;
LOOP
fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
Kernel.GC(TRUE);
fd := Unix.Open(path, Unix.rdwr, {});
done := fd >= 0; errno := Unix.errno();
IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
END ;
IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
(* errno EAGAIN observed on Solaris 2.4 *)
fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno()
END ;
IF (~done) & (errno # Unix.ENOENT) THEN
Console.String("warning Files0.Old "); Console.String(name);
Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
END ;
IF done THEN
res := Unix.Fstat(fd, stat);
f := CacheEntry(stat.dev, stat.ino, stat.mtime);
IF f # NIL THEN res := Unix.Close(fd); RETURN f
ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
RETURN f
END
ELSIF dir = "" THEN RETURN NIL
ELSE MakeFileName(dir, name, path); ScanPath(pos, dir)
END
END
ELSE RETURN NIL
END
END Old;
PROCEDURE Purge* (f: File);
VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
f.pos := 0; f.len := 0; f.swapper := -1;
res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
END Purge;
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
BEGIN
Create(f); res := Unix.Fstat(f.fd, stat);
time := localtime(stat.mtime);
t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
END GetDate;
PROCEDURE Pos* (VAR r: Rider): LONGINT;
BEGIN RETURN r.org + r.offset
END Pos;
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
VAR org, offset, i, n, res: LONGINT; buf: Buffer;
BEGIN
IF f # NIL THEN
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
offset := pos MOD bufsize; org := pos - offset; i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
IF i < nofbufs THEN
IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
ELSE buf := f.bufs[i]
END
ELSE
f.swapper := (f.swapper + 1) MOD nofbufs;
buf := f.bufs[f.swapper];
Flush(buf)
END ;
IF buf.org # org THEN
IF org = f.len THEN buf.size := 0
ELSE Create(f);
IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
n := Unix.ReadBlk(f.fd, buf.data);
IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
f.pos := org + n;
buf.size := n
END ;
buf.org := org; buf.chg := FALSE
END
ELSE buf := NIL; org := 0; offset := 0
END ;
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
END Set;
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
IF (offset < buf.size) THEN
x := buf.data[offset]; r.offset := offset + 1
ELSIF r.org + offset < buf.f.len THEN
Set(r, r.buf.f, r.org + offset);
x := r.buf.data[0]; r.offset := 1
ELSE
x := 0X; r.eof := TRUE
END
END Read;
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := buf.size - offset;
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
END ;
r.res := 0; r.eof := FALSE
END ReadBytes;
PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
BEGIN
ReadBytes(r, x, 1);
END ReadByte;
PROCEDURE Base* (VAR r: Rider): File;
BEGIN RETURN r.buf.f
END Base;
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
buf.data[offset] := x;
buf.chg := TRUE;
IF offset = buf.size THEN
INC(buf.size); INC(buf.f.len)
END ;
r.offset := offset + 1; r.res := 0
END Write;
PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := bufsize - offset;
IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
INC(offset, min); r.offset := offset;
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
INC(xpos, min); DEC(n, min); buf.chg := TRUE
END ;
r.res := 0
END WriteBytes;
(* another solution would be one that is similar to ReadBytes, WriteBytes.
No code duplication, more symmetric, only two ifs for
Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
must be made consistent with offset (if offset > buf.size) in a lazy way.
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= bufsize) OR (r.org # buf.org) THEN
Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
END ;
buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
END Write;
PROCEDURE WriteBytes ...
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= buf.size) OR (r.org # buf.org) THEN
IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
END
END ;
x := buf.data[offset]; r.offset := offset + 1
END Read;
but this would also affect Set, Length, and Flush.
Especially Length would become fairly complex.
*)
PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Unlink(name));
res := SHORT(Unix.errno())
END Delete;
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
VAR fdold, fdnew, n, errno, r: LONGINT;
ostat, nstat: Unix.Status;
buf: ARRAY 4096 OF CHAR;
BEGIN
r := Unix.Stat(old, ostat);
IF r >= 0 THEN
r := Unix.Stat(new, nstat);
IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
Delete(new, res); (* work around stale nfs handles *)
END ;
r := Unix.Rename(old, new);
IF r < 0 THEN res := SHORT(Unix.errno());
IF res = Unix.EXDEV THEN (* cross device link, move the file *)
fdold := Unix.Open(old, Unix.rdonly, {});
IF fdold < 0 THEN res := 2; RETURN END ;
fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
WHILE n > 0 DO
r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
Err("cannot move file", NIL, errno)
END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
END ;
errno := Unix.errno();
r := Unix.Close(fdold); r := Unix.Close(fdnew);
IF n = 0 THEN r := Unix.Unlink(old); res := 0
ELSE Err("cannot move file", NIL, errno)
END ;
ELSE RETURN (* res is Unix.Rename return code *)
END
END ;
res := 0
ELSE res := 2 (* old file not found *)
END
END Rename;
PROCEDURE Register* (f: File);
VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
BEGIN
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
Close(f);
IF f.registerName # "" THEN
Rename(f.workName, f.registerName, errno);
IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END
END Register;
PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Chdir(path));
getcwd(Kernel.CWD)
END ChangeDirectory;
PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
VAR i, j: LONGINT;
BEGIN
IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
END
END FlipBytes;
PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
BEGIN Read(R, SYSTEM.VAL(CHAR, x))
END ReadBool;
PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN ReadBytes(R, b, 2);
x := ORD(b[0]) + ORD(b[1])*256
END ReadInt;
PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
END ReadLInt;
PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
END ReadSet;
PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
END ReadReal;
PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
END ReadLReal;
PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
END ReadString;
PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
BEGIN s := 0; n := 0; Read(R, ch);
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
x := n
END ReadNum;
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
END WriteBool;
PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
WriteBytes(R, b, 2);
END WriteInt;
PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN
b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
WriteBytes(R, b, 4);
END WriteLInt;
PROCEDURE WriteSet* (VAR R: Rider; x: SET);
VAR b: ARRAY 4 OF CHAR; i: LONGINT;
BEGIN i := SYSTEM.VAL(LONGINT, x);
b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H);
WriteBytes(R, b, 4);
END WriteSet;
PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
END WriteReal;
PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
END WriteLReal;
PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE x[i] # 0X DO INC(i) END ;
WriteBytes(R, x, i+1)
END WriteString;
PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
BEGIN
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
Write(R, CHR(x MOD 128))
END WriteNum;
PROCEDURE Finalize(o: SYSTEM.PTR);
VAR f: File; res: LONGINT;
BEGIN
f := SYSTEM.VAL(File, o);
IF f.fd >= 0 THEN
fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
IF f.tempFile THEN res := Unix.Unlink(f.workName) END
END
END Finalize;
PROCEDURE Init;
VAR i: LONGINT;
BEGIN
i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
tempno := -1; Kernel.nofiles := 0
END Init;
BEGIN Init
END Files0.

View file

@ -20,7 +20,7 @@
#include "varargs.h"
#endif
extern void *malloc(unsigned int size);
extern void *malloc(long size);
extern void exit(int status);
void (*SYSTEM_Halt)();

View file

@ -15,7 +15,7 @@ uses double # as concatenation operator
//extern void *memcpy(void *dest, const void *src, long n);
extern void *memcpy(void *dest, const void *src, size_t n);
extern void *malloc(unsigned int size);
extern void *malloc(long size);
extern void exit(int status);
#define export

View file

@ -0,0 +1,664 @@
MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
(* modified version of Files, which opens only the file provided and does not scan any path in any environment variable, also ReadLine procedure added; -- noch *)
IMPORT SYSTEM, Unix, Kernel, Args, Console;
(* standard data type I/O
little endian,
Sint:1, Int:2, Lint:4
ORD({0}) = 1,
false = 0, true =1
IEEE real format,
null terminated strings,
compact numbers according to M.Odersky *)
CONST
nofbufs = 4;
bufsize = 4096;
fileTabSize = 64;
noDesc = -1;
notDone = -1;
(* file states *)
open = 0; create = 1; close = 2;
TYPE
FileName = ARRAY 101 OF CHAR;
File* = POINTER TO Handle;
Buffer = POINTER TO BufDesc;
Handle = RECORD
workName, registerName: FileName;
tempFile: BOOLEAN;
dev, ino, mtime: LONGINT;
fd-: INTEGER;
len, pos: LONGINT;
bufs: ARRAY nofbufs OF Buffer;
swapper, state: INTEGER
END ;
BufDesc = RECORD
f: File;
chg: BOOLEAN;
org, size: LONGINT;
data: ARRAY bufsize OF SYSTEM.BYTE
END ;
Rider* = RECORD
res*: LONGINT;
eof*: BOOLEAN;
buf: Buffer;
org, offset: LONGINT
END ;
Time = POINTER TO TimeDesc;
TimeDesc = RECORD
sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
END ;
VAR
fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
tempno: INTEGER;
(* for localtime *)
PROCEDURE -includetime()
'#include "time.h"';
PROCEDURE -localtime(VAR clock: LONGINT): Time
"(Files_Time) localtime(clock)";
PROCEDURE -getcwd(VAR cwd: Unix.Name)
"getcwd(cwd, cwd__len)";
PROCEDURE -IdxTrap "__HALT(-1)";
PROCEDURE^ Finalize(o: SYSTEM.PTR);
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
BEGIN
Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
IF f # NIL THEN
IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
END ;
IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
Console.Ln;
HALT(99)
END Err;
PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN i := 0; j := 0;
WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ;
IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ;
WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ;
dest[i] := 0X
END MakeFileName;
PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
VAR n, i, j: LONGINT;
BEGIN
INC(tempno); n := tempno; i := 0;
IF finalName[0] # "/" THEN (* relative pathname *)
WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END
END;
j := 0;
WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END;
DEC(i);
WHILE name[i] # "/" DO DEC(i) END;
name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6);
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := "."; INC(i); n := SHORT(Unix.Getpid());
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := 0X
END GetTempName;
PROCEDURE Create(f: File);
VAR stat: Unix.Status; done: BOOLEAN;
errno: LONGINT; err: ARRAY 32 OF CHAR;
BEGIN
IF f.fd = noDesc THEN
IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
ELSIF f.state = close THEN
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END ;
errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8})));
done := f.fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
Kernel.GC(TRUE);
f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8})));
done := f.fd >= 0
END ;
IF done THEN
IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
END
ELSE errno := Unix.errno();
IF errno = Unix.ENOENT THEN err := "no such directory"
ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
ELSE err := "file not created"
END ;
Err(err, f, errno)
END
END
END Create;
PROCEDURE Flush(buf: Buffer);
VAR res: LONGINT; f: File; stat: Unix.Status;
BEGIN
IF buf.chg THEN f := buf.f; Create(f);
IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
f.pos := buf.org + buf.size;
buf.chg := FALSE;
res := Unix.Fstat(f.fd, stat);
f.mtime := stat.mtime
END
END Flush;
PROCEDURE Close* (f: File);
VAR i, res: LONGINT;
BEGIN
IF (f.state # create) OR (f.registerName # "") THEN
Create(f); i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
res := Unix.Fsync(f.fd);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
END
END Close;
PROCEDURE Length* (f: File): LONGINT;
BEGIN RETURN f.len
END Length;
PROCEDURE New* (name: ARRAY OF CHAR): File;
VAR f: File;
BEGIN
NEW(f); f.workName := ""; COPY(name, f.registerName);
f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
RETURN f
END New;
(*
PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
BEGIN
i := 0; ch := Kernel.OBERON[pos];
WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
IF ch = "~" THEN
INC(pos); ch := Kernel.OBERON[pos];
home := ""; Args.GetEnv("HOME", home);
WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
END
END ;
WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
dir[i] := 0X
END ScanPath;
*)
PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0; ch := name[0];
WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
RETURN ch = "/"
END HasDir;
PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < fileTabSize DO
f := SYSTEM.VAL(File, fileTab[i]);
IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
IF mtime # f.mtime THEN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
f.swapper := -1; f.mtime := mtime;
res := Unix.Fstat(f.fd, stat); f.len := stat.size
END ;
RETURN f
END ;
INC(i)
END ;
RETURN NIL
END CacheEntry;
PROCEDURE Old* (name: ARRAY OF CHAR): File;
VAR f: File; fd: INTEGER; res, errno: LONGINT; pos: INTEGER; done: BOOLEAN;
dir, path: ARRAY 256 OF CHAR;
stat: Unix.Status;
BEGIN
IF name # "" THEN
IF HasDir(name) THEN dir := ""; COPY(name, path)
ELSE
pos := 0;
COPY(name, path); (* -- noch *)
(*ScanPath(pos, dir);*) (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
END ;
LOOP
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
Kernel.GC(TRUE);
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {})));
done := fd >= 0; errno := Unix.errno();
IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
END ;
IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
(* errno EAGAIN observed on Solaris 2.4 *)
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno()
END ;
IF (~done) & (errno # Unix.ENOENT) THEN
Console.String("warning Files.Old "); Console.String(name);
Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
END ;
IF done THEN
res := Unix.Fstat(fd, stat);
f := CacheEntry(stat.dev, stat.ino, stat.mtime);
IF f # NIL THEN res := Unix.Close(fd); RETURN f
ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
RETURN f
END
ELSIF dir = "" THEN RETURN NIL
ELSE (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
RETURN NIL
END
END
ELSE RETURN NIL
END
END Old;
PROCEDURE Purge* (f: File);
VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
f.pos := 0; f.len := 0; f.swapper := -1;
res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
END Purge;
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
BEGIN
Create(f); res := Unix.Fstat(f.fd, stat);
time := localtime(stat.mtime);
t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
END GetDate;
PROCEDURE Pos* (VAR r: Rider): LONGINT;
BEGIN RETURN r.org + r.offset
END Pos;
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
VAR org, offset, i, n, res: LONGINT; buf: Buffer;
BEGIN
IF f # NIL THEN
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
offset := pos MOD bufsize; org := pos - offset; i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
IF i < nofbufs THEN
IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
ELSE buf := f.bufs[i]
END
ELSE
f.swapper := (f.swapper + 1) MOD nofbufs;
buf := f.bufs[f.swapper];
Flush(buf)
END ;
IF buf.org # org THEN
IF org = f.len THEN buf.size := 0
ELSE Create(f);
IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
n := Unix.ReadBlk(f.fd, buf.data);
IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
f.pos := org + n;
buf.size := n
END ;
buf.org := org; buf.chg := FALSE
END
ELSE buf := NIL; org := 0; offset := 0
END ;
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
END Set;
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
IF (offset < buf.size) THEN
x := buf.data[offset]; r.offset := offset + 1
ELSIF r.org + offset < buf.f.len THEN
Set(r, r.buf.f, r.org + offset);
x := r.buf.data[0]; r.offset := 1
ELSE
x := 0X; r.eof := TRUE
END
END Read;
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := buf.size - offset;
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
END ;
r.res := 0; r.eof := FALSE
END ReadBytes;
PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
BEGIN
ReadBytes(r, x, 1);
END ReadByte;
PROCEDURE Base* (VAR r: Rider): File;
BEGIN RETURN r.buf.f
END Base;
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
buf.data[offset] := x;
buf.chg := TRUE;
IF offset = buf.size THEN
INC(buf.size); INC(buf.f.len)
END ;
r.offset := offset + 1; r.res := 0
END Write;
PROCEDURE WriteByte* (VAR r : Rider; x : SYSTEM.BYTE); (* added for compatibility with PO 2013, -- noch *)
BEGIN
Write(r, x);
END WriteByte;
PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := bufsize - offset;
IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
INC(offset, min); r.offset := offset;
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
INC(xpos, min); DEC(n, min); buf.chg := TRUE
END ;
r.res := 0
END WriteBytes;
(* another solution would be one that is similar to ReadBytes, WriteBytes.
No code duplication, more symmetric, only two ifs for
Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
must be made consistent with offset (if offset > buf.size) in a lazy way.
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= bufsize) OR (r.org # buf.org) THEN
Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
END ;
buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
END Write;
PROCEDURE WriteBytes ...
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= buf.size) OR (r.org # buf.org) THEN
IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
END
END ;
x := buf.data[offset]; r.offset := offset + 1
END Read;
but this would also affect Set, Length, and Flush.
Especially Length would become fairly complex.
*)
PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Unlink(name));
res := SHORT(Unix.errno())
END Delete;
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
VAR fdold, fdnew: INTEGER; n, errno, r: LONGINT;
ostat, nstat: Unix.Status;
buf: ARRAY 4096 OF CHAR;
BEGIN
r := Unix.Stat(old, ostat);
IF r >= 0 THEN
r := Unix.Stat(new, nstat);
IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
Delete(new, res); (* work around stale nfs handles *)
END ;
r := Unix.Rename(old, new);
IF r < 0 THEN res := SHORT(Unix.errno());
IF res = Unix.EXDEV THEN (* cross device link, move the file *)
fdold := Unix.Open(old, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {})));
IF fdold < 0 THEN res := 2; RETURN END ;
fdnew := Unix.Open(new, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8})));
IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
WHILE n > 0 DO
r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
Err("cannot move file", NIL, errno)
END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
END ;
errno := Unix.errno();
r := Unix.Close(fdold); r := Unix.Close(fdnew);
IF n = 0 THEN r := Unix.Unlink(old); res := 0
ELSE Err("cannot move file", NIL, errno)
END ;
ELSE RETURN (* res is Unix.Rename return code *)
END
END ;
res := 0
ELSE res := 2 (* old file not found *)
END
END Rename;
PROCEDURE Register* (f: File);
VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
BEGIN
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
Close(f);
IF f.registerName # "" THEN
Rename(f.workName, f.registerName, errno);
IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END
END Register;
PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Chdir(path));
getcwd(Kernel.CWD)
END ChangeDirectory;
PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
VAR i, j: LONGINT;
BEGIN
IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
END
END FlipBytes;
PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
BEGIN Read(R, SYSTEM.VAL(CHAR, x))
END ReadBool;
PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN ReadBytes(R, b, 2);
x := ORD(b[0]) + ORD(b[1])*256
END ReadInt;
PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
END ReadLInt;
PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
END ReadSet;
PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
END ReadReal;
PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
END ReadLReal;
PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
END ReadString;
(* need to read line; -- noch *)
PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR; b : BOOLEAN;
BEGIN i := 0;
b := FALSE;
REPEAT
Read(R, ch);
IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN
b := TRUE
ELSE
x[i] := ch;
INC(i);
END;
UNTIL b
END ReadLine;
PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
BEGIN s := 0; n := 0; Read(R, ch);
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
x := n
END ReadNum;
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
END WriteBool;
PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
WriteBytes(R, b, 2);
END WriteInt;
PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN
b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
WriteBytes(R, b, 4);
END WriteLInt;
PROCEDURE WriteSet* (VAR R: Rider; x: SET);
VAR b: ARRAY 4 OF CHAR; i: LONGINT;
BEGIN i := SYSTEM.VAL(LONGINT, x);
b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H);
WriteBytes(R, b, 4);
END WriteSet;
PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
END WriteReal;
PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
END WriteLReal;
PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE x[i] # 0X DO INC(i) END ;
WriteBytes(R, x, i+1)
END WriteString;
PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
BEGIN
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
Write(R, CHR(x MOD 128))
END WriteNum;
PROCEDURE GetName*(f: File; VAR name: ARRAY OF CHAR);
BEGIN
COPY (f.workName, name);
END GetName;
PROCEDURE Finalize(o: SYSTEM.PTR);
VAR f: File; res: LONGINT;
BEGIN
f := SYSTEM.VAL(File, o);
IF f.fd >= 0 THEN
fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
IF f.tempFile THEN res := Unix.Unlink(f.workName) END
END
END Finalize;
PROCEDURE Init;
VAR i: LONGINT;
BEGIN
i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
tempno := -1; Kernel.nofiles := 0
END Init;
BEGIN Init
END Files.

View file

@ -0,0 +1,636 @@
MODULE Files0; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
(* this module is not for use by developers and inteded to bootstrap voc *)
(* for general use import Files module *)
IMPORT SYSTEM, Unix, Kernel := Kernel0, Args, Console;
(* standard data type I/O
little endian,
Sint:1, Int:2, Lint:4
ORD({0}) = 1,
false = 0, true =1
IEEE real format,
null terminated strings,
compact numbers according to M.Odersky *)
CONST
nofbufs = 4;
bufsize = 4096;
fileTabSize = 64;
noDesc = -1;
notDone = -1;
(* file states *)
open = 0; create = 1; close = 2;
TYPE
FileName = ARRAY 101 OF CHAR;
File* = POINTER TO Handle;
Buffer = POINTER TO BufDesc;
Handle = RECORD
workName, registerName: FileName;
tempFile: BOOLEAN;
dev, ino, mtime: LONGINT;
fd-: INTEGER;
len, pos: LONGINT;
bufs: ARRAY nofbufs OF Buffer;
swapper, state: INTEGER
END ;
BufDesc = RECORD
f: File;
chg: BOOLEAN;
org, size: LONGINT;
data: ARRAY bufsize OF SYSTEM.BYTE
END ;
Rider* = RECORD
res*: LONGINT;
eof*: BOOLEAN;
buf: Buffer;
org, offset: LONGINT
END ;
Time = POINTER TO TimeDesc;
TimeDesc = RECORD
sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
END ;
VAR
fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
tempno: INTEGER;
(* for localtime *)
PROCEDURE -includetime()
'#include "time.h"';
PROCEDURE -localtime(VAR clock: LONGINT): Time
"(Files0_Time) localtime(clock)";
PROCEDURE -getcwd(VAR cwd: Unix.Name)
"getcwd(cwd, cwd__len)";
PROCEDURE -IdxTrap "__HALT(-1)";
PROCEDURE^ Finalize(o: SYSTEM.PTR);
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
BEGIN
Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
IF f # NIL THEN
IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
END ;
IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
Console.Ln;
HALT(99)
END Err;
PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN i := 0; j := 0;
WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ;
IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ;
WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ;
dest[i] := 0X
END MakeFileName;
PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
VAR n, i, j: LONGINT;
BEGIN
INC(tempno); n := tempno; i := 0;
IF finalName[0] # "/" THEN (* relative pathname *)
WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END
END;
j := 0;
WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END;
DEC(i);
WHILE name[i] # "/" DO DEC(i) END;
name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6);
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := "."; INC(i); n := SHORT(Unix.Getpid());
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := 0X
END GetTempName;
PROCEDURE Create(f: File);
VAR stat: Unix.Status; done: BOOLEAN;
errno: LONGINT; err: ARRAY 32 OF CHAR;
BEGIN
IF f.fd = noDesc THEN
IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
ELSIF f.state = close THEN
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END ;
errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, (Unix.rdwr + Unix.creat + Unix.trunc))), SHORT(SYSTEM.VAL(LONGINT, ({2, 4,5, 7,8}))));
done := f.fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
Kernel.GC(TRUE);
f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, (Unix.rdwr + Unix.creat + Unix.trunc))), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8})));
done := f.fd >= 0
END ;
IF done THEN
IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
END
ELSE errno := Unix.errno();
IF errno = Unix.ENOENT THEN err := "no such directory"
ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
ELSE err := "file not created"
END ;
Err(err, f, errno)
END
END
END Create;
PROCEDURE Flush(buf: Buffer);
VAR res: LONGINT; f: File; stat: Unix.Status;
BEGIN
IF buf.chg THEN f := buf.f; Create(f);
IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
f.pos := buf.org + buf.size;
buf.chg := FALSE;
res := Unix.Fstat(f.fd, stat);
f.mtime := stat.mtime
END
END Flush;
PROCEDURE Close* (f: File);
VAR i, res: LONGINT;
BEGIN
IF (f.state # create) OR (f.registerName # "") THEN
Create(f); i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
res := Unix.Fsync(f.fd);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
END
END Close;
PROCEDURE Length* (f: File): LONGINT;
BEGIN RETURN f.len
END Length;
PROCEDURE New* (name: ARRAY OF CHAR): File;
VAR f: File;
BEGIN
NEW(f); f.workName := ""; COPY(name, f.registerName);
f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
RETURN f
END New;
PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
BEGIN
i := 0; ch := Kernel.OBERON[pos];
WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
IF ch = "~" THEN
INC(pos); ch := Kernel.OBERON[pos];
home := ""; Args.GetEnv("HOME", home);
WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
END
END ;
WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
dir[i] := 0X
END ScanPath;
PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0; ch := name[0];
WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
RETURN ch = "/"
END HasDir;
PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < fileTabSize DO
f := SYSTEM.VAL(File, fileTab[i]);
IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
IF mtime # f.mtime THEN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
f.swapper := -1; f.mtime := mtime;
res := Unix.Fstat(f.fd, stat); f.len := stat.size
END ;
RETURN f
END ;
INC(i)
END ;
RETURN NIL
END CacheEntry;
PROCEDURE Old* (name: ARRAY OF CHAR): File;
VAR f: File; fd: INTEGER; res, errno: LONGINT; pos: INTEGER; done: BOOLEAN;
dir, path: ARRAY 256 OF CHAR;
stat: Unix.Status;
BEGIN
IF name # "" THEN
IF HasDir(name) THEN dir := ""; COPY(name, path)
ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir)
END ;
LOOP
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
Kernel.GC(TRUE);
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {})));
done := fd >= 0; errno := Unix.errno();
IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
END ;
IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
(* errno EAGAIN observed on Solaris 2.4 *)
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno()
END ;
IF (~done) & (errno # Unix.ENOENT) THEN
Console.String("warning Files0.Old "); Console.String(name);
Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
END ;
IF done THEN
res := Unix.Fstat(fd, stat);
f := CacheEntry(stat.dev, stat.ino, stat.mtime);
IF f # NIL THEN res := Unix.Close(fd); RETURN f
ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
RETURN f
END
ELSIF dir = "" THEN RETURN NIL
ELSE MakeFileName(dir, name, path); ScanPath(pos, dir)
END
END
ELSE RETURN NIL
END
END Old;
PROCEDURE Purge* (f: File);
VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
f.pos := 0; f.len := 0; f.swapper := -1;
res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
END Purge;
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
BEGIN
Create(f); res := Unix.Fstat(f.fd, stat);
time := localtime(stat.mtime);
t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
END GetDate;
PROCEDURE Pos* (VAR r: Rider): LONGINT;
BEGIN RETURN r.org + r.offset
END Pos;
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
VAR org, offset, i, n, res: LONGINT; buf: Buffer;
BEGIN
IF f # NIL THEN
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
offset := pos MOD bufsize; org := pos - offset; i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
IF i < nofbufs THEN
IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
ELSE buf := f.bufs[i]
END
ELSE
f.swapper := (f.swapper + 1) MOD nofbufs;
buf := f.bufs[f.swapper];
Flush(buf)
END ;
IF buf.org # org THEN
IF org = f.len THEN buf.size := 0
ELSE Create(f);
IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
n := Unix.ReadBlk(f.fd, buf.data);
IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
f.pos := org + n;
buf.size := n
END ;
buf.org := org; buf.chg := FALSE
END
ELSE buf := NIL; org := 0; offset := 0
END ;
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
END Set;
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
IF (offset < buf.size) THEN
x := buf.data[offset]; r.offset := offset + 1
ELSIF r.org + offset < buf.f.len THEN
Set(r, r.buf.f, r.org + offset);
x := r.buf.data[0]; r.offset := 1
ELSE
x := 0X; r.eof := TRUE
END
END Read;
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := buf.size - offset;
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
END ;
r.res := 0; r.eof := FALSE
END ReadBytes;
PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
BEGIN
ReadBytes(r, x, 1);
END ReadByte;
PROCEDURE Base* (VAR r: Rider): File;
BEGIN RETURN r.buf.f
END Base;
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
buf.data[offset] := x;
buf.chg := TRUE;
IF offset = buf.size THEN
INC(buf.size); INC(buf.f.len)
END ;
r.offset := offset + 1; r.res := 0
END Write;
PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := bufsize - offset;
IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
INC(offset, min); r.offset := offset;
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
INC(xpos, min); DEC(n, min); buf.chg := TRUE
END ;
r.res := 0
END WriteBytes;
(* another solution would be one that is similar to ReadBytes, WriteBytes.
No code duplication, more symmetric, only two ifs for
Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
must be made consistent with offset (if offset > buf.size) in a lazy way.
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= bufsize) OR (r.org # buf.org) THEN
Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
END ;
buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
END Write;
PROCEDURE WriteBytes ...
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= buf.size) OR (r.org # buf.org) THEN
IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
END
END ;
x := buf.data[offset]; r.offset := offset + 1
END Read;
but this would also affect Set, Length, and Flush.
Especially Length would become fairly complex.
*)
PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Unlink(name));
res := SHORT(Unix.errno())
END Delete;
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
VAR fdold, fdnew: INTEGER; n, errno, r: LONGINT;
ostat, nstat: Unix.Status;
buf: ARRAY 4096 OF CHAR;
BEGIN
r := Unix.Stat(old, ostat);
IF r >= 0 THEN
r := Unix.Stat(new, nstat);
IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
Delete(new, res); (* work around stale nfs handles *)
END ;
r := Unix.Rename(old, new);
IF r < 0 THEN res := SHORT(Unix.errno());
IF res = Unix.EXDEV THEN (* cross device link, move the file *)
fdold := Unix.Open(old, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {})));
IF fdold < 0 THEN res := 2; RETURN END ;
fdnew := Unix.Open(new, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8})));
IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
WHILE n > 0 DO
r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
Err("cannot move file", NIL, errno)
END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
END ;
errno := Unix.errno();
r := Unix.Close(fdold); r := Unix.Close(fdnew);
IF n = 0 THEN r := Unix.Unlink(old); res := 0
ELSE Err("cannot move file", NIL, errno)
END ;
ELSE RETURN (* res is Unix.Rename return code *)
END
END ;
res := 0
ELSE res := 2 (* old file not found *)
END
END Rename;
PROCEDURE Register* (f: File);
VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
BEGIN
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
Close(f);
IF f.registerName # "" THEN
Rename(f.workName, f.registerName, errno);
IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END
END Register;
PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Chdir(path));
getcwd(Kernel.CWD)
END ChangeDirectory;
PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
VAR i, j: LONGINT;
BEGIN
IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
END
END FlipBytes;
PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
BEGIN Read(R, SYSTEM.VAL(CHAR, x))
END ReadBool;
PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN ReadBytes(R, b, 2);
x := ORD(b[0]) + ORD(b[1])*256
END ReadInt;
PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
END ReadLInt;
PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
END ReadSet;
PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
END ReadReal;
PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
END ReadLReal;
PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
END ReadString;
PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
BEGIN s := 0; n := 0; Read(R, ch);
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
x := n
END ReadNum;
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
END WriteBool;
PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
WriteBytes(R, b, 2);
END WriteInt;
PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN
b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
WriteBytes(R, b, 4);
END WriteLInt;
PROCEDURE WriteSet* (VAR R: Rider; x: SET);
VAR b: ARRAY 4 OF CHAR; i: LONGINT;
BEGIN i := SYSTEM.VAL(LONGINT, x);
b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H);
WriteBytes(R, b, 4);
END WriteSet;
PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
END WriteReal;
PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
END WriteLReal;
PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE x[i] # 0X DO INC(i) END ;
WriteBytes(R, x, i+1)
END WriteString;
PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
BEGIN
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
Write(R, CHR(x MOD 128))
END WriteNum;
PROCEDURE Finalize(o: SYSTEM.PTR);
VAR f: File; res: LONGINT;
BEGIN
f := SYSTEM.VAL(File, o);
IF f.fd >= 0 THEN
fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
IF f.tempFile THEN res := Unix.Unlink(f.workName) END
END
END Finalize;
PROCEDURE Init;
VAR i: LONGINT;
BEGIN
i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
tempno := -1; Kernel.nofiles := 0
END Init;
BEGIN Init
END Files0.

View file

@ -292,16 +292,18 @@ from man gettimeofday
END ;
Sockaddr* = RECORD
family*: INTEGER;
port*: INTEGER;
internetAddr*: LONGINT;
pad*: ARRAY 8 OF CHAR;
family0*, family1*: SHORTINT;
pad0, pad1: SHORTINT;
pad2 : INTEGER;
(*port*: INTEGER;
internetAddr*: LONGINT;*)
pad*: ARRAY 14 OF CHAR;
END ;
HostEntry* = POINTER [1] TO Hostent;
Hostent* = RECORD
name*, aliases*: LONGINT;
addrtype*, length*: LONGINT;
addrtype*, length*: INTEGER;
addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*)
END;
@ -321,7 +323,7 @@ from man gettimeofday
PROCEDURE -includeStdlib()
"#include <stdlib.h>";
(* for nanosleep() *)
(* for nanosleep() *)
PROCEDURE -includeTime()
"#include <time.h>";
@ -337,71 +339,71 @@ from man gettimeofday
RETURN err()
END errno;
PROCEDURE -Exit*(n: LONGINT)
PROCEDURE -Exit*(n: INTEGER)
"exit(n)";
PROCEDURE -Fork*(): LONGINT
PROCEDURE -Fork*(): INTEGER
"fork()";
PROCEDURE -Wait*(VAR status: LONGINT): LONGINT
PROCEDURE -Wait*(VAR status: INTEGER): INTEGER
"wait(status)";
PROCEDURE -Select*(width: LONGINT; VAR readfds, writefds, exceptfds: FdSet; VAR timeout: Timeval): LONGINT
PROCEDURE -Select*(width: INTEGER; VAR readfds, writefds, exceptfds: FdSet; VAR timeout: Timeval): INTEGER
"select(width, readfds, writefds, exceptfds, timeout)";
PROCEDURE -Gettimeofday* (VAR tv: Timeval; VAR tz: Timezone) : LONGINT
PROCEDURE -Gettimeofday* (VAR tv: Timeval; VAR tz: Timezone) : INTEGER
"gettimeofday(tv, tz)";
PROCEDURE -Read* (fd, buf, nbyte: LONGINT): LONGINT
PROCEDURE -Read* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT
"read(fd, buf, nbyte)";
PROCEDURE -ReadBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT
PROCEDURE -ReadBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT
"read(fd, buf, buf__len)";
PROCEDURE -Write* (fd, buf, nbyte: LONGINT): LONGINT
PROCEDURE -Write* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT
"write(fd, buf, nbyte)";
PROCEDURE -WriteBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT
PROCEDURE -WriteBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT
"write(fd, buf, buf__len)";
PROCEDURE -Dup*(fd: LONGINT): LONGINT
PROCEDURE -Dup*(fd: INTEGER): INTEGER
"dup(fd)";
PROCEDURE -Dup2*(fd1, fd2: LONGINT): LONGINT
PROCEDURE -Dup2*(fd1, fd2: INTEGER): INTEGER
"dup(fd1, fd2)";
PROCEDURE -Pipe*(fds : LONGINT): LONGINT
PROCEDURE -Pipe*(fds : LONGINT): INTEGER
"pipe(fds)";
PROCEDURE -Getpid*(): LONGINT
PROCEDURE -Getpid*(): INTEGER
"getpid()";
PROCEDURE -Getuid*(): LONGINT
PROCEDURE -Getuid*(): INTEGER
"getuid()";
PROCEDURE -Geteuid*(): LONGINT
PROCEDURE -Geteuid*(): INTEGER
"geteuid()";
PROCEDURE -Getgid*(): LONGINT
PROCEDURE -Getgid*(): INTEGER
"getgid()";
PROCEDURE -Getegid*(): LONGINT
PROCEDURE -Getegid*(): INTEGER
"getegid()";
PROCEDURE -Unlink*(name: Name): LONGINT
PROCEDURE -Unlink*(name: Name): INTEGER
"unlink(name)";
PROCEDURE -Open*(name: Name; flag, mode: SET): LONGINT
PROCEDURE -Open*(name: Name; flag: INTEGER; mode: LONGINT): INTEGER
"open(name, flag, mode)";
PROCEDURE -Close*(fd: LONGINT): LONGINT
PROCEDURE -Close*(fd: INTEGER): INTEGER
"close(fd)";
PROCEDURE -stat(name: Name; VAR statbuf: Status): LONGINT
PROCEDURE -stat(name: Name; VAR statbuf: Status): INTEGER
"stat((const char*)name, (struct stat*)statbuf)";
PROCEDURE Stat*(name: Name; VAR statbuf: Status): LONGINT;
VAR res: LONGINT;
PROCEDURE Stat*(name: Name; VAR statbuf: Status): INTEGER;
VAR res: INTEGER;
BEGIN
res := stat(name, statbuf);
(* make the first 4 bytes as unique as possible (used in module Files for caching!) *)
@ -411,11 +413,11 @@ from man gettimeofday
RETURN res;
END Stat;
PROCEDURE -fstat(fd: LONGINT; VAR statbuf: Status): LONGINT
PROCEDURE -fstat(fd: INTEGER; VAR statbuf: Status): INTEGER
"fstat(fd, (struct stat*)statbuf)";
PROCEDURE Fstat*(fd: LONGINT; VAR statbuf: Status): LONGINT;
VAR res: LONGINT;
PROCEDURE Fstat*(fd: INTEGER; VAR statbuf: Status): INTEGER;
VAR res: INTEGER;
BEGIN
res := fstat(fd, statbuf);
(* make the first 4 bytes as unique as possible (used in module Files for caching!) *)
@ -424,47 +426,47 @@ from man gettimeofday
RETURN res;
END Fstat;
PROCEDURE -Fchmod*(fd, mode: LONGINT): LONGINT
PROCEDURE -Fchmod*(fd, mode: INTEGER): INTEGER
"fchmod(fd, mode)";
PROCEDURE -Chmod*(path: Name; mode: LONGINT): LONGINT
PROCEDURE -Chmod*(path: Name; mode: INTEGER): INTEGER
"chmod(path, mode)";
PROCEDURE -Lseek*(fd, offset, origin: LONGINT): LONGINT
PROCEDURE -Lseek*(fd: INTEGER; offset: LONGINT; origin: INTEGER): LONGINT
"lseek(fd, offset, origin)";
PROCEDURE -Fsync*(fd: LONGINT): LONGINT
PROCEDURE -Fsync*(fd: INTEGER): INTEGER
"fsync(fd)";
PROCEDURE -Fcntl*(fd, cmd, arg: LONGINT ): LONGINT
PROCEDURE -Fcntl*(fd: INTEGER; cmd: INTEGER; arg: LONGINT ): INTEGER
"fcntl(fd, cmd, arg)";
PROCEDURE -Flock*(fd, operation: LONGINT): LONGINT
PROCEDURE -Flock*(fd, operation: INTEGER): INTEGER
"flock(fd, operation)";
PROCEDURE -Ftruncate*(fd, length: LONGINT): LONGINT
PROCEDURE -Ftruncate*(fd: INTEGER; length: LONGINT): INTEGER
"ftruncate(fd, length)";
PROCEDURE -Readblk*(fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT
PROCEDURE -Readblk*(fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT
"read(fd, buf, len)";
PROCEDURE -Rename*(old, new: Name): LONGINT
PROCEDURE -Rename*(old, new: Name): INTEGER
"rename(old, new)";
PROCEDURE -Chdir*(path: Name): LONGINT
PROCEDURE -Chdir*(path: Name): INTEGER
"chdir(path)";
PROCEDURE -Ioctl*(fd, request, arg: LONGINT): LONGINT
PROCEDURE -Ioctl*(fd: INTEGER; request, arg: LONGINT): INTEGER
"ioctl(fd, request, arg)";
PROCEDURE -Kill*(pid, sig: LONGINT): LONGINT
PROCEDURE -Kill*(pid, sig: INTEGER): INTEGER
"kill(pid, sig)";
PROCEDURE -Sigsetmask*(mask: LONGINT): LONGINT
PROCEDURE -Sigsetmask*(mask: INTEGER): INTEGER
"sigsetmask(mask)";
PROCEDURE -Sleep*(ms : INTEGER): INTEGER
"(INTEGER)sleep(ms)";
"(INTEGER)sleep(ms)";
PROCEDURE -Nanosleep*(VAR req : Timeval; VAR rem : Timeval): INTEGER
"(INTEGER)nanosleep(req, rem)";
@ -474,31 +476,31 @@ from man gettimeofday
PROCEDURE -Gethostbyname*(name: Name): HostEntry
"(Unix_HostEntry)gethostbyname(name)";
PROCEDURE -Gethostname*(VAR name: Name): LONGINT
PROCEDURE -Gethostname*(VAR name: Name): INTEGER
"gethostname(name, name__len)";
PROCEDURE -Socket*(af, type, protocol: LONGINT): LONGINT
PROCEDURE -Socket*(af, type, protocol: INTEGER): INTEGER
"socket(af, type, protocol)";
PROCEDURE -Connect*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT
PROCEDURE -Connect*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER
"connect(socket, &(name), namelen)";
PROCEDURE -Getsockname*(socket: LONGINT; VAR name: Sockaddr; VAR namelen: LONGINT): LONGINT
PROCEDURE -Getsockname*(socket: INTEGER; VAR name: Sockaddr; VAR namelen: INTEGER): INTEGER
"getsockname(socket, name, namelen)";
PROCEDURE -Bind*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT
PROCEDURE -Bind*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER
"bind(socket, &(name), namelen)";
PROCEDURE -Listen*(socket, backlog: LONGINT): LONGINT
PROCEDURE -Listen*(socket, backlog: INTEGER): INTEGER
"listen(socket, backlog)";
PROCEDURE -Accept*(socket: LONGINT; VAR addr: Sockaddr; VAR addrlen: LONGINT): LONGINT
PROCEDURE -Accept*(socket: INTEGER; VAR addr: Sockaddr; VAR addrlen: INTEGER): LONGINT
"accept(socket, addr, addrlen)";
PROCEDURE -Recv*(socket, bufadr, buflen, flags: LONGINT): LONGINT
PROCEDURE -Recv*(socket: INTEGER; bufadr, buflen: LONGINT; flags: INTEGER): LONGINT
"recv(socket, bufadr, buflen, flags)";
PROCEDURE -Send*(socket, bufadr, buflen, flags: LONGINT): LONGINT
PROCEDURE -Send*(socket: INTEGER; bufadr, buflen: LONGINT; flags: INTEGER): LONGINT
"send(socket, bufadr, buflen, flags)";
PROCEDURE -sys(str: ARRAY OF CHAR): INTEGER (* need this to call external tools like gcc or gas; noch *)

View file

@ -0,0 +1,663 @@
MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
(* modified version of Files, which opens only the file provided and does not scan any path in any environment variable, also ReadLine procedure added; -- noch *)
IMPORT SYSTEM, Unix, Kernel, Args, Console;
(* standard data type I/O
little endian,
Sint:1, Int:2, Lint:4
ORD({0}) = 1,
false = 0, true =1
IEEE real format,
null terminated strings,
compact numbers according to M.Odersky *)
CONST
nofbufs = 4;
bufsize = 4096;
fileTabSize = 64;
noDesc = -1;
notDone = -1;
(* file states *)
open = 0; create = 1; close = 2;
TYPE
FileName = ARRAY 101 OF CHAR;
File* = POINTER TO Handle;
Buffer = POINTER TO BufDesc;
Handle = RECORD
workName, registerName: FileName;
tempFile: BOOLEAN;
dev, ino, mtime: LONGINT;
fd-, len, pos: LONGINT;
bufs: ARRAY nofbufs OF Buffer;
swapper, state: INTEGER
END ;
BufDesc = RECORD
f: File;
chg: BOOLEAN;
org, size: LONGINT;
data: ARRAY bufsize OF SYSTEM.BYTE
END ;
Rider* = RECORD
res*: LONGINT;
eof*: BOOLEAN;
buf: Buffer;
org, offset: LONGINT
END ;
Time = POINTER TO TimeDesc;
TimeDesc = RECORD
sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
END ;
VAR
fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
tempno: INTEGER;
(* for localtime *)
PROCEDURE -includetime()
'#include "time.h"';
PROCEDURE -localtime(VAR clock: LONGINT): Time
"(Files_Time) localtime(clock)";
PROCEDURE -getcwd(VAR cwd: Unix.Name)
"getcwd(cwd, cwd__len)";
PROCEDURE -IdxTrap "__HALT(-1)";
PROCEDURE^ Finalize(o: SYSTEM.PTR);
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
BEGIN
Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
IF f # NIL THEN
IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
END ;
IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
Console.Ln;
HALT(99)
END Err;
PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN i := 0; j := 0;
WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ;
IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ;
WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ;
dest[i] := 0X
END MakeFileName;
PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
VAR n, i, j: LONGINT;
BEGIN
INC(tempno); n := tempno; i := 0;
IF finalName[0] # "/" THEN (* relative pathname *)
WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END
END;
j := 0;
WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END;
DEC(i);
WHILE name[i] # "/" DO DEC(i) END;
name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6);
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := "."; INC(i); n := SHORT(Unix.Getpid());
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := 0X
END GetTempName;
PROCEDURE Create(f: File);
VAR stat: Unix.Status; done: BOOLEAN;
errno: LONGINT; err: ARRAY 32 OF CHAR;
BEGIN
IF f.fd = noDesc THEN
IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
ELSIF f.state = close THEN
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END ;
errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
Kernel.GC(TRUE);
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0
END ;
IF done THEN
IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
END
ELSE errno := Unix.errno();
IF errno = Unix.ENOENT THEN err := "no such directory"
ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
ELSE err := "file not created"
END ;
Err(err, f, errno)
END
END
END Create;
PROCEDURE Flush(buf: Buffer);
VAR res: LONGINT; f: File; stat: Unix.Status;
BEGIN
IF buf.chg THEN f := buf.f; Create(f);
IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
f.pos := buf.org + buf.size;
buf.chg := FALSE;
res := Unix.Fstat(f.fd, stat);
f.mtime := stat.mtime
END
END Flush;
PROCEDURE Close* (f: File);
VAR i, res: LONGINT;
BEGIN
IF (f.state # create) OR (f.registerName # "") THEN
Create(f); i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
res := Unix.Fsync(f.fd);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
END
END Close;
PROCEDURE Length* (f: File): LONGINT;
BEGIN RETURN f.len
END Length;
PROCEDURE New* (name: ARRAY OF CHAR): File;
VAR f: File;
BEGIN
NEW(f); f.workName := ""; COPY(name, f.registerName);
f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
RETURN f
END New;
(*
PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
BEGIN
i := 0; ch := Kernel.OBERON[pos];
WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
IF ch = "~" THEN
INC(pos); ch := Kernel.OBERON[pos];
home := ""; Args.GetEnv("HOME", home);
WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
END
END ;
WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
dir[i] := 0X
END ScanPath;
*)
PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0; ch := name[0];
WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
RETURN ch = "/"
END HasDir;
PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < fileTabSize DO
f := SYSTEM.VAL(File, fileTab[i]);
IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
IF mtime # f.mtime THEN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
f.swapper := -1; f.mtime := mtime;
res := Unix.Fstat(f.fd, stat); f.len := stat.size
END ;
RETURN f
END ;
INC(i)
END ;
RETURN NIL
END CacheEntry;
PROCEDURE Old* (name: ARRAY OF CHAR): File;
VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN;
dir, path: ARRAY 256 OF CHAR;
stat: Unix.Status;
BEGIN
IF name # "" THEN
IF HasDir(name) THEN dir := ""; COPY(name, path)
ELSE
pos := 0;
COPY(name, path); (* -- noch *)
(*ScanPath(pos, dir);*) (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
END ;
LOOP
fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
Kernel.GC(TRUE);
fd := Unix.Open(path, Unix.rdwr, {});
done := fd >= 0; errno := Unix.errno();
IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
END ;
IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
(* errno EAGAIN observed on Solaris 2.4 *)
fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno()
END ;
IF (~done) & (errno # Unix.ENOENT) THEN
Console.String("warning Files.Old "); Console.String(name);
Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
END ;
IF done THEN
res := Unix.Fstat(fd, stat);
f := CacheEntry(stat.dev, stat.ino, stat.mtime);
IF f # NIL THEN res := Unix.Close(fd); RETURN f
ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
RETURN f
END
ELSIF dir = "" THEN RETURN NIL
ELSE (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
RETURN NIL
END
END
ELSE RETURN NIL
END
END Old;
PROCEDURE Purge* (f: File);
VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
f.pos := 0; f.len := 0; f.swapper := -1;
res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
END Purge;
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
BEGIN
Create(f); res := Unix.Fstat(f.fd, stat);
time := localtime(stat.mtime);
t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
END GetDate;
PROCEDURE Pos* (VAR r: Rider): LONGINT;
BEGIN RETURN r.org + r.offset
END Pos;
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
VAR org, offset, i, n, res: LONGINT; buf: Buffer;
BEGIN
IF f # NIL THEN
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
offset := pos MOD bufsize; org := pos - offset; i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
IF i < nofbufs THEN
IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
ELSE buf := f.bufs[i]
END
ELSE
f.swapper := (f.swapper + 1) MOD nofbufs;
buf := f.bufs[f.swapper];
Flush(buf)
END ;
IF buf.org # org THEN
IF org = f.len THEN buf.size := 0
ELSE Create(f);
IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
n := Unix.ReadBlk(f.fd, buf.data);
IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
f.pos := org + n;
buf.size := n
END ;
buf.org := org; buf.chg := FALSE
END
ELSE buf := NIL; org := 0; offset := 0
END ;
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
END Set;
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
IF (offset < buf.size) THEN
x := buf.data[offset]; r.offset := offset + 1
ELSIF r.org + offset < buf.f.len THEN
Set(r, r.buf.f, r.org + offset);
x := r.buf.data[0]; r.offset := 1
ELSE
x := 0X; r.eof := TRUE
END
END Read;
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := buf.size - offset;
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
END ;
r.res := 0; r.eof := FALSE
END ReadBytes;
PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
BEGIN
ReadBytes(r, x, 1);
END ReadByte;
PROCEDURE Base* (VAR r: Rider): File;
BEGIN RETURN r.buf.f
END Base;
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
buf.data[offset] := x;
buf.chg := TRUE;
IF offset = buf.size THEN
INC(buf.size); INC(buf.f.len)
END ;
r.offset := offset + 1; r.res := 0
END Write;
PROCEDURE WriteByte* (VAR r : Rider; x : SYSTEM.BYTE); (* added for compatibility with PO 2013, -- noch *)
BEGIN
Write(r, x);
END WriteByte;
PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := bufsize - offset;
IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
INC(offset, min); r.offset := offset;
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
INC(xpos, min); DEC(n, min); buf.chg := TRUE
END ;
r.res := 0
END WriteBytes;
(* another solution would be one that is similar to ReadBytes, WriteBytes.
No code duplication, more symmetric, only two ifs for
Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
must be made consistent with offset (if offset > buf.size) in a lazy way.
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= bufsize) OR (r.org # buf.org) THEN
Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
END ;
buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
END Write;
PROCEDURE WriteBytes ...
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= buf.size) OR (r.org # buf.org) THEN
IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
END
END ;
x := buf.data[offset]; r.offset := offset + 1
END Read;
but this would also affect Set, Length, and Flush.
Especially Length would become fairly complex.
*)
PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Unlink(name));
res := SHORT(Unix.errno())
END Delete;
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
VAR fdold, fdnew, n, errno, r: LONGINT;
ostat, nstat: Unix.Status;
buf: ARRAY 4096 OF CHAR;
BEGIN
r := Unix.Stat(old, ostat);
IF r >= 0 THEN
r := Unix.Stat(new, nstat);
IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
Delete(new, res); (* work around stale nfs handles *)
END ;
r := Unix.Rename(old, new);
IF r < 0 THEN res := SHORT(Unix.errno());
IF res = Unix.EXDEV THEN (* cross device link, move the file *)
fdold := Unix.Open(old, Unix.rdonly, {});
IF fdold < 0 THEN res := 2; RETURN END ;
fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
WHILE n > 0 DO
r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
Err("cannot move file", NIL, errno)
END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
END ;
errno := Unix.errno();
r := Unix.Close(fdold); r := Unix.Close(fdnew);
IF n = 0 THEN r := Unix.Unlink(old); res := 0
ELSE Err("cannot move file", NIL, errno)
END ;
ELSE RETURN (* res is Unix.Rename return code *)
END
END ;
res := 0
ELSE res := 2 (* old file not found *)
END
END Rename;
PROCEDURE Register* (f: File);
VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
BEGIN
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
Close(f);
IF f.registerName # "" THEN
Rename(f.workName, f.registerName, errno);
IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END
END Register;
PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Chdir(path));
getcwd(Kernel.CWD)
END ChangeDirectory;
PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
VAR i, j: LONGINT;
BEGIN
IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
END
END FlipBytes;
PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
BEGIN Read(R, SYSTEM.VAL(CHAR, x))
END ReadBool;
PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN ReadBytes(R, b, 2);
x := ORD(b[0]) + ORD(b[1])*256
END ReadInt;
PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
END ReadLInt;
PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
END ReadSet;
PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
END ReadReal;
PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
END ReadLReal;
PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
END ReadString;
(* need to read line; -- noch *)
PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR; b : BOOLEAN;
BEGIN i := 0;
b := FALSE;
REPEAT
Read(R, ch);
IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN
b := TRUE
ELSE
x[i] := ch;
INC(i);
END;
UNTIL b
END ReadLine;
PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
BEGIN s := 0; n := 0; Read(R, ch);
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
x := n
END ReadNum;
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
END WriteBool;
PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
WriteBytes(R, b, 2);
END WriteInt;
PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN
b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
WriteBytes(R, b, 4);
END WriteLInt;
PROCEDURE WriteSet* (VAR R: Rider; x: SET);
VAR b: ARRAY 4 OF CHAR; i: LONGINT;
BEGIN i := SYSTEM.VAL(LONGINT, x);
b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H);
WriteBytes(R, b, 4);
END WriteSet;
PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
END WriteReal;
PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
END WriteLReal;
PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE x[i] # 0X DO INC(i) END ;
WriteBytes(R, x, i+1)
END WriteString;
PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
BEGIN
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
Write(R, CHR(x MOD 128))
END WriteNum;
PROCEDURE GetName*(f: File; VAR name: ARRAY OF CHAR);
BEGIN
COPY (f.workName, name);
END GetName;
PROCEDURE Finalize(o: SYSTEM.PTR);
VAR f: File; res: LONGINT;
BEGIN
f := SYSTEM.VAL(File, o);
IF f.fd >= 0 THEN
fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
IF f.tempFile THEN res := Unix.Unlink(f.workName) END
END
END Finalize;
PROCEDURE Init;
VAR i: LONGINT;
BEGIN
i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
tempno := -1; Kernel.nofiles := 0
END Init;
BEGIN Init
END Files.

View file

@ -0,0 +1,635 @@
MODULE Files0; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
(* this module is not for use by developers and inteded to bootstrap voc *)
(* for general use import Files module *)
IMPORT SYSTEM, Unix, Kernel := Kernel0, Args, Console;
(* standard data type I/O
little endian,
Sint:1, Int:2, Lint:4
ORD({0}) = 1,
false = 0, true =1
IEEE real format,
null terminated strings,
compact numbers according to M.Odersky *)
CONST
nofbufs = 4;
bufsize = 4096;
fileTabSize = 64;
noDesc = -1;
notDone = -1;
(* file states *)
open = 0; create = 1; close = 2;
TYPE
FileName = ARRAY 101 OF CHAR;
File* = POINTER TO Handle;
Buffer = POINTER TO BufDesc;
Handle = RECORD
workName, registerName: FileName;
tempFile: BOOLEAN;
dev, ino, mtime: LONGINT;
fd-, len, pos: LONGINT;
bufs: ARRAY nofbufs OF Buffer;
swapper, state: INTEGER
END ;
BufDesc = RECORD
f: File;
chg: BOOLEAN;
org, size: LONGINT;
data: ARRAY bufsize OF SYSTEM.BYTE
END ;
Rider* = RECORD
res*: LONGINT;
eof*: BOOLEAN;
buf: Buffer;
org, offset: LONGINT
END ;
Time = POINTER TO TimeDesc;
TimeDesc = RECORD
sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
END ;
VAR
fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
tempno: INTEGER;
(* for localtime *)
PROCEDURE -includetime()
'#include "time.h"';
PROCEDURE -localtime(VAR clock: LONGINT): Time
"(Files0_Time) localtime(clock)";
PROCEDURE -getcwd(VAR cwd: Unix.Name)
"getcwd(cwd, cwd__len)";
PROCEDURE -IdxTrap "__HALT(-1)";
PROCEDURE^ Finalize(o: SYSTEM.PTR);
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
BEGIN
Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
IF f # NIL THEN
IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
END ;
IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
Console.Ln;
HALT(99)
END Err;
PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN i := 0; j := 0;
WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ;
IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ;
WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ;
dest[i] := 0X
END MakeFileName;
PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
VAR n, i, j: LONGINT;
BEGIN
INC(tempno); n := tempno; i := 0;
IF finalName[0] # "/" THEN (* relative pathname *)
WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END
END;
j := 0;
WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END;
DEC(i);
WHILE name[i] # "/" DO DEC(i) END;
name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6);
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := "."; INC(i); n := SHORT(Unix.Getpid());
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := 0X
END GetTempName;
PROCEDURE Create(f: File);
VAR stat: Unix.Status; done: BOOLEAN;
errno: LONGINT; err: ARRAY 32 OF CHAR;
BEGIN
IF f.fd = noDesc THEN
IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
ELSIF f.state = close THEN
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END ;
errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
Kernel.GC(TRUE);
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0
END ;
IF done THEN
IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
END
ELSE errno := Unix.errno();
IF errno = Unix.ENOENT THEN err := "no such directory"
ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
ELSE err := "file not created"
END ;
Err(err, f, errno)
END
END
END Create;
PROCEDURE Flush(buf: Buffer);
VAR res: LONGINT; f: File; stat: Unix.Status;
BEGIN
IF buf.chg THEN f := buf.f; Create(f);
IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
f.pos := buf.org + buf.size;
buf.chg := FALSE;
res := Unix.Fstat(f.fd, stat);
f.mtime := stat.mtime
END
END Flush;
PROCEDURE Close* (f: File);
VAR i, res: LONGINT;
BEGIN
IF (f.state # create) OR (f.registerName # "") THEN
Create(f); i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
res := Unix.Fsync(f.fd);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
END
END Close;
PROCEDURE Length* (f: File): LONGINT;
BEGIN RETURN f.len
END Length;
PROCEDURE New* (name: ARRAY OF CHAR): File;
VAR f: File;
BEGIN
NEW(f); f.workName := ""; COPY(name, f.registerName);
f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
RETURN f
END New;
PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
BEGIN
i := 0; ch := Kernel.OBERON[pos];
WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
IF ch = "~" THEN
INC(pos); ch := Kernel.OBERON[pos];
home := ""; Args.GetEnv("HOME", home);
WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
END
END ;
WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
dir[i] := 0X
END ScanPath;
PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0; ch := name[0];
WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
RETURN ch = "/"
END HasDir;
PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < fileTabSize DO
f := SYSTEM.VAL(File, fileTab[i]);
IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
IF mtime # f.mtime THEN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
f.swapper := -1; f.mtime := mtime;
res := Unix.Fstat(f.fd, stat); f.len := stat.size
END ;
RETURN f
END ;
INC(i)
END ;
RETURN NIL
END CacheEntry;
PROCEDURE Old* (name: ARRAY OF CHAR): File;
VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN;
dir, path: ARRAY 256 OF CHAR;
stat: Unix.Status;
BEGIN
IF name # "" THEN
IF HasDir(name) THEN dir := ""; COPY(name, path)
ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir)
END ;
LOOP
fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
Kernel.GC(TRUE);
fd := Unix.Open(path, Unix.rdwr, {});
done := fd >= 0; errno := Unix.errno();
IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
END ;
IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
(* errno EAGAIN observed on Solaris 2.4 *)
fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno()
END ;
IF (~done) & (errno # Unix.ENOENT) THEN
Console.String("warning Files0.Old "); Console.String(name);
Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
END ;
IF done THEN
res := Unix.Fstat(fd, stat);
f := CacheEntry(stat.dev, stat.ino, stat.mtime);
IF f # NIL THEN res := Unix.Close(fd); RETURN f
ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
RETURN f
END
ELSIF dir = "" THEN RETURN NIL
ELSE MakeFileName(dir, name, path); ScanPath(pos, dir)
END
END
ELSE RETURN NIL
END
END Old;
PROCEDURE Purge* (f: File);
VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
f.pos := 0; f.len := 0; f.swapper := -1;
res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
END Purge;
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
BEGIN
Create(f); res := Unix.Fstat(f.fd, stat);
time := localtime(stat.mtime);
t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
END GetDate;
PROCEDURE Pos* (VAR r: Rider): LONGINT;
BEGIN RETURN r.org + r.offset
END Pos;
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
VAR org, offset, i, n, res: LONGINT; buf: Buffer;
BEGIN
IF f # NIL THEN
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
offset := pos MOD bufsize; org := pos - offset; i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
IF i < nofbufs THEN
IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
ELSE buf := f.bufs[i]
END
ELSE
f.swapper := (f.swapper + 1) MOD nofbufs;
buf := f.bufs[f.swapper];
Flush(buf)
END ;
IF buf.org # org THEN
IF org = f.len THEN buf.size := 0
ELSE Create(f);
IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
n := Unix.ReadBlk(f.fd, buf.data);
IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
f.pos := org + n;
buf.size := n
END ;
buf.org := org; buf.chg := FALSE
END
ELSE buf := NIL; org := 0; offset := 0
END ;
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
END Set;
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
IF (offset < buf.size) THEN
x := buf.data[offset]; r.offset := offset + 1
ELSIF r.org + offset < buf.f.len THEN
Set(r, r.buf.f, r.org + offset);
x := r.buf.data[0]; r.offset := 1
ELSE
x := 0X; r.eof := TRUE
END
END Read;
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := buf.size - offset;
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
END ;
r.res := 0; r.eof := FALSE
END ReadBytes;
PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
BEGIN
ReadBytes(r, x, 1);
END ReadByte;
PROCEDURE Base* (VAR r: Rider): File;
BEGIN RETURN r.buf.f
END Base;
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
buf.data[offset] := x;
buf.chg := TRUE;
IF offset = buf.size THEN
INC(buf.size); INC(buf.f.len)
END ;
r.offset := offset + 1; r.res := 0
END Write;
PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := bufsize - offset;
IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
INC(offset, min); r.offset := offset;
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
INC(xpos, min); DEC(n, min); buf.chg := TRUE
END ;
r.res := 0
END WriteBytes;
(* another solution would be one that is similar to ReadBytes, WriteBytes.
No code duplication, more symmetric, only two ifs for
Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
must be made consistent with offset (if offset > buf.size) in a lazy way.
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= bufsize) OR (r.org # buf.org) THEN
Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
END ;
buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
END Write;
PROCEDURE WriteBytes ...
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= buf.size) OR (r.org # buf.org) THEN
IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
END
END ;
x := buf.data[offset]; r.offset := offset + 1
END Read;
but this would also affect Set, Length, and Flush.
Especially Length would become fairly complex.
*)
PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Unlink(name));
res := SHORT(Unix.errno())
END Delete;
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
VAR fdold, fdnew, n, errno, r: LONGINT;
ostat, nstat: Unix.Status;
buf: ARRAY 4096 OF CHAR;
BEGIN
r := Unix.Stat(old, ostat);
IF r >= 0 THEN
r := Unix.Stat(new, nstat);
IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
Delete(new, res); (* work around stale nfs handles *)
END ;
r := Unix.Rename(old, new);
IF r < 0 THEN res := SHORT(Unix.errno());
IF res = Unix.EXDEV THEN (* cross device link, move the file *)
fdold := Unix.Open(old, Unix.rdonly, {});
IF fdold < 0 THEN res := 2; RETURN END ;
fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
WHILE n > 0 DO
r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
Err("cannot move file", NIL, errno)
END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
END ;
errno := Unix.errno();
r := Unix.Close(fdold); r := Unix.Close(fdnew);
IF n = 0 THEN r := Unix.Unlink(old); res := 0
ELSE Err("cannot move file", NIL, errno)
END ;
ELSE RETURN (* res is Unix.Rename return code *)
END
END ;
res := 0
ELSE res := 2 (* old file not found *)
END
END Rename;
PROCEDURE Register* (f: File);
VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
BEGIN
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
Close(f);
IF f.registerName # "" THEN
Rename(f.workName, f.registerName, errno);
IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END
END Register;
PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Chdir(path));
getcwd(Kernel.CWD)
END ChangeDirectory;
PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
VAR i, j: LONGINT;
BEGIN
IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
END
END FlipBytes;
PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
BEGIN Read(R, SYSTEM.VAL(CHAR, x))
END ReadBool;
PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN ReadBytes(R, b, 2);
x := ORD(b[0]) + ORD(b[1])*256
END ReadInt;
PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
END ReadLInt;
PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
END ReadSet;
PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
END ReadReal;
PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
END ReadLReal;
PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
END ReadString;
PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
BEGIN s := 0; n := 0; Read(R, ch);
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
x := n
END ReadNum;
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
END WriteBool;
PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
WriteBytes(R, b, 2);
END WriteInt;
PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN
b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
WriteBytes(R, b, 4);
END WriteLInt;
PROCEDURE WriteSet* (VAR R: Rider; x: SET);
VAR b: ARRAY 4 OF CHAR; i: LONGINT;
BEGIN i := SYSTEM.VAL(LONGINT, x);
b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H);
WriteBytes(R, b, 4);
END WriteSet;
PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
END WriteReal;
PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
END WriteLReal;
PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE x[i] # 0X DO INC(i) END ;
WriteBytes(R, x, i+1)
END WriteString;
PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
BEGIN
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
Write(R, CHR(x MOD 128))
END WriteNum;
PROCEDURE Finalize(o: SYSTEM.PTR);
VAR f: File; res: LONGINT;
BEGIN
f := SYSTEM.VAL(File, o);
IF f.fd >= 0 THEN
fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
IF f.tempFile THEN res := Unix.Unlink(f.workName) END
END
END Finalize;
PROCEDURE Init;
VAR i: LONGINT;
BEGIN
i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
tempno := -1; Kernel.nofiles := 0
END Init;
BEGIN Init
END Files0.

View file

@ -0,0 +1,663 @@
MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
(* modified version of Files, which opens only the file provided and does not scan any path in any environment variable, also ReadLine procedure added; -- noch *)
IMPORT SYSTEM, Unix, Kernel, Args, Console;
(* standard data type I/O
little endian,
Sint:1, Int:2, Lint:4
ORD({0}) = 1,
false = 0, true =1
IEEE real format,
null terminated strings,
compact numbers according to M.Odersky *)
CONST
nofbufs = 4;
bufsize = 4096;
fileTabSize = 64;
noDesc = -1;
notDone = -1;
(* file states *)
open = 0; create = 1; close = 2;
TYPE
FileName = ARRAY 101 OF CHAR;
File* = POINTER TO Handle;
Buffer = POINTER TO BufDesc;
Handle = RECORD
workName, registerName: FileName;
tempFile: BOOLEAN;
dev, ino, mtime: LONGINT;
fd-, len, pos: LONGINT;
bufs: ARRAY nofbufs OF Buffer;
swapper, state: INTEGER
END ;
BufDesc = RECORD
f: File;
chg: BOOLEAN;
org, size: LONGINT;
data: ARRAY bufsize OF SYSTEM.BYTE
END ;
Rider* = RECORD
res*: LONGINT;
eof*: BOOLEAN;
buf: Buffer;
org, offset: LONGINT
END ;
Time = POINTER TO TimeDesc;
TimeDesc = RECORD
sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
END ;
VAR
fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
tempno: INTEGER;
(* for localtime *)
PROCEDURE -includetime()
'#include "time.h"';
PROCEDURE -localtime(VAR clock: LONGINT): Time
"(Files_Time) localtime(clock)";
PROCEDURE -getcwd(VAR cwd: Unix.Name)
"getcwd(cwd, cwd__len)";
PROCEDURE -IdxTrap "__HALT(-1)";
PROCEDURE^ Finalize(o: SYSTEM.PTR);
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
BEGIN
Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
IF f # NIL THEN
IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
END ;
IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
Console.Ln;
HALT(99)
END Err;
PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN i := 0; j := 0;
WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ;
IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ;
WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ;
dest[i] := 0X
END MakeFileName;
PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
VAR n, i, j: LONGINT;
BEGIN
INC(tempno); n := tempno; i := 0;
IF finalName[0] # "/" THEN (* relative pathname *)
WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END
END;
j := 0;
WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END;
DEC(i);
WHILE name[i] # "/" DO DEC(i) END;
name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6);
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := "."; INC(i); n := SHORT(Unix.Getpid());
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := 0X
END GetTempName;
PROCEDURE Create(f: File);
VAR stat: Unix.Status; done: BOOLEAN;
errno: LONGINT; err: ARRAY 32 OF CHAR;
BEGIN
IF f.fd = noDesc THEN
IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
ELSIF f.state = close THEN
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END ;
errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
Kernel.GC(TRUE);
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0
END ;
IF done THEN
IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
END
ELSE errno := Unix.errno();
IF errno = Unix.ENOENT THEN err := "no such directory"
ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
ELSE err := "file not created"
END ;
Err(err, f, errno)
END
END
END Create;
PROCEDURE Flush(buf: Buffer);
VAR res: LONGINT; f: File; stat: Unix.Status;
BEGIN
IF buf.chg THEN f := buf.f; Create(f);
IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
f.pos := buf.org + buf.size;
buf.chg := FALSE;
res := Unix.Fstat(f.fd, stat);
f.mtime := stat.mtime
END
END Flush;
PROCEDURE Close* (f: File);
VAR i, res: LONGINT;
BEGIN
IF (f.state # create) OR (f.registerName # "") THEN
Create(f); i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
res := Unix.Fsync(f.fd);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
END
END Close;
PROCEDURE Length* (f: File): LONGINT;
BEGIN RETURN f.len
END Length;
PROCEDURE New* (name: ARRAY OF CHAR): File;
VAR f: File;
BEGIN
NEW(f); f.workName := ""; COPY(name, f.registerName);
f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
RETURN f
END New;
(*
PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
BEGIN
i := 0; ch := Kernel.OBERON[pos];
WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
IF ch = "~" THEN
INC(pos); ch := Kernel.OBERON[pos];
home := ""; Args.GetEnv("HOME", home);
WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
END
END ;
WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
dir[i] := 0X
END ScanPath;
*)
PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0; ch := name[0];
WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
RETURN ch = "/"
END HasDir;
PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < fileTabSize DO
f := SYSTEM.VAL(File, fileTab[i]);
IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
IF mtime # f.mtime THEN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
f.swapper := -1; f.mtime := mtime;
res := Unix.Fstat(f.fd, stat); f.len := stat.size
END ;
RETURN f
END ;
INC(i)
END ;
RETURN NIL
END CacheEntry;
PROCEDURE Old* (name: ARRAY OF CHAR): File;
VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN;
dir, path: ARRAY 256 OF CHAR;
stat: Unix.Status;
BEGIN
IF name # "" THEN
IF HasDir(name) THEN dir := ""; COPY(name, path)
ELSE
pos := 0;
COPY(name, path); (* -- noch *)
(*ScanPath(pos, dir);*) (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
END ;
LOOP
fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
Kernel.GC(TRUE);
fd := Unix.Open(path, Unix.rdwr, {});
done := fd >= 0; errno := Unix.errno();
IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
END ;
IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
(* errno EAGAIN observed on Solaris 2.4 *)
fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno()
END ;
IF (~done) & (errno # Unix.ENOENT) THEN
Console.String("warning Files.Old "); Console.String(name);
Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
END ;
IF done THEN
res := Unix.Fstat(fd, stat);
f := CacheEntry(stat.dev, stat.ino, stat.mtime);
IF f # NIL THEN res := Unix.Close(fd); RETURN f
ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
RETURN f
END
ELSIF dir = "" THEN RETURN NIL
ELSE (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
RETURN NIL
END
END
ELSE RETURN NIL
END
END Old;
PROCEDURE Purge* (f: File);
VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
f.pos := 0; f.len := 0; f.swapper := -1;
res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
END Purge;
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
BEGIN
Create(f); res := Unix.Fstat(f.fd, stat);
time := localtime(stat.mtime);
t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
END GetDate;
PROCEDURE Pos* (VAR r: Rider): LONGINT;
BEGIN RETURN r.org + r.offset
END Pos;
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
VAR org, offset, i, n, res: LONGINT; buf: Buffer;
BEGIN
IF f # NIL THEN
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
offset := pos MOD bufsize; org := pos - offset; i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
IF i < nofbufs THEN
IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
ELSE buf := f.bufs[i]
END
ELSE
f.swapper := (f.swapper + 1) MOD nofbufs;
buf := f.bufs[f.swapper];
Flush(buf)
END ;
IF buf.org # org THEN
IF org = f.len THEN buf.size := 0
ELSE Create(f);
IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
n := Unix.ReadBlk(f.fd, buf.data);
IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
f.pos := org + n;
buf.size := n
END ;
buf.org := org; buf.chg := FALSE
END
ELSE buf := NIL; org := 0; offset := 0
END ;
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
END Set;
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
IF (offset < buf.size) THEN
x := buf.data[offset]; r.offset := offset + 1
ELSIF r.org + offset < buf.f.len THEN
Set(r, r.buf.f, r.org + offset);
x := r.buf.data[0]; r.offset := 1
ELSE
x := 0X; r.eof := TRUE
END
END Read;
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := buf.size - offset;
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
END ;
r.res := 0; r.eof := FALSE
END ReadBytes;
PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
BEGIN
ReadBytes(r, x, 1);
END ReadByte;
PROCEDURE Base* (VAR r: Rider): File;
BEGIN RETURN r.buf.f
END Base;
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
buf.data[offset] := x;
buf.chg := TRUE;
IF offset = buf.size THEN
INC(buf.size); INC(buf.f.len)
END ;
r.offset := offset + 1; r.res := 0
END Write;
PROCEDURE WriteByte* (VAR r : Rider; x : SYSTEM.BYTE); (* added for compatibility with PO 2013, -- noch *)
BEGIN
Write(r, x);
END WriteByte;
PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := bufsize - offset;
IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
INC(offset, min); r.offset := offset;
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
INC(xpos, min); DEC(n, min); buf.chg := TRUE
END ;
r.res := 0
END WriteBytes;
(* another solution would be one that is similar to ReadBytes, WriteBytes.
No code duplication, more symmetric, only two ifs for
Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
must be made consistent with offset (if offset > buf.size) in a lazy way.
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= bufsize) OR (r.org # buf.org) THEN
Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
END ;
buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
END Write;
PROCEDURE WriteBytes ...
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= buf.size) OR (r.org # buf.org) THEN
IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
END
END ;
x := buf.data[offset]; r.offset := offset + 1
END Read;
but this would also affect Set, Length, and Flush.
Especially Length would become fairly complex.
*)
PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Unlink(name));
res := SHORT(Unix.errno())
END Delete;
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
VAR fdold, fdnew, n, errno, r: LONGINT;
ostat, nstat: Unix.Status;
buf: ARRAY 4096 OF CHAR;
BEGIN
r := Unix.Stat(old, ostat);
IF r >= 0 THEN
r := Unix.Stat(new, nstat);
IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
Delete(new, res); (* work around stale nfs handles *)
END ;
r := Unix.Rename(old, new);
IF r < 0 THEN res := SHORT(Unix.errno());
IF res = Unix.EXDEV THEN (* cross device link, move the file *)
fdold := Unix.Open(old, Unix.rdonly, {});
IF fdold < 0 THEN res := 2; RETURN END ;
fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
WHILE n > 0 DO
r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
Err("cannot move file", NIL, errno)
END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
END ;
errno := Unix.errno();
r := Unix.Close(fdold); r := Unix.Close(fdnew);
IF n = 0 THEN r := Unix.Unlink(old); res := 0
ELSE Err("cannot move file", NIL, errno)
END ;
ELSE RETURN (* res is Unix.Rename return code *)
END
END ;
res := 0
ELSE res := 2 (* old file not found *)
END
END Rename;
PROCEDURE Register* (f: File);
VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
BEGIN
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
Close(f);
IF f.registerName # "" THEN
Rename(f.workName, f.registerName, errno);
IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END
END Register;
PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Chdir(path));
getcwd(Kernel.CWD)
END ChangeDirectory;
PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
VAR i, j: LONGINT;
BEGIN
IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
END
END FlipBytes;
PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
BEGIN Read(R, SYSTEM.VAL(CHAR, x))
END ReadBool;
PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN ReadBytes(R, b, 2);
x := ORD(b[0]) + ORD(b[1])*256
END ReadInt;
PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
END ReadLInt;
PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
END ReadSet;
PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
END ReadReal;
PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
END ReadLReal;
PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
END ReadString;
(* need to read line; -- noch *)
PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR; b : BOOLEAN;
BEGIN i := 0;
b := FALSE;
REPEAT
Read(R, ch);
IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN
b := TRUE
ELSE
x[i] := ch;
INC(i);
END;
UNTIL b
END ReadLine;
PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
BEGIN s := 0; n := 0; Read(R, ch);
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
x := n
END ReadNum;
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
END WriteBool;
PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
WriteBytes(R, b, 2);
END WriteInt;
PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN
b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
WriteBytes(R, b, 4);
END WriteLInt;
PROCEDURE WriteSet* (VAR R: Rider; x: SET);
VAR b: ARRAY 4 OF CHAR; i: LONGINT;
BEGIN i := SYSTEM.VAL(LONGINT, x);
b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H);
WriteBytes(R, b, 4);
END WriteSet;
PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
END WriteReal;
PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
END WriteLReal;
PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE x[i] # 0X DO INC(i) END ;
WriteBytes(R, x, i+1)
END WriteString;
PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
BEGIN
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
Write(R, CHR(x MOD 128))
END WriteNum;
PROCEDURE GetName*(f: File; VAR name: ARRAY OF CHAR);
BEGIN
COPY (f.workName, name);
END GetName;
PROCEDURE Finalize(o: SYSTEM.PTR);
VAR f: File; res: LONGINT;
BEGIN
f := SYSTEM.VAL(File, o);
IF f.fd >= 0 THEN
fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
IF f.tempFile THEN res := Unix.Unlink(f.workName) END
END
END Finalize;
PROCEDURE Init;
VAR i: LONGINT;
BEGIN
i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
tempno := -1; Kernel.nofiles := 0
END Init;
BEGIN Init
END Files.

View file

@ -0,0 +1,635 @@
MODULE Files0; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
(* this module is not for use by developers and inteded to bootstrap voc *)
(* for general use import Files module *)
IMPORT SYSTEM, Unix, Kernel := Kernel0, Args, Console;
(* standard data type I/O
little endian,
Sint:1, Int:2, Lint:4
ORD({0}) = 1,
false = 0, true =1
IEEE real format,
null terminated strings,
compact numbers according to M.Odersky *)
CONST
nofbufs = 4;
bufsize = 4096;
fileTabSize = 64;
noDesc = -1;
notDone = -1;
(* file states *)
open = 0; create = 1; close = 2;
TYPE
FileName = ARRAY 101 OF CHAR;
File* = POINTER TO Handle;
Buffer = POINTER TO BufDesc;
Handle = RECORD
workName, registerName: FileName;
tempFile: BOOLEAN;
dev, ino, mtime: LONGINT;
fd-, len, pos: LONGINT;
bufs: ARRAY nofbufs OF Buffer;
swapper, state: INTEGER
END ;
BufDesc = RECORD
f: File;
chg: BOOLEAN;
org, size: LONGINT;
data: ARRAY bufsize OF SYSTEM.BYTE
END ;
Rider* = RECORD
res*: LONGINT;
eof*: BOOLEAN;
buf: Buffer;
org, offset: LONGINT
END ;
Time = POINTER TO TimeDesc;
TimeDesc = RECORD
sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
END ;
VAR
fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
tempno: INTEGER;
(* for localtime *)
PROCEDURE -includetime()
'#include "time.h"';
PROCEDURE -localtime(VAR clock: LONGINT): Time
"(Files0_Time) localtime(clock)";
PROCEDURE -getcwd(VAR cwd: Unix.Name)
"getcwd(cwd, cwd__len)";
PROCEDURE -IdxTrap "__HALT(-1)";
PROCEDURE^ Finalize(o: SYSTEM.PTR);
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
BEGIN
Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
IF f # NIL THEN
IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
END ;
IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
Console.Ln;
HALT(99)
END Err;
PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN i := 0; j := 0;
WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ;
IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ;
WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ;
dest[i] := 0X
END MakeFileName;
PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
VAR n, i, j: LONGINT;
BEGIN
INC(tempno); n := tempno; i := 0;
IF finalName[0] # "/" THEN (* relative pathname *)
WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END
END;
j := 0;
WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END;
DEC(i);
WHILE name[i] # "/" DO DEC(i) END;
name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6);
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := "."; INC(i); n := SHORT(Unix.Getpid());
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := 0X
END GetTempName;
PROCEDURE Create(f: File);
VAR stat: Unix.Status; done: BOOLEAN;
errno: LONGINT; err: ARRAY 32 OF CHAR;
BEGIN
IF f.fd = noDesc THEN
IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
ELSIF f.state = close THEN
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END ;
errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
Kernel.GC(TRUE);
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0
END ;
IF done THEN
IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
END
ELSE errno := Unix.errno();
IF errno = Unix.ENOENT THEN err := "no such directory"
ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
ELSE err := "file not created"
END ;
Err(err, f, errno)
END
END
END Create;
PROCEDURE Flush(buf: Buffer);
VAR res: LONGINT; f: File; stat: Unix.Status;
BEGIN
IF buf.chg THEN f := buf.f; Create(f);
IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
f.pos := buf.org + buf.size;
buf.chg := FALSE;
res := Unix.Fstat(f.fd, stat);
f.mtime := stat.mtime
END
END Flush;
PROCEDURE Close* (f: File);
VAR i, res: LONGINT;
BEGIN
IF (f.state # create) OR (f.registerName # "") THEN
Create(f); i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
res := Unix.Fsync(f.fd);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
END
END Close;
PROCEDURE Length* (f: File): LONGINT;
BEGIN RETURN f.len
END Length;
PROCEDURE New* (name: ARRAY OF CHAR): File;
VAR f: File;
BEGIN
NEW(f); f.workName := ""; COPY(name, f.registerName);
f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
RETURN f
END New;
PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
BEGIN
i := 0; ch := Kernel.OBERON[pos];
WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
IF ch = "~" THEN
INC(pos); ch := Kernel.OBERON[pos];
home := ""; Args.GetEnv("HOME", home);
WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
END
END ;
WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
dir[i] := 0X
END ScanPath;
PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0; ch := name[0];
WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
RETURN ch = "/"
END HasDir;
PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < fileTabSize DO
f := SYSTEM.VAL(File, fileTab[i]);
IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
IF mtime # f.mtime THEN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
f.swapper := -1; f.mtime := mtime;
res := Unix.Fstat(f.fd, stat); f.len := stat.size
END ;
RETURN f
END ;
INC(i)
END ;
RETURN NIL
END CacheEntry;
PROCEDURE Old* (name: ARRAY OF CHAR): File;
VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN;
dir, path: ARRAY 256 OF CHAR;
stat: Unix.Status;
BEGIN
IF name # "" THEN
IF HasDir(name) THEN dir := ""; COPY(name, path)
ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir)
END ;
LOOP
fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
Kernel.GC(TRUE);
fd := Unix.Open(path, Unix.rdwr, {});
done := fd >= 0; errno := Unix.errno();
IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
END ;
IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
(* errno EAGAIN observed on Solaris 2.4 *)
fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno()
END ;
IF (~done) & (errno # Unix.ENOENT) THEN
Console.String("warning Files0.Old "); Console.String(name);
Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
END ;
IF done THEN
res := Unix.Fstat(fd, stat);
f := CacheEntry(stat.dev, stat.ino, stat.mtime);
IF f # NIL THEN res := Unix.Close(fd); RETURN f
ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
RETURN f
END
ELSIF dir = "" THEN RETURN NIL
ELSE MakeFileName(dir, name, path); ScanPath(pos, dir)
END
END
ELSE RETURN NIL
END
END Old;
PROCEDURE Purge* (f: File);
VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
f.pos := 0; f.len := 0; f.swapper := -1;
res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
END Purge;
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
BEGIN
Create(f); res := Unix.Fstat(f.fd, stat);
time := localtime(stat.mtime);
t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
END GetDate;
PROCEDURE Pos* (VAR r: Rider): LONGINT;
BEGIN RETURN r.org + r.offset
END Pos;
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
VAR org, offset, i, n, res: LONGINT; buf: Buffer;
BEGIN
IF f # NIL THEN
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
offset := pos MOD bufsize; org := pos - offset; i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
IF i < nofbufs THEN
IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
ELSE buf := f.bufs[i]
END
ELSE
f.swapper := (f.swapper + 1) MOD nofbufs;
buf := f.bufs[f.swapper];
Flush(buf)
END ;
IF buf.org # org THEN
IF org = f.len THEN buf.size := 0
ELSE Create(f);
IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
n := Unix.ReadBlk(f.fd, buf.data);
IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
f.pos := org + n;
buf.size := n
END ;
buf.org := org; buf.chg := FALSE
END
ELSE buf := NIL; org := 0; offset := 0
END ;
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
END Set;
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
IF (offset < buf.size) THEN
x := buf.data[offset]; r.offset := offset + 1
ELSIF r.org + offset < buf.f.len THEN
Set(r, r.buf.f, r.org + offset);
x := r.buf.data[0]; r.offset := 1
ELSE
x := 0X; r.eof := TRUE
END
END Read;
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := buf.size - offset;
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
END ;
r.res := 0; r.eof := FALSE
END ReadBytes;
PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
BEGIN
ReadBytes(r, x, 1);
END ReadByte;
PROCEDURE Base* (VAR r: Rider): File;
BEGIN RETURN r.buf.f
END Base;
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
buf.data[offset] := x;
buf.chg := TRUE;
IF offset = buf.size THEN
INC(buf.size); INC(buf.f.len)
END ;
r.offset := offset + 1; r.res := 0
END Write;
PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := bufsize - offset;
IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
INC(offset, min); r.offset := offset;
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
INC(xpos, min); DEC(n, min); buf.chg := TRUE
END ;
r.res := 0
END WriteBytes;
(* another solution would be one that is similar to ReadBytes, WriteBytes.
No code duplication, more symmetric, only two ifs for
Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
must be made consistent with offset (if offset > buf.size) in a lazy way.
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= bufsize) OR (r.org # buf.org) THEN
Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
END ;
buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
END Write;
PROCEDURE WriteBytes ...
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= buf.size) OR (r.org # buf.org) THEN
IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
END
END ;
x := buf.data[offset]; r.offset := offset + 1
END Read;
but this would also affect Set, Length, and Flush.
Especially Length would become fairly complex.
*)
PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Unlink(name));
res := SHORT(Unix.errno())
END Delete;
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
VAR fdold, fdnew, n, errno, r: LONGINT;
ostat, nstat: Unix.Status;
buf: ARRAY 4096 OF CHAR;
BEGIN
r := Unix.Stat(old, ostat);
IF r >= 0 THEN
r := Unix.Stat(new, nstat);
IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
Delete(new, res); (* work around stale nfs handles *)
END ;
r := Unix.Rename(old, new);
IF r < 0 THEN res := SHORT(Unix.errno());
IF res = Unix.EXDEV THEN (* cross device link, move the file *)
fdold := Unix.Open(old, Unix.rdonly, {});
IF fdold < 0 THEN res := 2; RETURN END ;
fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
WHILE n > 0 DO
r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
Err("cannot move file", NIL, errno)
END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
END ;
errno := Unix.errno();
r := Unix.Close(fdold); r := Unix.Close(fdnew);
IF n = 0 THEN r := Unix.Unlink(old); res := 0
ELSE Err("cannot move file", NIL, errno)
END ;
ELSE RETURN (* res is Unix.Rename return code *)
END
END ;
res := 0
ELSE res := 2 (* old file not found *)
END
END Rename;
PROCEDURE Register* (f: File);
VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
BEGIN
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
Close(f);
IF f.registerName # "" THEN
Rename(f.workName, f.registerName, errno);
IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END
END Register;
PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Chdir(path));
getcwd(Kernel.CWD)
END ChangeDirectory;
PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
VAR i, j: LONGINT;
BEGIN
IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
END
END FlipBytes;
PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
BEGIN Read(R, SYSTEM.VAL(CHAR, x))
END ReadBool;
PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN ReadBytes(R, b, 2);
x := ORD(b[0]) + ORD(b[1])*256
END ReadInt;
PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
END ReadLInt;
PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
END ReadSet;
PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
END ReadReal;
PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
END ReadLReal;
PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
END ReadString;
PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
BEGIN s := 0; n := 0; Read(R, ch);
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
x := n
END ReadNum;
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
END WriteBool;
PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
WriteBytes(R, b, 2);
END WriteInt;
PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN
b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
WriteBytes(R, b, 4);
END WriteLInt;
PROCEDURE WriteSet* (VAR R: Rider; x: SET);
VAR b: ARRAY 4 OF CHAR; i: LONGINT;
BEGIN i := SYSTEM.VAL(LONGINT, x);
b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H);
WriteBytes(R, b, 4);
END WriteSet;
PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
END WriteReal;
PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
END WriteLReal;
PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE x[i] # 0X DO INC(i) END ;
WriteBytes(R, x, i+1)
END WriteString;
PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
BEGIN
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
Write(R, CHR(x MOD 128))
END WriteNum;
PROCEDURE Finalize(o: SYSTEM.PTR);
VAR f: File; res: LONGINT;
BEGIN
f := SYSTEM.VAL(File, o);
IF f.fd >= 0 THEN
fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
IF f.tempFile THEN res := Unix.Unlink(f.workName) END
END
END Finalize;
PROCEDURE Init;
VAR i: LONGINT;
BEGIN
i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
tempno := -1; Kernel.nofiles := 0
END Init;
BEGIN Init
END Files0.

View file

@ -0,0 +1,663 @@
MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
(* modified version of Files, which opens only the file provided and does not scan any path in any environment variable, also ReadLine procedure added; -- noch *)
IMPORT SYSTEM, Unix, Kernel, Args, Console;
(* standard data type I/O
little endian,
Sint:1, Int:2, Lint:4
ORD({0}) = 1,
false = 0, true =1
IEEE real format,
null terminated strings,
compact numbers according to M.Odersky *)
CONST
nofbufs = 4;
bufsize = 4096;
fileTabSize = 64;
noDesc = -1;
notDone = -1;
(* file states *)
open = 0; create = 1; close = 2;
TYPE
FileName = ARRAY 101 OF CHAR;
File* = POINTER TO Handle;
Buffer = POINTER TO BufDesc;
Handle = RECORD
workName, registerName: FileName;
tempFile: BOOLEAN;
dev, ino, mtime: LONGINT;
fd-, len, pos: LONGINT;
bufs: ARRAY nofbufs OF Buffer;
swapper, state: INTEGER
END ;
BufDesc = RECORD
f: File;
chg: BOOLEAN;
org, size: LONGINT;
data: ARRAY bufsize OF SYSTEM.BYTE
END ;
Rider* = RECORD
res*: LONGINT;
eof*: BOOLEAN;
buf: Buffer;
org, offset: LONGINT
END ;
Time = POINTER TO TimeDesc;
TimeDesc = RECORD
sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
END ;
VAR
fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
tempno: INTEGER;
(* for localtime *)
PROCEDURE -includetime()
'#include "time.h"';
PROCEDURE -localtime(VAR clock: LONGINT): Time
"(Files_Time) localtime(clock)";
PROCEDURE -getcwd(VAR cwd: Unix.Name)
"getcwd(cwd, cwd__len)";
PROCEDURE -IdxTrap "__HALT(-1)";
PROCEDURE^ Finalize(o: SYSTEM.PTR);
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
BEGIN
Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
IF f # NIL THEN
IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
END ;
IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
Console.Ln;
HALT(99)
END Err;
PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN i := 0; j := 0;
WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ;
IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ;
WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ;
dest[i] := 0X
END MakeFileName;
PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
VAR n, i, j: LONGINT;
BEGIN
INC(tempno); n := tempno; i := 0;
IF finalName[0] # "/" THEN (* relative pathname *)
WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END
END;
j := 0;
WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END;
DEC(i);
WHILE name[i] # "/" DO DEC(i) END;
name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6);
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := "."; INC(i); n := SHORT(Unix.Getpid());
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := 0X
END GetTempName;
PROCEDURE Create(f: File);
VAR stat: Unix.Status; done: BOOLEAN;
errno: LONGINT; err: ARRAY 32 OF CHAR;
BEGIN
IF f.fd = noDesc THEN
IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
ELSIF f.state = close THEN
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END ;
errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
Kernel.GC(TRUE);
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0
END ;
IF done THEN
IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
END
ELSE errno := Unix.errno();
IF errno = Unix.ENOENT THEN err := "no such directory"
ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
ELSE err := "file not created"
END ;
Err(err, f, errno)
END
END
END Create;
PROCEDURE Flush(buf: Buffer);
VAR res: LONGINT; f: File; stat: Unix.Status;
BEGIN
IF buf.chg THEN f := buf.f; Create(f);
IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
f.pos := buf.org + buf.size;
buf.chg := FALSE;
res := Unix.Fstat(f.fd, stat);
f.mtime := stat.mtime
END
END Flush;
PROCEDURE Close* (f: File);
VAR i, res: LONGINT;
BEGIN
IF (f.state # create) OR (f.registerName # "") THEN
Create(f); i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
res := Unix.Fsync(f.fd);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
END
END Close;
PROCEDURE Length* (f: File): LONGINT;
BEGIN RETURN f.len
END Length;
PROCEDURE New* (name: ARRAY OF CHAR): File;
VAR f: File;
BEGIN
NEW(f); f.workName := ""; COPY(name, f.registerName);
f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
RETURN f
END New;
(*
PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
BEGIN
i := 0; ch := Kernel.OBERON[pos];
WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
IF ch = "~" THEN
INC(pos); ch := Kernel.OBERON[pos];
home := ""; Args.GetEnv("HOME", home);
WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
END
END ;
WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
dir[i] := 0X
END ScanPath;
*)
PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0; ch := name[0];
WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
RETURN ch = "/"
END HasDir;
PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < fileTabSize DO
f := SYSTEM.VAL(File, fileTab[i]);
IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
IF mtime # f.mtime THEN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
f.swapper := -1; f.mtime := mtime;
res := Unix.Fstat(f.fd, stat); f.len := stat.size
END ;
RETURN f
END ;
INC(i)
END ;
RETURN NIL
END CacheEntry;
PROCEDURE Old* (name: ARRAY OF CHAR): File;
VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN;
dir, path: ARRAY 256 OF CHAR;
stat: Unix.Status;
BEGIN
IF name # "" THEN
IF HasDir(name) THEN dir := ""; COPY(name, path)
ELSE
pos := 0;
COPY(name, path); (* -- noch *)
(*ScanPath(pos, dir);*) (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
END ;
LOOP
fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
Kernel.GC(TRUE);
fd := Unix.Open(path, Unix.rdwr, {});
done := fd >= 0; errno := Unix.errno();
IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
END ;
IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
(* errno EAGAIN observed on Solaris 2.4 *)
fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno()
END ;
IF (~done) & (errno # Unix.ENOENT) THEN
Console.String("warning Files.Old "); Console.String(name);
Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
END ;
IF done THEN
res := Unix.Fstat(fd, stat);
f := CacheEntry(stat.dev, stat.ino, stat.mtime);
IF f # NIL THEN res := Unix.Close(fd); RETURN f
ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
RETURN f
END
ELSIF dir = "" THEN RETURN NIL
ELSE (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
RETURN NIL
END
END
ELSE RETURN NIL
END
END Old;
PROCEDURE Purge* (f: File);
VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
f.pos := 0; f.len := 0; f.swapper := -1;
res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
END Purge;
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
BEGIN
Create(f); res := Unix.Fstat(f.fd, stat);
time := localtime(stat.mtime);
t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
END GetDate;
PROCEDURE Pos* (VAR r: Rider): LONGINT;
BEGIN RETURN r.org + r.offset
END Pos;
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
VAR org, offset, i, n, res: LONGINT; buf: Buffer;
BEGIN
IF f # NIL THEN
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
offset := pos MOD bufsize; org := pos - offset; i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
IF i < nofbufs THEN
IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
ELSE buf := f.bufs[i]
END
ELSE
f.swapper := (f.swapper + 1) MOD nofbufs;
buf := f.bufs[f.swapper];
Flush(buf)
END ;
IF buf.org # org THEN
IF org = f.len THEN buf.size := 0
ELSE Create(f);
IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
n := Unix.ReadBlk(f.fd, buf.data);
IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
f.pos := org + n;
buf.size := n
END ;
buf.org := org; buf.chg := FALSE
END
ELSE buf := NIL; org := 0; offset := 0
END ;
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
END Set;
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
IF (offset < buf.size) THEN
x := buf.data[offset]; r.offset := offset + 1
ELSIF r.org + offset < buf.f.len THEN
Set(r, r.buf.f, r.org + offset);
x := r.buf.data[0]; r.offset := 1
ELSE
x := 0X; r.eof := TRUE
END
END Read;
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := buf.size - offset;
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
END ;
r.res := 0; r.eof := FALSE
END ReadBytes;
PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
BEGIN
ReadBytes(r, x, 1);
END ReadByte;
PROCEDURE Base* (VAR r: Rider): File;
BEGIN RETURN r.buf.f
END Base;
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
buf.data[offset] := x;
buf.chg := TRUE;
IF offset = buf.size THEN
INC(buf.size); INC(buf.f.len)
END ;
r.offset := offset + 1; r.res := 0
END Write;
PROCEDURE WriteByte* (VAR r : Rider; x : SYSTEM.BYTE); (* added for compatibility with PO 2013, -- noch *)
BEGIN
Write(r, x);
END WriteByte;
PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := bufsize - offset;
IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
INC(offset, min); r.offset := offset;
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
INC(xpos, min); DEC(n, min); buf.chg := TRUE
END ;
r.res := 0
END WriteBytes;
(* another solution would be one that is similar to ReadBytes, WriteBytes.
No code duplication, more symmetric, only two ifs for
Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
must be made consistent with offset (if offset > buf.size) in a lazy way.
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= bufsize) OR (r.org # buf.org) THEN
Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
END ;
buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
END Write;
PROCEDURE WriteBytes ...
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= buf.size) OR (r.org # buf.org) THEN
IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
END
END ;
x := buf.data[offset]; r.offset := offset + 1
END Read;
but this would also affect Set, Length, and Flush.
Especially Length would become fairly complex.
*)
PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Unlink(name));
res := SHORT(Unix.errno())
END Delete;
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
VAR fdold, fdnew, n, errno, r: LONGINT;
ostat, nstat: Unix.Status;
buf: ARRAY 4096 OF CHAR;
BEGIN
r := Unix.Stat(old, ostat);
IF r >= 0 THEN
r := Unix.Stat(new, nstat);
IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
Delete(new, res); (* work around stale nfs handles *)
END ;
r := Unix.Rename(old, new);
IF r < 0 THEN res := SHORT(Unix.errno());
IF res = Unix.EXDEV THEN (* cross device link, move the file *)
fdold := Unix.Open(old, Unix.rdonly, {});
IF fdold < 0 THEN res := 2; RETURN END ;
fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
WHILE n > 0 DO
r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
Err("cannot move file", NIL, errno)
END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
END ;
errno := Unix.errno();
r := Unix.Close(fdold); r := Unix.Close(fdnew);
IF n = 0 THEN r := Unix.Unlink(old); res := 0
ELSE Err("cannot move file", NIL, errno)
END ;
ELSE RETURN (* res is Unix.Rename return code *)
END
END ;
res := 0
ELSE res := 2 (* old file not found *)
END
END Rename;
PROCEDURE Register* (f: File);
VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
BEGIN
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
Close(f);
IF f.registerName # "" THEN
Rename(f.workName, f.registerName, errno);
IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END
END Register;
PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Chdir(path));
getcwd(Kernel.CWD)
END ChangeDirectory;
PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
VAR i, j: LONGINT;
BEGIN
IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
END
END FlipBytes;
PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
BEGIN Read(R, SYSTEM.VAL(CHAR, x))
END ReadBool;
PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN ReadBytes(R, b, 2);
x := ORD(b[0]) + ORD(b[1])*256
END ReadInt;
PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
END ReadLInt;
PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
END ReadSet;
PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
END ReadReal;
PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
END ReadLReal;
PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
END ReadString;
(* need to read line; -- noch *)
PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR; b : BOOLEAN;
BEGIN i := 0;
b := FALSE;
REPEAT
Read(R, ch);
IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN
b := TRUE
ELSE
x[i] := ch;
INC(i);
END;
UNTIL b
END ReadLine;
PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
BEGIN s := 0; n := 0; Read(R, ch);
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
x := n
END ReadNum;
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
END WriteBool;
PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
WriteBytes(R, b, 2);
END WriteInt;
PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN
b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
WriteBytes(R, b, 4);
END WriteLInt;
PROCEDURE WriteSet* (VAR R: Rider; x: SET);
VAR b: ARRAY 4 OF CHAR; i: LONGINT;
BEGIN i := SYSTEM.VAL(LONGINT, x);
b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H);
WriteBytes(R, b, 4);
END WriteSet;
PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
END WriteReal;
PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
END WriteLReal;
PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE x[i] # 0X DO INC(i) END ;
WriteBytes(R, x, i+1)
END WriteString;
PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
BEGIN
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
Write(R, CHR(x MOD 128))
END WriteNum;
PROCEDURE GetName*(f: File; VAR name: ARRAY OF CHAR);
BEGIN
COPY (f.workName, name);
END GetName;
PROCEDURE Finalize(o: SYSTEM.PTR);
VAR f: File; res: LONGINT;
BEGIN
f := SYSTEM.VAL(File, o);
IF f.fd >= 0 THEN
fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
IF f.tempFile THEN res := Unix.Unlink(f.workName) END
END
END Finalize;
PROCEDURE Init;
VAR i: LONGINT;
BEGIN
i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
tempno := -1; Kernel.nofiles := 0
END Init;
BEGIN Init
END Files.

View file

@ -0,0 +1,635 @@
MODULE Files0; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
(* this module is not for use by developers and inteded to bootstrap voc *)
(* for general use import Files module *)
IMPORT SYSTEM, Unix, Kernel := Kernel0, Args, Console;
(* standard data type I/O
little endian,
Sint:1, Int:2, Lint:4
ORD({0}) = 1,
false = 0, true =1
IEEE real format,
null terminated strings,
compact numbers according to M.Odersky *)
CONST
nofbufs = 4;
bufsize = 4096;
fileTabSize = 64;
noDesc = -1;
notDone = -1;
(* file states *)
open = 0; create = 1; close = 2;
TYPE
FileName = ARRAY 101 OF CHAR;
File* = POINTER TO Handle;
Buffer = POINTER TO BufDesc;
Handle = RECORD
workName, registerName: FileName;
tempFile: BOOLEAN;
dev, ino, mtime: LONGINT;
fd-, len, pos: LONGINT;
bufs: ARRAY nofbufs OF Buffer;
swapper, state: INTEGER
END ;
BufDesc = RECORD
f: File;
chg: BOOLEAN;
org, size: LONGINT;
data: ARRAY bufsize OF SYSTEM.BYTE
END ;
Rider* = RECORD
res*: LONGINT;
eof*: BOOLEAN;
buf: Buffer;
org, offset: LONGINT
END ;
Time = POINTER TO TimeDesc;
TimeDesc = RECORD
sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
END ;
VAR
fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
tempno: INTEGER;
(* for localtime *)
PROCEDURE -includetime()
'#include "time.h"';
PROCEDURE -localtime(VAR clock: LONGINT): Time
"(Files0_Time) localtime(clock)";
PROCEDURE -getcwd(VAR cwd: Unix.Name)
"getcwd(cwd, cwd__len)";
PROCEDURE -IdxTrap "__HALT(-1)";
PROCEDURE^ Finalize(o: SYSTEM.PTR);
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
BEGIN
Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
IF f # NIL THEN
IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
END ;
IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
Console.Ln;
HALT(99)
END Err;
PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN i := 0; j := 0;
WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ;
IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ;
WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ;
dest[i] := 0X
END MakeFileName;
PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
VAR n, i, j: LONGINT;
BEGIN
INC(tempno); n := tempno; i := 0;
IF finalName[0] # "/" THEN (* relative pathname *)
WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END
END;
j := 0;
WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END;
DEC(i);
WHILE name[i] # "/" DO DEC(i) END;
name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6);
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := "."; INC(i); n := SHORT(Unix.Getpid());
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := 0X
END GetTempName;
PROCEDURE Create(f: File);
VAR stat: Unix.Status; done: BOOLEAN;
errno: LONGINT; err: ARRAY 32 OF CHAR;
BEGIN
IF f.fd = noDesc THEN
IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
ELSIF f.state = close THEN
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END ;
errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
Kernel.GC(TRUE);
f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
done := f.fd >= 0
END ;
IF done THEN
IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
END
ELSE errno := Unix.errno();
IF errno = Unix.ENOENT THEN err := "no such directory"
ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
ELSE err := "file not created"
END ;
Err(err, f, errno)
END
END
END Create;
PROCEDURE Flush(buf: Buffer);
VAR res: LONGINT; f: File; stat: Unix.Status;
BEGIN
IF buf.chg THEN f := buf.f; Create(f);
IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
f.pos := buf.org + buf.size;
buf.chg := FALSE;
res := Unix.Fstat(f.fd, stat);
f.mtime := stat.mtime
END
END Flush;
PROCEDURE Close* (f: File);
VAR i, res: LONGINT;
BEGIN
IF (f.state # create) OR (f.registerName # "") THEN
Create(f); i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
res := Unix.Fsync(f.fd);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
END
END Close;
PROCEDURE Length* (f: File): LONGINT;
BEGIN RETURN f.len
END Length;
PROCEDURE New* (name: ARRAY OF CHAR): File;
VAR f: File;
BEGIN
NEW(f); f.workName := ""; COPY(name, f.registerName);
f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
RETURN f
END New;
PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
BEGIN
i := 0; ch := Kernel.OBERON[pos];
WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
IF ch = "~" THEN
INC(pos); ch := Kernel.OBERON[pos];
home := ""; Args.GetEnv("HOME", home);
WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
END
END ;
WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
dir[i] := 0X
END ScanPath;
PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0; ch := name[0];
WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
RETURN ch = "/"
END HasDir;
PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < fileTabSize DO
f := SYSTEM.VAL(File, fileTab[i]);
IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
IF mtime # f.mtime THEN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
f.swapper := -1; f.mtime := mtime;
res := Unix.Fstat(f.fd, stat); f.len := stat.size
END ;
RETURN f
END ;
INC(i)
END ;
RETURN NIL
END CacheEntry;
PROCEDURE Old* (name: ARRAY OF CHAR): File;
VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN;
dir, path: ARRAY 256 OF CHAR;
stat: Unix.Status;
BEGIN
IF name # "" THEN
IF HasDir(name) THEN dir := ""; COPY(name, path)
ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir)
END ;
LOOP
fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
Kernel.GC(TRUE);
fd := Unix.Open(path, Unix.rdwr, {});
done := fd >= 0; errno := Unix.errno();
IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
END ;
IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
(* errno EAGAIN observed on Solaris 2.4 *)
fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno()
END ;
IF (~done) & (errno # Unix.ENOENT) THEN
Console.String("warning Files0.Old "); Console.String(name);
Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
END ;
IF done THEN
res := Unix.Fstat(fd, stat);
f := CacheEntry(stat.dev, stat.ino, stat.mtime);
IF f # NIL THEN res := Unix.Close(fd); RETURN f
ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
RETURN f
END
ELSIF dir = "" THEN RETURN NIL
ELSE MakeFileName(dir, name, path); ScanPath(pos, dir)
END
END
ELSE RETURN NIL
END
END Old;
PROCEDURE Purge* (f: File);
VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
f.pos := 0; f.len := 0; f.swapper := -1;
res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
END Purge;
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
BEGIN
Create(f); res := Unix.Fstat(f.fd, stat);
time := localtime(stat.mtime);
t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
END GetDate;
PROCEDURE Pos* (VAR r: Rider): LONGINT;
BEGIN RETURN r.org + r.offset
END Pos;
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
VAR org, offset, i, n, res: LONGINT; buf: Buffer;
BEGIN
IF f # NIL THEN
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
offset := pos MOD bufsize; org := pos - offset; i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
IF i < nofbufs THEN
IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
ELSE buf := f.bufs[i]
END
ELSE
f.swapper := (f.swapper + 1) MOD nofbufs;
buf := f.bufs[f.swapper];
Flush(buf)
END ;
IF buf.org # org THEN
IF org = f.len THEN buf.size := 0
ELSE Create(f);
IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
n := Unix.ReadBlk(f.fd, buf.data);
IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
f.pos := org + n;
buf.size := n
END ;
buf.org := org; buf.chg := FALSE
END
ELSE buf := NIL; org := 0; offset := 0
END ;
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
END Set;
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
IF (offset < buf.size) THEN
x := buf.data[offset]; r.offset := offset + 1
ELSIF r.org + offset < buf.f.len THEN
Set(r, r.buf.f, r.org + offset);
x := r.buf.data[0]; r.offset := 1
ELSE
x := 0X; r.eof := TRUE
END
END Read;
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := buf.size - offset;
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
END ;
r.res := 0; r.eof := FALSE
END ReadBytes;
PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
BEGIN
ReadBytes(r, x, 1);
END ReadByte;
PROCEDURE Base* (VAR r: Rider): File;
BEGIN RETURN r.buf.f
END Base;
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
buf.data[offset] := x;
buf.chg := TRUE;
IF offset = buf.size THEN
INC(buf.size); INC(buf.f.len)
END ;
r.offset := offset + 1; r.res := 0
END Write;
PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := bufsize - offset;
IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
INC(offset, min); r.offset := offset;
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
INC(xpos, min); DEC(n, min); buf.chg := TRUE
END ;
r.res := 0
END WriteBytes;
(* another solution would be one that is similar to ReadBytes, WriteBytes.
No code duplication, more symmetric, only two ifs for
Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
must be made consistent with offset (if offset > buf.size) in a lazy way.
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= bufsize) OR (r.org # buf.org) THEN
Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
END ;
buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
END Write;
PROCEDURE WriteBytes ...
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= buf.size) OR (r.org # buf.org) THEN
IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
END
END ;
x := buf.data[offset]; r.offset := offset + 1
END Read;
but this would also affect Set, Length, and Flush.
Especially Length would become fairly complex.
*)
PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Unlink(name));
res := SHORT(Unix.errno())
END Delete;
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
VAR fdold, fdnew, n, errno, r: LONGINT;
ostat, nstat: Unix.Status;
buf: ARRAY 4096 OF CHAR;
BEGIN
r := Unix.Stat(old, ostat);
IF r >= 0 THEN
r := Unix.Stat(new, nstat);
IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
Delete(new, res); (* work around stale nfs handles *)
END ;
r := Unix.Rename(old, new);
IF r < 0 THEN res := SHORT(Unix.errno());
IF res = Unix.EXDEV THEN (* cross device link, move the file *)
fdold := Unix.Open(old, Unix.rdonly, {});
IF fdold < 0 THEN res := 2; RETURN END ;
fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
WHILE n > 0 DO
r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
Err("cannot move file", NIL, errno)
END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
END ;
errno := Unix.errno();
r := Unix.Close(fdold); r := Unix.Close(fdnew);
IF n = 0 THEN r := Unix.Unlink(old); res := 0
ELSE Err("cannot move file", NIL, errno)
END ;
ELSE RETURN (* res is Unix.Rename return code *)
END
END ;
res := 0
ELSE res := 2 (* old file not found *)
END
END Rename;
PROCEDURE Register* (f: File);
VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
BEGIN
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
Close(f);
IF f.registerName # "" THEN
Rename(f.workName, f.registerName, errno);
IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END
END Register;
PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Chdir(path));
getcwd(Kernel.CWD)
END ChangeDirectory;
PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
VAR i, j: LONGINT;
BEGIN
IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
END
END FlipBytes;
PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
BEGIN Read(R, SYSTEM.VAL(CHAR, x))
END ReadBool;
PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN ReadBytes(R, b, 2);
x := ORD(b[0]) + ORD(b[1])*256
END ReadInt;
PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
END ReadLInt;
PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
END ReadSet;
PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
END ReadReal;
PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
END ReadLReal;
PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
END ReadString;
PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
BEGIN s := 0; n := 0; Read(R, ch);
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
x := n
END ReadNum;
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
END WriteBool;
PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
WriteBytes(R, b, 2);
END WriteInt;
PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN
b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
WriteBytes(R, b, 4);
END WriteLInt;
PROCEDURE WriteSet* (VAR R: Rider; x: SET);
VAR b: ARRAY 4 OF CHAR; i: LONGINT;
BEGIN i := SYSTEM.VAL(LONGINT, x);
b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H);
WriteBytes(R, b, 4);
END WriteSet;
PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
END WriteReal;
PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
END WriteLReal;
PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE x[i] # 0X DO INC(i) END ;
WriteBytes(R, x, i+1)
END WriteString;
PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
BEGIN
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
Write(R, CHR(x MOD 128))
END WriteNum;
PROCEDURE Finalize(o: SYSTEM.PTR);
VAR f: File; res: LONGINT;
BEGIN
f := SYSTEM.VAL(File, o);
IF f.fd >= 0 THEN
fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
IF f.tempFile THEN res := Unix.Unlink(f.workName) END
END
END Finalize;
PROCEDURE Init;
VAR i: LONGINT;
BEGIN
i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
tempno := -1; Kernel.nofiles := 0
END Init;
BEGIN Init
END Files0.

View file

@ -0,0 +1,664 @@
MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
(* modified version of Files, which opens only the file provided and does not scan any path in any environment variable, also ReadLine procedure added; -- noch *)
IMPORT SYSTEM, Unix, Kernel, Args, Console;
(* standard data type I/O
little endian,
Sint:1, Int:2, Lint:4
ORD({0}) = 1,
false = 0, true =1
IEEE real format,
null terminated strings,
compact numbers according to M.Odersky *)
CONST
nofbufs = 4;
bufsize = 4096;
fileTabSize = 64;
noDesc = -1;
notDone = -1;
(* file states *)
open = 0; create = 1; close = 2;
TYPE
FileName = ARRAY 101 OF CHAR;
File* = POINTER TO Handle;
Buffer = POINTER TO BufDesc;
Handle = RECORD
workName, registerName: FileName;
tempFile: BOOLEAN;
dev, ino, mtime: LONGINT;
fd-: INTEGER;
len, pos: LONGINT;
bufs: ARRAY nofbufs OF Buffer;
swapper, state: INTEGER
END ;
BufDesc = RECORD
f: File;
chg: BOOLEAN;
org, size: LONGINT;
data: ARRAY bufsize OF SYSTEM.BYTE
END ;
Rider* = RECORD
res*: LONGINT;
eof*: BOOLEAN;
buf: Buffer;
org, offset: LONGINT
END ;
Time = POINTER TO TimeDesc;
TimeDesc = RECORD
sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
END ;
VAR
fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
tempno: INTEGER;
(* for localtime *)
PROCEDURE -includetime()
'#include "time.h"';
PROCEDURE -localtime(VAR clock: LONGINT): Time
"(Files_Time) localtime(clock)";
PROCEDURE -getcwd(VAR cwd: Unix.Name)
"getcwd(cwd, cwd__len)";
PROCEDURE -IdxTrap "__HALT(-1)";
PROCEDURE^ Finalize(o: SYSTEM.PTR);
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
BEGIN
Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
IF f # NIL THEN
IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
END ;
IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
Console.Ln;
HALT(99)
END Err;
PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN i := 0; j := 0;
WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ;
IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ;
WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ;
dest[i] := 0X
END MakeFileName;
PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
VAR n, i, j: LONGINT;
BEGIN
INC(tempno); n := tempno; i := 0;
IF finalName[0] # "/" THEN (* relative pathname *)
WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END
END;
j := 0;
WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END;
DEC(i);
WHILE name[i] # "/" DO DEC(i) END;
name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6);
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := "."; INC(i); n := SHORT(Unix.Getpid());
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := 0X
END GetTempName;
PROCEDURE Create(f: File);
VAR stat: Unix.Status; done: BOOLEAN;
errno: LONGINT; err: ARRAY 32 OF CHAR;
BEGIN
IF f.fd = noDesc THEN
IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
ELSIF f.state = close THEN
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END ;
errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8})));
done := f.fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
Kernel.GC(TRUE);
f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8})));
done := f.fd >= 0
END ;
IF done THEN
IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
END
ELSE errno := Unix.errno();
IF errno = Unix.ENOENT THEN err := "no such directory"
ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
ELSE err := "file not created"
END ;
Err(err, f, errno)
END
END
END Create;
PROCEDURE Flush(buf: Buffer);
VAR res: LONGINT; f: File; stat: Unix.Status;
BEGIN
IF buf.chg THEN f := buf.f; Create(f);
IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
f.pos := buf.org + buf.size;
buf.chg := FALSE;
res := Unix.Fstat(f.fd, stat);
f.mtime := stat.mtime
END
END Flush;
PROCEDURE Close* (f: File);
VAR i, res: LONGINT;
BEGIN
IF (f.state # create) OR (f.registerName # "") THEN
Create(f); i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
res := Unix.Fsync(f.fd);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
END
END Close;
PROCEDURE Length* (f: File): LONGINT;
BEGIN RETURN f.len
END Length;
PROCEDURE New* (name: ARRAY OF CHAR): File;
VAR f: File;
BEGIN
NEW(f); f.workName := ""; COPY(name, f.registerName);
f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
RETURN f
END New;
(*
PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
BEGIN
i := 0; ch := Kernel.OBERON[pos];
WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
IF ch = "~" THEN
INC(pos); ch := Kernel.OBERON[pos];
home := ""; Args.GetEnv("HOME", home);
WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
END
END ;
WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
dir[i] := 0X
END ScanPath;
*)
PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0; ch := name[0];
WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
RETURN ch = "/"
END HasDir;
PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < fileTabSize DO
f := SYSTEM.VAL(File, fileTab[i]);
IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
IF mtime # f.mtime THEN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
f.swapper := -1; f.mtime := mtime;
res := Unix.Fstat(f.fd, stat); f.len := stat.size
END ;
RETURN f
END ;
INC(i)
END ;
RETURN NIL
END CacheEntry;
PROCEDURE Old* (name: ARRAY OF CHAR): File;
VAR f: File; fd: INTEGER; res, errno: LONGINT; pos: INTEGER; done: BOOLEAN;
dir, path: ARRAY 256 OF CHAR;
stat: Unix.Status;
BEGIN
IF name # "" THEN
IF HasDir(name) THEN dir := ""; COPY(name, path)
ELSE
pos := 0;
COPY(name, path); (* -- noch *)
(*ScanPath(pos, dir);*) (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
END ;
LOOP
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
Kernel.GC(TRUE);
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {})));
done := fd >= 0; errno := Unix.errno();
IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
END ;
IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
(* errno EAGAIN observed on Solaris 2.4 *)
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno()
END ;
IF (~done) & (errno # Unix.ENOENT) THEN
Console.String("warning Files.Old "); Console.String(name);
Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
END ;
IF done THEN
res := Unix.Fstat(fd, stat);
f := CacheEntry(stat.dev, stat.ino, stat.mtime);
IF f # NIL THEN res := Unix.Close(fd); RETURN f
ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
RETURN f
END
ELSIF dir = "" THEN RETURN NIL
ELSE (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
RETURN NIL
END
END
ELSE RETURN NIL
END
END Old;
PROCEDURE Purge* (f: File);
VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
f.pos := 0; f.len := 0; f.swapper := -1;
res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
END Purge;
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
BEGIN
Create(f); res := Unix.Fstat(f.fd, stat);
time := localtime(stat.mtime);
t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
END GetDate;
PROCEDURE Pos* (VAR r: Rider): LONGINT;
BEGIN RETURN r.org + r.offset
END Pos;
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
VAR org, offset, i, n, res: LONGINT; buf: Buffer;
BEGIN
IF f # NIL THEN
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
offset := pos MOD bufsize; org := pos - offset; i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
IF i < nofbufs THEN
IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
ELSE buf := f.bufs[i]
END
ELSE
f.swapper := (f.swapper + 1) MOD nofbufs;
buf := f.bufs[f.swapper];
Flush(buf)
END ;
IF buf.org # org THEN
IF org = f.len THEN buf.size := 0
ELSE Create(f);
IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
n := Unix.ReadBlk(f.fd, buf.data);
IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
f.pos := org + n;
buf.size := n
END ;
buf.org := org; buf.chg := FALSE
END
ELSE buf := NIL; org := 0; offset := 0
END ;
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
END Set;
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
IF (offset < buf.size) THEN
x := buf.data[offset]; r.offset := offset + 1
ELSIF r.org + offset < buf.f.len THEN
Set(r, r.buf.f, r.org + offset);
x := r.buf.data[0]; r.offset := 1
ELSE
x := 0X; r.eof := TRUE
END
END Read;
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := buf.size - offset;
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
END ;
r.res := 0; r.eof := FALSE
END ReadBytes;
PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
BEGIN
ReadBytes(r, x, 1);
END ReadByte;
PROCEDURE Base* (VAR r: Rider): File;
BEGIN RETURN r.buf.f
END Base;
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
buf.data[offset] := x;
buf.chg := TRUE;
IF offset = buf.size THEN
INC(buf.size); INC(buf.f.len)
END ;
r.offset := offset + 1; r.res := 0
END Write;
PROCEDURE WriteByte* (VAR r : Rider; x : SYSTEM.BYTE); (* added for compatibility with PO 2013, -- noch *)
BEGIN
Write(r, x);
END WriteByte;
PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := bufsize - offset;
IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
INC(offset, min); r.offset := offset;
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
INC(xpos, min); DEC(n, min); buf.chg := TRUE
END ;
r.res := 0
END WriteBytes;
(* another solution would be one that is similar to ReadBytes, WriteBytes.
No code duplication, more symmetric, only two ifs for
Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
must be made consistent with offset (if offset > buf.size) in a lazy way.
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= bufsize) OR (r.org # buf.org) THEN
Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
END ;
buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
END Write;
PROCEDURE WriteBytes ...
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= buf.size) OR (r.org # buf.org) THEN
IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
END
END ;
x := buf.data[offset]; r.offset := offset + 1
END Read;
but this would also affect Set, Length, and Flush.
Especially Length would become fairly complex.
*)
PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Unlink(name));
res := SHORT(Unix.errno())
END Delete;
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
VAR fdold, fdnew: INTEGER; n, errno, r: LONGINT;
ostat, nstat: Unix.Status;
buf: ARRAY 4096 OF CHAR;
BEGIN
r := Unix.Stat(old, ostat);
IF r >= 0 THEN
r := Unix.Stat(new, nstat);
IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
Delete(new, res); (* work around stale nfs handles *)
END ;
r := Unix.Rename(old, new);
IF r < 0 THEN res := SHORT(Unix.errno());
IF res = Unix.EXDEV THEN (* cross device link, move the file *)
fdold := Unix.Open(old, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {})));
IF fdold < 0 THEN res := 2; RETURN END ;
fdnew := Unix.Open(new, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8})));
IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
WHILE n > 0 DO
r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
Err("cannot move file", NIL, errno)
END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
END ;
errno := Unix.errno();
r := Unix.Close(fdold); r := Unix.Close(fdnew);
IF n = 0 THEN r := Unix.Unlink(old); res := 0
ELSE Err("cannot move file", NIL, errno)
END ;
ELSE RETURN (* res is Unix.Rename return code *)
END
END ;
res := 0
ELSE res := 2 (* old file not found *)
END
END Rename;
PROCEDURE Register* (f: File);
VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
BEGIN
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
Close(f);
IF f.registerName # "" THEN
Rename(f.workName, f.registerName, errno);
IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END
END Register;
PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Chdir(path));
getcwd(Kernel.CWD)
END ChangeDirectory;
PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
VAR i, j: LONGINT;
BEGIN
IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
END
END FlipBytes;
PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
BEGIN Read(R, SYSTEM.VAL(CHAR, x))
END ReadBool;
PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN ReadBytes(R, b, 2);
x := ORD(b[0]) + ORD(b[1])*256
END ReadInt;
PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
END ReadLInt;
PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
END ReadSet;
PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
END ReadReal;
PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
END ReadLReal;
PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
END ReadString;
(* need to read line; -- noch *)
PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR; b : BOOLEAN;
BEGIN i := 0;
b := FALSE;
REPEAT
Read(R, ch);
IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN
b := TRUE
ELSE
x[i] := ch;
INC(i);
END;
UNTIL b
END ReadLine;
PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
BEGIN s := 0; n := 0; Read(R, ch);
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
x := n
END ReadNum;
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
END WriteBool;
PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
WriteBytes(R, b, 2);
END WriteInt;
PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN
b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
WriteBytes(R, b, 4);
END WriteLInt;
PROCEDURE WriteSet* (VAR R: Rider; x: SET);
VAR b: ARRAY 4 OF CHAR; i: LONGINT;
BEGIN i := SYSTEM.VAL(LONGINT, x);
b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H);
WriteBytes(R, b, 4);
END WriteSet;
PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
END WriteReal;
PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
END WriteLReal;
PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE x[i] # 0X DO INC(i) END ;
WriteBytes(R, x, i+1)
END WriteString;
PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
BEGIN
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
Write(R, CHR(x MOD 128))
END WriteNum;
PROCEDURE GetName*(f: File; VAR name: ARRAY OF CHAR);
BEGIN
COPY (f.workName, name);
END GetName;
PROCEDURE Finalize(o: SYSTEM.PTR);
VAR f: File; res: LONGINT;
BEGIN
f := SYSTEM.VAL(File, o);
IF f.fd >= 0 THEN
fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
IF f.tempFile THEN res := Unix.Unlink(f.workName) END
END
END Finalize;
PROCEDURE Init;
VAR i: LONGINT;
BEGIN
i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
tempno := -1; Kernel.nofiles := 0
END Init;
BEGIN Init
END Files.

View file

@ -0,0 +1,636 @@
MODULE Files0; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
(* this module is not for use by developers and inteded to bootstrap voc *)
(* for general use import Files module *)
IMPORT SYSTEM, Unix, Kernel := Kernel0, Args, Console;
(* standard data type I/O
little endian,
Sint:1, Int:2, Lint:4
ORD({0}) = 1,
false = 0, true =1
IEEE real format,
null terminated strings,
compact numbers according to M.Odersky *)
CONST
nofbufs = 4;
bufsize = 4096;
fileTabSize = 64;
noDesc = -1;
notDone = -1;
(* file states *)
open = 0; create = 1; close = 2;
TYPE
FileName = ARRAY 101 OF CHAR;
File* = POINTER TO Handle;
Buffer = POINTER TO BufDesc;
Handle = RECORD
workName, registerName: FileName;
tempFile: BOOLEAN;
dev, ino, mtime: LONGINT;
fd-: INTEGER;
len, pos: LONGINT;
bufs: ARRAY nofbufs OF Buffer;
swapper, state: INTEGER
END ;
BufDesc = RECORD
f: File;
chg: BOOLEAN;
org, size: LONGINT;
data: ARRAY bufsize OF SYSTEM.BYTE
END ;
Rider* = RECORD
res*: LONGINT;
eof*: BOOLEAN;
buf: Buffer;
org, offset: LONGINT
END ;
Time = POINTER TO TimeDesc;
TimeDesc = RECORD
sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
END ;
VAR
fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
tempno: INTEGER;
(* for localtime *)
PROCEDURE -includetime()
'#include "time.h"';
PROCEDURE -localtime(VAR clock: LONGINT): Time
"(Files0_Time) localtime(clock)";
PROCEDURE -getcwd(VAR cwd: Unix.Name)
"getcwd(cwd, cwd__len)";
PROCEDURE -IdxTrap "__HALT(-1)";
PROCEDURE^ Finalize(o: SYSTEM.PTR);
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
BEGIN
Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
IF f # NIL THEN
IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
END ;
IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
Console.Ln;
HALT(99)
END Err;
PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN i := 0; j := 0;
WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ;
IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ;
WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ;
dest[i] := 0X
END MakeFileName;
PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
VAR n, i, j: LONGINT;
BEGIN
INC(tempno); n := tempno; i := 0;
IF finalName[0] # "/" THEN (* relative pathname *)
WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END
END;
j := 0;
WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END;
DEC(i);
WHILE name[i] # "/" DO DEC(i) END;
name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6);
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := "."; INC(i); n := SHORT(Unix.Getpid());
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
name[i] := 0X
END GetTempName;
PROCEDURE Create(f: File);
VAR stat: Unix.Status; done: BOOLEAN;
errno: LONGINT; err: ARRAY 32 OF CHAR;
BEGIN
IF f.fd = noDesc THEN
IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
ELSIF f.state = close THEN
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END ;
errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, (Unix.rdwr + Unix.creat + Unix.trunc))), SHORT(SYSTEM.VAL(LONGINT, ({2, 4,5, 7,8}))));
done := f.fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
Kernel.GC(TRUE);
f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, (Unix.rdwr + Unix.creat + Unix.trunc))), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8})));
done := f.fd >= 0
END ;
IF done THEN
IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
END
ELSE errno := Unix.errno();
IF errno = Unix.ENOENT THEN err := "no such directory"
ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
ELSE err := "file not created"
END ;
Err(err, f, errno)
END
END
END Create;
PROCEDURE Flush(buf: Buffer);
VAR res: LONGINT; f: File; stat: Unix.Status;
BEGIN
IF buf.chg THEN f := buf.f; Create(f);
IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
f.pos := buf.org + buf.size;
buf.chg := FALSE;
res := Unix.Fstat(f.fd, stat);
f.mtime := stat.mtime
END
END Flush;
PROCEDURE Close* (f: File);
VAR i, res: LONGINT;
BEGIN
IF (f.state # create) OR (f.registerName # "") THEN
Create(f); i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
res := Unix.Fsync(f.fd);
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
END
END Close;
PROCEDURE Length* (f: File): LONGINT;
BEGIN RETURN f.len
END Length;
PROCEDURE New* (name: ARRAY OF CHAR): File;
VAR f: File;
BEGIN
NEW(f); f.workName := ""; COPY(name, f.registerName);
f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
RETURN f
END New;
PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
BEGIN
i := 0; ch := Kernel.OBERON[pos];
WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
IF ch = "~" THEN
INC(pos); ch := Kernel.OBERON[pos];
home := ""; Args.GetEnv("HOME", home);
WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
END
END ;
WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
dir[i] := 0X
END ScanPath;
PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0; ch := name[0];
WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
RETURN ch = "/"
END HasDir;
PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < fileTabSize DO
f := SYSTEM.VAL(File, fileTab[i]);
IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
IF mtime # f.mtime THEN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
f.swapper := -1; f.mtime := mtime;
res := Unix.Fstat(f.fd, stat); f.len := stat.size
END ;
RETURN f
END ;
INC(i)
END ;
RETURN NIL
END CacheEntry;
PROCEDURE Old* (name: ARRAY OF CHAR): File;
VAR f: File; fd: INTEGER; res, errno: LONGINT; pos: INTEGER; done: BOOLEAN;
dir, path: ARRAY 256 OF CHAR;
stat: Unix.Status;
BEGIN
IF name # "" THEN
IF HasDir(name) THEN dir := ""; COPY(name, path)
ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir)
END ;
LOOP
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno();
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
Kernel.GC(TRUE);
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {})));
done := fd >= 0; errno := Unix.errno();
IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
END ;
IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
(* errno EAGAIN observed on Solaris 2.4 *)
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno()
END ;
IF (~done) & (errno # Unix.ENOENT) THEN
Console.String("warning Files0.Old "); Console.String(name);
Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
END ;
IF done THEN
res := Unix.Fstat(fd, stat);
f := CacheEntry(stat.dev, stat.ino, stat.mtime);
IF f # NIL THEN res := Unix.Close(fd); RETURN f
ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
RETURN f
END
ELSIF dir = "" THEN RETURN NIL
ELSE MakeFileName(dir, name, path); ScanPath(pos, dir)
END
END
ELSE RETURN NIL
END
END Old;
PROCEDURE Purge* (f: File);
VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
BEGIN i := 0;
WHILE i < nofbufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
INC(i)
END ;
IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
f.pos := 0; f.len := 0; f.swapper := -1;
res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
END Purge;
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
BEGIN
Create(f); res := Unix.Fstat(f.fd, stat);
time := localtime(stat.mtime);
t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
END GetDate;
PROCEDURE Pos* (VAR r: Rider): LONGINT;
BEGIN RETURN r.org + r.offset
END Pos;
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
VAR org, offset, i, n, res: LONGINT; buf: Buffer;
BEGIN
IF f # NIL THEN
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
offset := pos MOD bufsize; org := pos - offset; i := 0;
WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
IF i < nofbufs THEN
IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
ELSE buf := f.bufs[i]
END
ELSE
f.swapper := (f.swapper + 1) MOD nofbufs;
buf := f.bufs[f.swapper];
Flush(buf)
END ;
IF buf.org # org THEN
IF org = f.len THEN buf.size := 0
ELSE Create(f);
IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
n := Unix.ReadBlk(f.fd, buf.data);
IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
f.pos := org + n;
buf.size := n
END ;
buf.org := org; buf.chg := FALSE
END
ELSE buf := NIL; org := 0; offset := 0
END ;
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
END Set;
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
IF (offset < buf.size) THEN
x := buf.data[offset]; r.offset := offset + 1
ELSIF r.org + offset < buf.f.len THEN
Set(r, r.buf.f, r.org + offset);
x := r.buf.data[0]; r.offset := 1
ELSE
x := 0X; r.eof := TRUE
END
END Read;
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := buf.size - offset;
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
END ;
r.res := 0; r.eof := FALSE
END ReadBytes;
PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
BEGIN
ReadBytes(r, x, 1);
END ReadByte;
PROCEDURE Base* (VAR r: Rider): File;
BEGIN RETURN r.buf.f
END Base;
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
buf.data[offset] := x;
buf.chg := TRUE;
IF offset = buf.size THEN
INC(buf.size); INC(buf.f.len)
END ;
r.offset := offset + 1; r.res := 0
END Write;
PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
BEGIN
IF n > LEN(x) THEN IdxTrap END ;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= bufsize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END ;
restInBuf := bufsize - offset;
IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
INC(offset, min); r.offset := offset;
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
INC(xpos, min); DEC(n, min); buf.chg := TRUE
END ;
r.res := 0
END WriteBytes;
(* another solution would be one that is similar to ReadBytes, WriteBytes.
No code duplication, more symmetric, only two ifs for
Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
must be made consistent with offset (if offset > buf.size) in a lazy way.
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= bufsize) OR (r.org # buf.org) THEN
Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
END ;
buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
END Write;
PROCEDURE WriteBytes ...
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
IF (offset >= buf.size) OR (r.org # buf.org) THEN
IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
END
END ;
x := buf.data[offset]; r.offset := offset + 1
END Read;
but this would also affect Set, Length, and Flush.
Especially Length would become fairly complex.
*)
PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Unlink(name));
res := SHORT(Unix.errno())
END Delete;
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
VAR fdold, fdnew: INTEGER; n, errno, r: LONGINT;
ostat, nstat: Unix.Status;
buf: ARRAY 4096 OF CHAR;
BEGIN
r := Unix.Stat(old, ostat);
IF r >= 0 THEN
r := Unix.Stat(new, nstat);
IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
Delete(new, res); (* work around stale nfs handles *)
END ;
r := Unix.Rename(old, new);
IF r < 0 THEN res := SHORT(Unix.errno());
IF res = Unix.EXDEV THEN (* cross device link, move the file *)
fdold := Unix.Open(old, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {})));
IF fdold < 0 THEN res := 2; RETURN END ;
fdnew := Unix.Open(new, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8})));
IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
WHILE n > 0 DO
r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
Err("cannot move file", NIL, errno)
END ;
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
END ;
errno := Unix.errno();
r := Unix.Close(fdold); r := Unix.Close(fdnew);
IF n = 0 THEN r := Unix.Unlink(old); res := 0
ELSE Err("cannot move file", NIL, errno)
END ;
ELSE RETURN (* res is Unix.Rename return code *)
END
END ;
res := 0
ELSE res := 2 (* old file not found *)
END
END Rename;
PROCEDURE Register* (f: File);
VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
BEGIN
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
Close(f);
IF f.registerName # "" THEN
Rename(f.workName, f.registerName, errno);
IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END
END Register;
PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
BEGIN
res := SHORT(Unix.Chdir(path));
getcwd(Kernel.CWD)
END ChangeDirectory;
PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
VAR i, j: LONGINT;
BEGIN
IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
END
END FlipBytes;
PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
BEGIN Read(R, SYSTEM.VAL(CHAR, x))
END ReadBool;
PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN ReadBytes(R, b, 2);
x := ORD(b[0]) + ORD(b[1])*256
END ReadInt;
PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
END ReadLInt;
PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4);
x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
END ReadSet;
PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
END ReadReal;
PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
END ReadLReal;
PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
END ReadString;
PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
BEGIN s := 0; n := 0; Read(R, ch);
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
x := n
END ReadNum;
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
END WriteBool;
PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
VAR b: ARRAY 2 OF CHAR;
BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
WriteBytes(R, b, 2);
END WriteInt;
PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
VAR b: ARRAY 4 OF CHAR;
BEGIN
b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
WriteBytes(R, b, 4);
END WriteLInt;
PROCEDURE WriteSet* (VAR R: Rider; x: SET);
VAR b: ARRAY 4 OF CHAR; i: LONGINT;
BEGIN i := SYSTEM.VAL(LONGINT, x);
b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H);
WriteBytes(R, b, 4);
END WriteSet;
PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
VAR b: ARRAY 4 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
END WriteReal;
PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
VAR b: ARRAY 8 OF CHAR;
BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
END WriteLReal;
PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE x[i] # 0X DO INC(i) END ;
WriteBytes(R, x, i+1)
END WriteString;
PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
BEGIN
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
Write(R, CHR(x MOD 128))
END WriteNum;
PROCEDURE Finalize(o: SYSTEM.PTR);
VAR f: File; res: LONGINT;
BEGIN
f := SYSTEM.VAL(File, o);
IF f.fd >= 0 THEN
fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
IF f.tempFile THEN res := Unix.Unlink(f.workName) END
END
END Finalize;
PROCEDURE Init;
VAR i: LONGINT;
BEGIN
i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
tempno := -1; Kernel.nofiles := 0
END Init;
BEGIN Init
END Files0.

View file

@ -292,16 +292,18 @@ from man gettimeofday
END ;
Sockaddr* = RECORD
family*: INTEGER;
port*: INTEGER;
internetAddr*: LONGINT;
pad*: ARRAY 8 OF CHAR;
family0*, family1*: SHORTINT;
pad0, pad1: SHORTINT;
pad2 : INTEGER;
(*port*: INTEGER;
internetAddr*: LONGINT;*)
pad*: ARRAY 14 OF CHAR;
END ;
HostEntry* = POINTER [1] TO Hostent;
Hostent* = RECORD
name*, aliases*: LONGINT;
addrtype*, length*: LONGINT;
addrtype*, length*: INTEGER;
addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*)
END;
@ -337,71 +339,71 @@ from man gettimeofday
RETURN err()
END errno;
PROCEDURE -Exit*(n: LONGINT)
PROCEDURE -Exit*(n: INTEGER)
"exit(n)";
PROCEDURE -Fork*(): LONGINT
PROCEDURE -Fork*(): INTEGER
"fork()";
PROCEDURE -Wait*(VAR status: LONGINT): LONGINT
PROCEDURE -Wait*(VAR status: INTEGER): INTEGER
"wait(status)";
PROCEDURE -Select*(width: LONGINT; VAR readfds, writefds, exceptfds: FdSet; VAR timeout: Timeval): LONGINT
PROCEDURE -Select*(width: INTEGER; VAR readfds, writefds, exceptfds: FdSet; VAR timeout: Timeval): INTEGER
"select(width, readfds, writefds, exceptfds, timeout)";
PROCEDURE -Gettimeofday* (VAR tv: Timeval; VAR tz: Timezone) : LONGINT
PROCEDURE -Gettimeofday* (VAR tv: Timeval; VAR tz: Timezone) : INTEGER
"gettimeofday(tv, tz)";
PROCEDURE -Read* (fd, buf, nbyte: LONGINT): LONGINT
PROCEDURE -Read* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT
"read(fd, buf, nbyte)";
PROCEDURE -ReadBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT
PROCEDURE -ReadBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT
"read(fd, buf, buf__len)";
PROCEDURE -Write* (fd, buf, nbyte: LONGINT): LONGINT
PROCEDURE -Write* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT
"write(fd, buf, nbyte)";
PROCEDURE -WriteBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT
PROCEDURE -WriteBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT
"write(fd, buf, buf__len)";
PROCEDURE -Dup*(fd: LONGINT): LONGINT
PROCEDURE -Dup*(fd: INTEGER): INTEGER
"dup(fd)";
PROCEDURE -Dup2*(fd1, fd2: LONGINT): LONGINT
PROCEDURE -Dup2*(fd1, fd2: INTEGER): INTEGER
"dup(fd1, fd2)";
PROCEDURE -Pipe*(fds : LONGINT): LONGINT
PROCEDURE -Pipe*(fds : LONGINT): INTEGER
"pipe(fds)";
PROCEDURE -Getpid*(): LONGINT
PROCEDURE -Getpid*(): INTEGER
"getpid()";
PROCEDURE -Getuid*(): LONGINT
PROCEDURE -Getuid*(): INTEGER
"getuid()";
PROCEDURE -Geteuid*(): LONGINT
PROCEDURE -Geteuid*(): INTEGER
"geteuid()";
PROCEDURE -Getgid*(): LONGINT
PROCEDURE -Getgid*(): INTEGER
"getgid()";
PROCEDURE -Getegid*(): LONGINT
PROCEDURE -Getegid*(): INTEGER
"getegid()";
PROCEDURE -Unlink*(name: Name): LONGINT
PROCEDURE -Unlink*(name: Name): INTEGER
"unlink(name)";
PROCEDURE -Open*(name: Name; flag, mode: SET): LONGINT
PROCEDURE -Open*(name: Name; flag: INTEGER; mode: LONGINT): INTEGER
"open(name, flag, mode)";
PROCEDURE -Close*(fd: LONGINT): LONGINT
PROCEDURE -Close*(fd: INTEGER): INTEGER
"close(fd)";
PROCEDURE -stat(name: Name; VAR statbuf: Status): LONGINT
PROCEDURE -stat(name: Name; VAR statbuf: Status): INTEGER
"stat((const char*)name, (struct stat*)statbuf)";
PROCEDURE Stat*(name: Name; VAR statbuf: Status): LONGINT;
VAR res: LONGINT;
PROCEDURE Stat*(name: Name; VAR statbuf: Status): INTEGER;
VAR res: INTEGER;
BEGIN
res := stat(name, statbuf);
(* make the first 4 bytes as unique as possible (used in module Files for caching!) *)
@ -411,11 +413,11 @@ from man gettimeofday
RETURN res;
END Stat;
PROCEDURE -fstat(fd: LONGINT; VAR statbuf: Status): LONGINT
PROCEDURE -fstat(fd: INTEGER; VAR statbuf: Status): INTEGER
"fstat(fd, (struct stat*)statbuf)";
PROCEDURE Fstat*(fd: LONGINT; VAR statbuf: Status): LONGINT;
VAR res: LONGINT;
PROCEDURE Fstat*(fd: INTEGER; VAR statbuf: Status): INTEGER;
VAR res: INTEGER;
BEGIN
res := fstat(fd, statbuf);
(* make the first 4 bytes as unique as possible (used in module Files for caching!) *)
@ -424,81 +426,81 @@ from man gettimeofday
RETURN res;
END Fstat;
PROCEDURE -Fchmod*(fd, mode: LONGINT): LONGINT
PROCEDURE -Fchmod*(fd, mode: INTEGER): INTEGER
"fchmod(fd, mode)";
PROCEDURE -Chmod*(path: Name; mode: LONGINT): LONGINT
PROCEDURE -Chmod*(path: Name; mode: INTEGER): INTEGER
"chmod(path, mode)";
PROCEDURE -Lseek*(fd, offset, origin: LONGINT): LONGINT
PROCEDURE -Lseek*(fd: INTEGER; offset: LONGINT; origin: INTEGER): LONGINT
"lseek(fd, offset, origin)";
PROCEDURE -Fsync*(fd: LONGINT): LONGINT
PROCEDURE -Fsync*(fd: INTEGER): INTEGER
"fsync(fd)";
PROCEDURE -Fcntl*(fd, cmd, arg: LONGINT ): LONGINT
PROCEDURE -Fcntl*(fd: INTEGER; cmd: INTEGER; arg: LONGINT ): INTEGER
"fcntl(fd, cmd, arg)";
PROCEDURE -Flock*(fd, operation: LONGINT): LONGINT
PROCEDURE -Flock*(fd, operation: INTEGER): INTEGER
"flock(fd, operation)";
PROCEDURE -Ftruncate*(fd, length: LONGINT): LONGINT
PROCEDURE -Ftruncate*(fd: INTEGER; length: LONGINT): INTEGER
"ftruncate(fd, length)";
PROCEDURE -Readblk*(fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT
PROCEDURE -Readblk*(fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT
"read(fd, buf, len)";
PROCEDURE -Rename*(old, new: Name): LONGINT
PROCEDURE -Rename*(old, new: Name): INTEGER
"rename(old, new)";
PROCEDURE -Chdir*(path: Name): LONGINT
PROCEDURE -Chdir*(path: Name): INTEGER
"chdir(path)";
PROCEDURE -Ioctl*(fd, request, arg: LONGINT): LONGINT
PROCEDURE -Ioctl*(fd: INTEGER; request, arg: LONGINT): INTEGER
"ioctl(fd, request, arg)";
PROCEDURE -Kill*(pid, sig: LONGINT): LONGINT
PROCEDURE -Kill*(pid, sig: INTEGER): INTEGER
"kill(pid, sig)";
PROCEDURE -Sigsetmask*(mask: LONGINT): LONGINT
PROCEDURE -Sigsetmask*(mask: INTEGER): INTEGER
"sigsetmask(mask)";
PROCEDURE -Sleep*(ms : INTEGER): INTEGER
"sleep(ms)";
"(INTEGER)sleep(ms)";
PROCEDURE -Nanosleep*(VAR req : Timeval; VAR rem : Timeval): INTEGER
"nanosleep(req, rem)";
"(INTEGER)nanosleep(req, rem)";
(* TCP/IP networking *)
PROCEDURE -Gethostbyname*(name: Name): HostEntry
"(Unix_HostEntry)gethostbyname(name)";
PROCEDURE -Gethostname*(VAR name: Name): LONGINT
PROCEDURE -Gethostname*(VAR name: Name): INTEGER
"gethostname(name, name__len)";
PROCEDURE -Socket*(af, type, protocol: LONGINT): LONGINT
PROCEDURE -Socket*(af, type, protocol: INTEGER): INTEGER
"socket(af, type, protocol)";
PROCEDURE -Connect*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT
PROCEDURE -Connect*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER
"connect(socket, &(name), namelen)";
PROCEDURE -Getsockname*(socket: LONGINT; VAR name: Sockaddr; VAR namelen: LONGINT): LONGINT
PROCEDURE -Getsockname*(socket: INTEGER; VAR name: Sockaddr; VAR namelen: INTEGER): INTEGER
"getsockname(socket, name, namelen)";
PROCEDURE -Bind*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT
PROCEDURE -Bind*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER
"bind(socket, &(name), namelen)";
PROCEDURE -Listen*(socket, backlog: LONGINT): LONGINT
PROCEDURE -Listen*(socket, backlog: INTEGER): INTEGER
"listen(socket, backlog)";
PROCEDURE -Accept*(socket: LONGINT; VAR addr: Sockaddr; VAR addrlen: LONGINT): LONGINT
PROCEDURE -Accept*(socket: INTEGER; VAR addr: Sockaddr; VAR addrlen: INTEGER): LONGINT
"accept(socket, addr, addrlen)";
PROCEDURE -Recv*(socket, bufadr, buflen, flags: LONGINT): LONGINT
PROCEDURE -Recv*(socket: INTEGER; bufadr, buflen: LONGINT; flags: INTEGER): LONGINT
"recv(socket, bufadr, buflen, flags)";
PROCEDURE -Send*(socket, bufadr, buflen, flags: LONGINT): LONGINT
PROCEDURE -Send*(socket: INTEGER; bufadr, buflen: LONGINT; flags: INTEGER): LONGINT
"send(socket, bufadr, buflen, flags)";
PROCEDURE -sys(str: ARRAY OF CHAR): INTEGER (* need this to call external tools like gcc or gas; noch *)

View file

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

View file

@ -1,201 +0,0 @@
(* Ulm's Oberon Library
Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: SysStat.om,v 1.3 2000/11/12 13:02:09 borchert Exp $
----------------------------------------------------------------------------
$Log: SysStat.om,v $
Revision 1.3 2000/11/12 13:02:09 borchert
door file type added
Revision 1.2 2000/11/12 12:48:07 borchert
- conversion adapted to Solaris 2.x
- Lstat added
Revision 1.1 1994/02/23 08:00:48 borchert
Initial revision
----------------------------------------------------------------------------
AFB 9/89
----------------------------------------------------------------------------
*)
MODULE ulmSysStat;
(* examine inode: stat(2) and fstat(2) *)
IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, uSYS := ulmSYSTEM, SysConversions := ulmSysConversions, SysErrors := ulmSysErrors,
SysTypes := ulmSysTypes;
CONST
(* file mode:
bit 0 = 1<<0 bit 31 = 1<<31
user group other
3 1 1111 11
1 ... 6 5432 109 876 543 210
+--------+------+-----+-----+-----+-----+
| unused | type | sst | rwx | rwx | rwx |
+--------+------+-----+-----+-----+-----+
*)
type* = {12..15};
prot* = {0..8};
(* file types; example: (stat.mode * type = dir) *)
reg* = {15}; (* regular *)
dir* = {14}; (* directory *)
chr* = {13}; (* character special *)
fifo* = {12}; (* fifo *)
blk* = {13..14}; (* block special *)
symlink* = {13, 15}; (* symbolic link *)
socket* = {14, 15}; (* socket *)
(* special *)
setuid* = 11; (* set user id on execution *)
setgid* = 10; (* set group id on execution *)
savetext* = 9; (* save swapped text even after use *)
(* protection *)
uread* = 8; (* read permission owner *)
uwrite* = 7; (* write permission owner *)
uexec* = 6; (* execute/search permission owner *)
gread* = 5; (* read permission group *)
gwrite* = 4; (* write permission group *)
gexec* = 3; (* execute/search permission group *)
oread* = 2; (* read permission other *)
owrite* = 1; (* write permission other *)
oexec* = 0; (* execute/search permission other *)
(* example for "r-xr-x---": (read + exec) * (owner + group) *)
owner* = {uread, uwrite, uexec};
group* = {gread, gwrite, gexec};
other* = {oread, owrite, oexec};
read* = {uread, gread, oread};
write* = {uwrite, gwrite, owrite};
exec* = {uexec, gexec, oexec};
rwx* = prot;
TYPE
StatRec* = (* result of stat(2) and fstat(2) *)
RECORD
device*: SysTypes.Device; (* ID of device containing
a directory entry for this file *)
inode*: SysTypes.Inode; (* inode number *)
mode*: SET; (* file mode; see mknod(2) *)
nlinks*: LONGINT; (* number of links *)
uid*: LONGINT; (* user id of the file's owner *)
gid*: LONGINT; (* group id of the file's group *)
rdev*: SysTypes.Device; (* ID of device
this entry is defined only for
character special or block
special files
*)
size*: SysTypes.Offset; (* file size in bytes *)
blksize*: LONGINT; (* preferred blocksize *)
blocks*: LONGINT; (* # of blocks allocated *)
atime*: SysTypes.Time; (* time of last access *)
mtime*: SysTypes.Time; (* time of last data modification *)
ctime*: SysTypes.Time; (* time of last file status change *)
END;
(* Linux kernel struct stat (2.2.17)
struct stat {
unsigned short st_dev;
unsigned short __pad1;
unsigned long st_ino;
unsigned short st_mode;
unsigned short st_nlink;
unsigned short st_uid;
unsigned short st_gid;
unsigned short st_rdev;
unsigned short __pad2;
unsigned long st_size;
unsigned long st_blksize;
unsigned long st_blocks;
unsigned long st_atime;
unsigned long __unused1;
unsigned long st_mtime;
unsigned long __unused2;
unsigned long st_ctime;
unsigned long __unused3;
unsigned long __unused4;
unsigned long __unused5;
};
*)
CONST
statbufsize = 88(*64*); (* see <sys/stat.h> *) (* sizeof struct stat gives us 144 on x86_64 and 88 on x86 *)
TYPE
UnixStatRec = ARRAY statbufsize OF SYS.BYTE;
CONST
statbufconv =
(*"is=dev/-s=pad1/ll=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/ll=size/2*ll=blksize,blocks/il=atime/-l/il=mtime/-l/il=ctime/3*-l";*)
(*"ls=dev/-s=pad1/lL=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/lL=size/2*lL=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l";*)
"ll=dev/-l=devx/-s=pad1/ll=ino/Sl=mode/ll=nlink/ll=uid/ll=gid/ll=rdev/-l=rdevx/-s=pad2/ll=size/2*ll=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l";
VAR
statbuffmt: SysConversions.Format;
PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
d0, d1, d2: LONGINT;
origbuf: UnixStatRec;
BEGIN
IF uSYS.UNIXCALL(Sys.newstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf), d2) THEN
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
RETURN TRUE
ELSE
SysErrors.Raise(errors, d0, Sys.newstat, path);
RETURN FALSE
END;
END Stat;
(*
PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
d0, d1: INTEGER;
origbuf: UnixStatRec;
BEGIN
IF SYS.UNIXCALL(Sys.newlstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf)) THEN
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
RETURN TRUE
ELSE
SysErrors.Raise(errors, d0, Sys.newlstat, path);
RETURN FALSE
END;
END Lstat;
*)
PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
d0, d1, d2: LONGINT;
origbuf: UnixStatRec;
BEGIN
IF uSYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf), d2) THEN
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
RETURN TRUE
ELSE
SysErrors.Raise(errors, d0, Sys.newfstat, "");
RETURN FALSE
END;
END Fstat;
BEGIN
SysConversions.Compile(statbuffmt, statbufconv);
END ulmSysStat.

View file

@ -1,70 +0,0 @@
(* Ulm's Oberon Library
Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: SysTypes.om,v 1.1 1994/02/23 08:01:38 borchert Exp $
----------------------------------------------------------------------------
$Log: SysTypes.om,v $
Revision 1.1 1994/02/23 08:01:38 borchert
Initial revision
----------------------------------------------------------------------------
AFB 9/89
----------------------------------------------------------------------------
*)
MODULE ulmSysTypes;
IMPORT Types := ulmTypes;
TYPE
Address* = Types.Address;
UntracedAddress* = Types.UntracedAddress;
Count* = Types.Count;
Size* = Types.Size;
Byte* = Types.Byte;
File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *)
Offset* = LONGINT;
Device* = LONGINT;
Inode* = LONGINT;
Time* = LONGINT;
Word* = INTEGER; (* must have the size of C's int-type *)
(* Note: linux supports wait4 but not waitid, i.e. these
* constants aren't needed. *)
(*
CONST
(* possible values of the idtype parameter (4 bytes),
see <sys/procset.h>
*)
idPid = 0; (* a process identifier *)
idPpid = 1; (* a parent process identifier *)
idPgid = 2; (* a process group (job control group) identifier *)
idSid = 3; (* a session identifier *)
idCid = 4; (* a scheduling class identifier *)
idUid = 5; (* a user identifier *)
idGid = 6; (* a group identifier *)
idAll = 7; (* all processes *)
idLwpid = 8; (* an LWP identifier *)
TYPE
IdType = INTEGER; (* idPid .. idLwpid *)
*)
END ulmSysTypes.

View file

@ -1,133 +0,0 @@
(* Ulm's Oberon Library
Copyright (C) 1989-2000 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: Types.om,v 1.5 2000/12/13 10:03:00 borchert Exp $
----------------------------------------------------------------------------
$Log: Types.om,v $
Revision 1.5 2000/12/13 10:03:00 borchert
SetInt type used in msb constant
Revision 1.4 2000/12/13 09:51:57 borchert
constants and types for the relationship of INTEGER and SET added
Revision 1.3 1998/09/25 15:23:09 borchert
Real32..Real128 added
Revision 1.2 1994/07/01 11:08:04 borchert
IntAddress, Int8/16/32, ToInt8/16/32 and bit/little endian stuff added
Revision 1.1 1994/02/22 20:12:14 borchert
Initial revision
----------------------------------------------------------------------------
AFB 9/93
----------------------------------------------------------------------------
*)
MODULE ulmTypes;
(* compiler-dependent type definitions;
this version works for Ulm's Oberon Compilers on
following architectures: m68k and sparc
*)
IMPORT SYS := SYSTEM;
TYPE
Address* = LONGINT (*SYS.ADDRESS*);
(* ulm compiler can accept
VAR p : SYSTEM.ADDRESS; // SYSTEM.PTR in ETH and V4 versions
...
p := SYSTEM.ADR(something);
and this is how it is used in ulm oberon system library,
while SYSTEM.ADR returns LONGINT in ETH and V4 versions.
Thus I leave it as LONGINT for now, before coming up with better solution -- noch *)
UntracedAddress* = POINTER[1] TO UntracedAddressDesc; (*SYS.UNTRACEDADDRESS;*)
UntracedAddressDesc* = RECORD[1] END;
Count* = LONGINT;
Size* = Count;
Byte* = SYS.BYTE;
IntAddress* = LONGINT;
Int8* = SHORTINT;
Int16* = INTEGER;
Int32* = LONGINT;
Real32* = REAL;
Real64* = LONGREAL;
CONST
bigEndian* = 0; (* SPARC, M68K etc *)
littleEndian* = 1; (* Intel 80x86, VAX etc *)
byteorder* = littleEndian; (* machine-dependent constant *)
TYPE
ByteOrder* = SHORTINT; (* bigEndian or littleEndian *)
(* following constants and type definitions try to make
conversions from INTEGER to SET and vice versa more portable
to allow for bit operations on INTEGER values
*)
TYPE
SetInt* = LONGINT; (* INTEGER type that corresponds to SET *)
VAR msb* : SET;
msbIsMax*, msbIs0*: SHORTINT;
msbindex*, lsbindex*, nofbits*: LONGINT;
PROCEDURE ToInt8*(int: LONGINT) : Int8;
BEGIN
RETURN SHORT(SHORT(int))
END ToInt8;
PROCEDURE ToInt16*(int: LONGINT) : Int16;
BEGIN
RETURN SYS.VAL(Int16, int)
END ToInt16;
PROCEDURE ToInt32*(int: LONGINT) : Int32;
BEGIN
RETURN int
END ToInt32;
PROCEDURE ToReal32*(real: LONGREAL) : Real32;
BEGIN
RETURN SHORT(real)
END ToReal32;
PROCEDURE ToReal64*(real: LONGREAL) : Real64;
BEGIN
RETURN real
END ToReal64;
BEGIN
msb := SYS.VAL(SET, MIN(SetInt));
(* most significant bit, converted to a SET *)
(* we expect msbIsMax XOR msbIs0 to be 1;
this is checked for by an assertion
*)
msbIsMax := SYS.VAL(SHORTINT, (msb = {MAX(SET)}));
(* is 1, if msb equals {MAX(SET)} *)
msbIs0 := SYS.VAL(SHORTINT, (msb = {0}));
(* is 0, if msb equals {0} *)
msbindex := msbIsMax * MAX(SET);
(* set element that corresponds to the most-significant-bit *)
lsbindex := MAX(SET) - msbindex;
(* set element that corresponds to the lowest-significant-bit *)
nofbits := MAX(SET) + 1;
(* number of elements in SETs *)
ASSERT((msbIs0 = 1) & (msbIsMax = 0) OR (msbIs0 = 0) & (msbIsMax = 1));
END ulmTypes.

View file

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

View file

@ -1,201 +0,0 @@
(* Ulm's Oberon Library
Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: SysStat.om,v 1.3 2000/11/12 13:02:09 borchert Exp $
----------------------------------------------------------------------------
$Log: SysStat.om,v $
Revision 1.3 2000/11/12 13:02:09 borchert
door file type added
Revision 1.2 2000/11/12 12:48:07 borchert
- conversion adapted to Solaris 2.x
- Lstat added
Revision 1.1 1994/02/23 08:00:48 borchert
Initial revision
----------------------------------------------------------------------------
AFB 9/89
----------------------------------------------------------------------------
*)
MODULE ulmSysStat;
(* examine inode: stat(2) and fstat(2) *)
IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, uSYS := ulmSYSTEM, SysConversions := ulmSysConversions, SysErrors := ulmSysErrors,
SysTypes := ulmSysTypes;
CONST
(* file mode:
bit 0 = 1<<0 bit 31 = 1<<31
user group other
3 1 1111 11
1 ... 6 5432 109 876 543 210
+--------+------+-----+-----+-----+-----+
| unused | type | sst | rwx | rwx | rwx |
+--------+------+-----+-----+-----+-----+
*)
type* = {12..15};
prot* = {0..8};
(* file types; example: (stat.mode * type = dir) *)
reg* = {15}; (* regular *)
dir* = {14}; (* directory *)
chr* = {13}; (* character special *)
fifo* = {12}; (* fifo *)
blk* = {13..14}; (* block special *)
symlink* = {13, 15}; (* symbolic link *)
socket* = {14, 15}; (* socket *)
(* special *)
setuid* = 11; (* set user id on execution *)
setgid* = 10; (* set group id on execution *)
savetext* = 9; (* save swapped text even after use *)
(* protection *)
uread* = 8; (* read permission owner *)
uwrite* = 7; (* write permission owner *)
uexec* = 6; (* execute/search permission owner *)
gread* = 5; (* read permission group *)
gwrite* = 4; (* write permission group *)
gexec* = 3; (* execute/search permission group *)
oread* = 2; (* read permission other *)
owrite* = 1; (* write permission other *)
oexec* = 0; (* execute/search permission other *)
(* example for "r-xr-x---": (read + exec) * (owner + group) *)
owner* = {uread, uwrite, uexec};
group* = {gread, gwrite, gexec};
other* = {oread, owrite, oexec};
read* = {uread, gread, oread};
write* = {uwrite, gwrite, owrite};
exec* = {uexec, gexec, oexec};
rwx* = prot;
TYPE
StatRec* = (* result of stat(2) and fstat(2) *)
RECORD
device*: SysTypes.Device; (* ID of device containing
a directory entry for this file *)
inode*: SysTypes.Inode; (* inode number *)
mode*: SET; (* file mode; see mknod(2) *)
nlinks*: LONGINT; (* number of links *)
uid*: LONGINT; (* user id of the file's owner *)
gid*: LONGINT; (* group id of the file's group *)
rdev*: SysTypes.Device; (* ID of device
this entry is defined only for
character special or block
special files
*)
size*: SysTypes.Offset; (* file size in bytes *)
blksize*: LONGINT; (* preferred blocksize *)
blocks*: LONGINT; (* # of blocks allocated *)
atime*: SysTypes.Time; (* time of last access *)
mtime*: SysTypes.Time; (* time of last data modification *)
ctime*: SysTypes.Time; (* time of last file status change *)
END;
(* Linux kernel struct stat (2.2.17)
struct stat {
unsigned short st_dev;
unsigned short __pad1;
unsigned long st_ino;
unsigned short st_mode;
unsigned short st_nlink;
unsigned short st_uid;
unsigned short st_gid;
unsigned short st_rdev;
unsigned short __pad2;
unsigned long st_size;
unsigned long st_blksize;
unsigned long st_blocks;
unsigned long st_atime;
unsigned long __unused1;
unsigned long st_mtime;
unsigned long __unused2;
unsigned long st_ctime;
unsigned long __unused3;
unsigned long __unused4;
unsigned long __unused5;
};
*)
CONST
statbufsize = 88(*64*); (* see <sys/stat.h> *) (* sizeof struct stat gives us 144 on x86_64 and 88 on x86 *)
TYPE
UnixStatRec = ARRAY statbufsize OF SYS.BYTE;
CONST
statbufconv =
(*"is=dev/-s=pad1/ll=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/ll=size/2*ll=blksize,blocks/il=atime/-l/il=mtime/-l/il=ctime/3*-l";*)
(*"ls=dev/-s=pad1/lL=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/lL=size/2*lL=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l";*)
"ll=dev/-l=devx/-s=pad1/ll=ino/Sl=mode/ll=nlink/ll=uid/ll=gid/ll=rdev/-l=rdevx/-s=pad2/ll=size/2*ll=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l";
VAR
statbuffmt: SysConversions.Format;
PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
d0, d1, d2: LONGINT;
origbuf: UnixStatRec;
BEGIN
IF uSYS.UNIXCALL(Sys.newstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf), d2) THEN
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
RETURN TRUE
ELSE
SysErrors.Raise(errors, d0, Sys.newstat, path);
RETURN FALSE
END;
END Stat;
(*
PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
d0, d1: INTEGER;
origbuf: UnixStatRec;
BEGIN
IF SYS.UNIXCALL(Sys.newlstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf)) THEN
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
RETURN TRUE
ELSE
SysErrors.Raise(errors, d0, Sys.newlstat, path);
RETURN FALSE
END;
END Lstat;
*)
PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
d0, d1, d2: LONGINT;
origbuf: UnixStatRec;
BEGIN
IF uSYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf), d2) THEN
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
RETURN TRUE
ELSE
SysErrors.Raise(errors, d0, Sys.newfstat, "");
RETURN FALSE
END;
END Fstat;
BEGIN
SysConversions.Compile(statbuffmt, statbufconv);
END ulmSysStat.

View file

@ -1,70 +0,0 @@
(* Ulm's Oberon Library
Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: SysTypes.om,v 1.1 1994/02/23 08:01:38 borchert Exp $
----------------------------------------------------------------------------
$Log: SysTypes.om,v $
Revision 1.1 1994/02/23 08:01:38 borchert
Initial revision
----------------------------------------------------------------------------
AFB 9/89
----------------------------------------------------------------------------
*)
MODULE ulmSysTypes;
IMPORT Types := ulmTypes;
TYPE
Address* = Types.Address;
UntracedAddress* = Types.UntracedAddress;
Count* = Types.Count;
Size* = Types.Size;
Byte* = Types.Byte;
File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *)
Offset* = LONGINT;
Device* = LONGINT;
Inode* = LONGINT;
Time* = LONGINT;
Word* = INTEGER; (* must have the size of C's int-type *)
(* Note: linux supports wait4 but not waitid, i.e. these
* constants aren't needed. *)
(*
CONST
(* possible values of the idtype parameter (4 bytes),
see <sys/procset.h>
*)
idPid = 0; (* a process identifier *)
idPpid = 1; (* a parent process identifier *)
idPgid = 2; (* a process group (job control group) identifier *)
idSid = 3; (* a session identifier *)
idCid = 4; (* a scheduling class identifier *)
idUid = 5; (* a user identifier *)
idGid = 6; (* a group identifier *)
idAll = 7; (* all processes *)
idLwpid = 8; (* an LWP identifier *)
TYPE
IdType = INTEGER; (* idPid .. idLwpid *)
*)
END ulmSysTypes.

View file

@ -1,133 +0,0 @@
(* Ulm's Oberon Library
Copyright (C) 1989-2000 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: Types.om,v 1.5 2000/12/13 10:03:00 borchert Exp $
----------------------------------------------------------------------------
$Log: Types.om,v $
Revision 1.5 2000/12/13 10:03:00 borchert
SetInt type used in msb constant
Revision 1.4 2000/12/13 09:51:57 borchert
constants and types for the relationship of INTEGER and SET added
Revision 1.3 1998/09/25 15:23:09 borchert
Real32..Real128 added
Revision 1.2 1994/07/01 11:08:04 borchert
IntAddress, Int8/16/32, ToInt8/16/32 and bit/little endian stuff added
Revision 1.1 1994/02/22 20:12:14 borchert
Initial revision
----------------------------------------------------------------------------
AFB 9/93
----------------------------------------------------------------------------
*)
MODULE ulmTypes;
(* compiler-dependent type definitions;
this version works for Ulm's Oberon Compilers on
following architectures: m68k and sparc
*)
IMPORT SYS := SYSTEM;
TYPE
Address* = LONGINT (*SYS.ADDRESS*);
(* ulm compiler can accept
VAR p : SYSTEM.ADDRESS; // SYSTEM.PTR in ETH and V4 versions
...
p := SYSTEM.ADR(something);
and this is how it is used in ulm oberon system library,
while SYSTEM.ADR returns LONGINT in ETH and V4 versions.
Thus I leave it as LONGINT for now, before coming up with better solution -- noch *)
UntracedAddress* = POINTER[1] TO UntracedAddressDesc; (*SYS.UNTRACEDADDRESS;*)
UntracedAddressDesc* = RECORD[1] END;
Count* = LONGINT;
Size* = Count;
Byte* = SYS.BYTE;
IntAddress* = LONGINT;
Int8* = SHORTINT;
Int16* = INTEGER;
Int32* = LONGINT;
Real32* = REAL;
Real64* = LONGREAL;
CONST
bigEndian* = 0; (* SPARC, M68K etc *)
littleEndian* = 1; (* Intel 80x86, VAX etc *)
byteorder* = littleEndian; (* machine-dependent constant *)
TYPE
ByteOrder* = SHORTINT; (* bigEndian or littleEndian *)
(* following constants and type definitions try to make
conversions from INTEGER to SET and vice versa more portable
to allow for bit operations on INTEGER values
*)
TYPE
SetInt* = LONGINT; (* INTEGER type that corresponds to SET *)
VAR msb* : SET;
msbIsMax*, msbIs0*: SHORTINT;
msbindex*, lsbindex*, nofbits*: LONGINT;
PROCEDURE ToInt8*(int: LONGINT) : Int8;
BEGIN
RETURN SHORT(SHORT(int))
END ToInt8;
PROCEDURE ToInt16*(int: LONGINT) : Int16;
BEGIN
RETURN SYS.VAL(Int16, int)
END ToInt16;
PROCEDURE ToInt32*(int: LONGINT) : Int32;
BEGIN
RETURN int
END ToInt32;
PROCEDURE ToReal32*(real: LONGREAL) : Real32;
BEGIN
RETURN SHORT(real)
END ToReal32;
PROCEDURE ToReal64*(real: LONGREAL) : Real64;
BEGIN
RETURN real
END ToReal64;
BEGIN
msb := SYS.VAL(SET, MIN(SetInt));
(* most significant bit, converted to a SET *)
(* we expect msbIsMax XOR msbIs0 to be 1;
this is checked for by an assertion
*)
msbIsMax := SYS.VAL(SHORTINT, (msb = {MAX(SET)}));
(* is 1, if msb equals {MAX(SET)} *)
msbIs0 := SYS.VAL(SHORTINT, (msb = {0}));
(* is 0, if msb equals {0} *)
msbindex := msbIsMax * MAX(SET);
(* set element that corresponds to the most-significant-bit *)
lsbindex := MAX(SET) - msbindex;
(* set element that corresponds to the lowest-significant-bit *)
nofbits := MAX(SET) + 1;
(* number of elements in SETs *)
ASSERT((msbIs0 = 1) & (msbIsMax = 0) OR (msbIs0 = 0) & (msbIsMax = 1));
END ulmTypes.

View file

@ -0,0 +1,137 @@
MODULE ulmSYSTEM;
IMPORT SYSTEM, Unix, Sys := ulmSys;
TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
pstring = POINTER TO ARRAY 1024 OF CHAR;
pstatus = POINTER TO Unix.Status;
TYPE bytearray* = ARRAY SIZE(LONGINT) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *)
pbytearray* = POINTER TO bytearray;
TYPE longrealarray* = ARRAY SIZE(LONGREAL) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *)
plongrealarray* = POINTER TO bytearray;
PROCEDURE LongToByteArr* ( l : LONGINT; VAR bar : bytearray); (* noch *)
VAR b : SYSTEM.BYTE;
p : pbytearray;
i : LONGINT;
BEGIN
p := SYSTEM.VAL(pbytearray, SYSTEM.ADR(l));
FOR i := 0 TO SIZE(LONGINT) -1 DO
b := p^[i]; bar[i] := b;
END
END LongToByteArr;
PROCEDURE LRealToByteArr* ( l : LONGREAL; VAR lar : longrealarray); (* noch *)
VAR b : SYSTEM.BYTE;
p : plongrealarray;
i : LONGINT;
BEGIN
p := SYSTEM.VAL(plongrealarray, SYSTEM.ADR(l));
FOR i := 0 TO SIZE(LONGREAL) -1 DO
b := p^[i]; lar[i] := b;
END
END LRealToByteArr;
(*
PROCEDURE -Write(adr, n: LONGINT): LONGINT
"write(1/*stdout*/, adr, n)";
PROCEDURE -read(VAR ch: CHAR): LONGINT
"read(0/*stdin*/, ch, 1)";
*)
PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *)
VAR oldflag : BOOLEAN;
BEGIN
oldflag := flag;
flag := TRUE;
RETURN oldflag;
END TAS;
PROCEDURE UNIXCALL*(syscall: LONGINT; VAR d0, d1: LONGINT; (* in ulm version both LONGINT and INTEGER are 4 byte size *)
arg1, arg2, arg3: LONGINT) : BOOLEAN;
VAR
n : LONGINT;
ch : CHAR;
pch : pchar;
pstr : pstring;
pst : pstatus;
BEGIN
IF syscall = Sys.read THEN
d0 := Unix.Read(arg1, arg2, arg3);
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
(*NEW(pch);
pch := SYSTEM.VAL(pchar, arg2);
ch := pch^[0];
n := read(ch);
IF n # 1 THEN
ch := 0X;
RETURN FALSE
ELSE
pch^[0] := ch;
RETURN TRUE
END;
*)
ELSIF syscall = Sys.write THEN
d0 := Unix.Write(arg1, arg2, arg3);
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
(*NEW(pch);
pch := SYSTEM.VAL(pchar, arg2);
n := Write(SYSTEM.VAL(LONGINT, pch), 1);
IF n # 1 THEN RETURN FALSE ELSE RETURN TRUE END
*)
ELSIF syscall = Sys.open THEN
pstr := SYSTEM.VAL(pstring, arg1);
d0 := Unix.Open(pstr^, SYSTEM.VAL(SET, arg3), SYSTEM.VAL(SET, arg2));
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
ELSIF syscall = Sys.close THEN
d0 := Unix.Close(arg1);
IF d0 = 0 THEN RETURN TRUE ELSE RETURN FALSE END
ELSIF syscall = Sys.lseek THEN
d0 := Unix.Lseek(arg1, arg2, arg3);
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
ELSIF syscall = Sys.ioctl THEN
d0 := Unix.Ioctl(arg1, arg2, arg3);
RETURN d0 >= 0;
ELSIF syscall = Sys.fcntl THEN
d0 := Unix.Fcntl (arg1, arg2, arg3);
RETURN d0 >= 0;
ELSIF syscall = Sys.dup THEN
d0 := Unix.Dup(arg1);
RETURN d0 > 0;
ELSIF syscall = Sys.pipe THEN
d0 := Unix.Pipe(arg1);
RETURN d0 >= 0;
ELSIF syscall = Sys.newstat THEN
pst := SYSTEM.VAL(pstatus, arg2);
pstr := SYSTEM.VAL(pstring, arg1);
d0 := Unix.Stat(pstr^, pst^);
RETURN d0 >= 0
ELSIF syscall = Sys.newfstat THEN
pst := SYSTEM.VAL(pstatus, arg2);
d0 := Unix.Fstat(arg1, pst^);
RETURN d0 >= 0;
END
END UNIXCALL;
PROCEDURE UNIXFORK(VAR pid: LONGINT) : BOOLEAN;
BEGIN
END UNIXFORK;
PROCEDURE UNIXSIGNAL(signo: INTEGER; p: PROCEDURE;
VAR old: PROCEDURE; VAR error: INTEGER) : BOOLEAN;
BEGIN
END UNIXSIGNAL;
PROCEDURE WMOVE*(from, to, n : LONGINT);
VAR l : LONGINT;
BEGIN
SYSTEM.MOVE(from, to, n);
END WMOVE;
END ulmSYSTEM.

View file

@ -0,0 +1,137 @@
MODULE ulmSYSTEM;
IMPORT SYSTEM, Unix, Sys := ulmSys;
TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
pstring = POINTER TO ARRAY 1024 OF CHAR;
pstatus = POINTER TO Unix.Status;
TYPE bytearray* = ARRAY SIZE(LONGINT) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *)
pbytearray* = POINTER TO bytearray;
TYPE longrealarray* = ARRAY SIZE(LONGREAL) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *)
plongrealarray* = POINTER TO bytearray;
PROCEDURE LongToByteArr* ( l : LONGINT; VAR bar : bytearray); (* noch *)
VAR b : SYSTEM.BYTE;
p : pbytearray;
i : LONGINT;
BEGIN
p := SYSTEM.VAL(pbytearray, SYSTEM.ADR(l));
FOR i := 0 TO SIZE(LONGINT) -1 DO
b := p^[i]; bar[i] := b;
END
END LongToByteArr;
PROCEDURE LRealToByteArr* ( l : LONGREAL; VAR lar : longrealarray); (* noch *)
VAR b : SYSTEM.BYTE;
p : plongrealarray;
i : LONGINT;
BEGIN
p := SYSTEM.VAL(plongrealarray, SYSTEM.ADR(l));
FOR i := 0 TO SIZE(LONGREAL) -1 DO
b := p^[i]; lar[i] := b;
END
END LRealToByteArr;
(*
PROCEDURE -Write(adr, n: LONGINT): LONGINT
"write(1/*stdout*/, adr, n)";
PROCEDURE -read(VAR ch: CHAR): LONGINT
"read(0/*stdin*/, ch, 1)";
*)
PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *)
VAR oldflag : BOOLEAN;
BEGIN
oldflag := flag;
flag := TRUE;
RETURN oldflag;
END TAS;
PROCEDURE UNIXCALL*(syscall: LONGINT; VAR d0, d1: LONGINT; (* in ulm version both LONGINT and INTEGER are 4 byte size *)
arg1, arg2, arg3: LONGINT) : BOOLEAN;
VAR
n : LONGINT;
ch : CHAR;
pch : pchar;
pstr : pstring;
pst : pstatus;
BEGIN
IF syscall = Sys.read THEN
d0 := Unix.Read(arg1, arg2, arg3);
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
(*NEW(pch);
pch := SYSTEM.VAL(pchar, arg2);
ch := pch^[0];
n := read(ch);
IF n # 1 THEN
ch := 0X;
RETURN FALSE
ELSE
pch^[0] := ch;
RETURN TRUE
END;
*)
ELSIF syscall = Sys.write THEN
d0 := Unix.Write(arg1, arg2, arg3);
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
(*NEW(pch);
pch := SYSTEM.VAL(pchar, arg2);
n := Write(SYSTEM.VAL(LONGINT, pch), 1);
IF n # 1 THEN RETURN FALSE ELSE RETURN TRUE END
*)
ELSIF syscall = Sys.open THEN
pstr := SYSTEM.VAL(pstring, arg1);
d0 := Unix.Open(pstr^, SYSTEM.VAL(SET, arg3), SYSTEM.VAL(SET, arg2));
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
ELSIF syscall = Sys.close THEN
d0 := Unix.Close(arg1);
IF d0 = 0 THEN RETURN TRUE ELSE RETURN FALSE END
ELSIF syscall = Sys.lseek THEN
d0 := Unix.Lseek(arg1, arg2, arg3);
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
ELSIF syscall = Sys.ioctl THEN
d0 := Unix.Ioctl(arg1, arg2, arg3);
RETURN d0 >= 0;
ELSIF syscall = Sys.fcntl THEN
d0 := Unix.Fcntl (arg1, arg2, arg3);
RETURN d0 >= 0;
ELSIF syscall = Sys.dup THEN
d0 := Unix.Dup(arg1);
RETURN d0 > 0;
ELSIF syscall = Sys.pipe THEN
d0 := Unix.Pipe(arg1);
RETURN d0 >= 0;
ELSIF syscall = Sys.newstat THEN
pst := SYSTEM.VAL(pstatus, arg2);
pstr := SYSTEM.VAL(pstring, arg1);
d0 := Unix.Stat(pstr^, pst^);
RETURN d0 >= 0
ELSIF syscall = Sys.newfstat THEN
pst := SYSTEM.VAL(pstatus, arg2);
d0 := Unix.Fstat(arg1, pst^);
RETURN d0 >= 0;
END
END UNIXCALL;
PROCEDURE UNIXFORK(VAR pid: LONGINT) : BOOLEAN;
BEGIN
END UNIXFORK;
PROCEDURE UNIXSIGNAL(signo: INTEGER; p: PROCEDURE;
VAR old: PROCEDURE; VAR error: INTEGER) : BOOLEAN;
BEGIN
END UNIXSIGNAL;
PROCEDURE WMOVE*(from, to, n : LONGINT);
VAR l : LONGINT;
BEGIN
SYSTEM.MOVE(from, to, n);
END WMOVE;
END ulmSYSTEM.

View file

@ -0,0 +1,137 @@
MODULE ulmSYSTEM;
IMPORT SYSTEM, Unix, Sys := ulmSys;
TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
pstring = POINTER TO ARRAY 1024 OF CHAR;
pstatus = POINTER TO Unix.Status;
TYPE bytearray* = ARRAY SIZE(LONGINT) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *)
pbytearray* = POINTER TO bytearray;
TYPE longrealarray* = ARRAY SIZE(LONGREAL) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *)
plongrealarray* = POINTER TO bytearray;
PROCEDURE LongToByteArr* ( l : LONGINT; VAR bar : bytearray); (* noch *)
VAR b : SYSTEM.BYTE;
p : pbytearray;
i : LONGINT;
BEGIN
p := SYSTEM.VAL(pbytearray, SYSTEM.ADR(l));
FOR i := 0 TO SIZE(LONGINT) -1 DO
b := p^[i]; bar[i] := b;
END
END LongToByteArr;
PROCEDURE LRealToByteArr* ( l : LONGREAL; VAR lar : longrealarray); (* noch *)
VAR b : SYSTEM.BYTE;
p : plongrealarray;
i : LONGINT;
BEGIN
p := SYSTEM.VAL(plongrealarray, SYSTEM.ADR(l));
FOR i := 0 TO SIZE(LONGREAL) -1 DO
b := p^[i]; lar[i] := b;
END
END LRealToByteArr;
(*
PROCEDURE -Write(adr, n: LONGINT): LONGINT
"write(1/*stdout*/, adr, n)";
PROCEDURE -read(VAR ch: CHAR): LONGINT
"read(0/*stdin*/, ch, 1)";
*)
PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *)
VAR oldflag : BOOLEAN;
BEGIN
oldflag := flag;
flag := TRUE;
RETURN oldflag;
END TAS;
PROCEDURE UNIXCALL*(syscall: LONGINT; VAR d0, d1: LONGINT; (* in ulm version both LONGINT and INTEGER are 4 byte size *)
arg1, arg2, arg3: LONGINT) : BOOLEAN;
VAR
n : LONGINT;
ch : CHAR;
pch : pchar;
pstr : pstring;
pst : pstatus;
BEGIN
IF syscall = Sys.read THEN
d0 := Unix.Read(SHORT(arg1), arg2, arg3);
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
(*NEW(pch);
pch := SYSTEM.VAL(pchar, arg2);
ch := pch^[0];
n := read(ch);
IF n # 1 THEN
ch := 0X;
RETURN FALSE
ELSE
pch^[0] := ch;
RETURN TRUE
END;
*)
ELSIF syscall = Sys.write THEN
d0 := Unix.Write(SHORT(arg1), arg2, arg3);
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
(*NEW(pch);
pch := SYSTEM.VAL(pchar, arg2);
n := Write(SYSTEM.VAL(LONGINT, pch), 1);
IF n # 1 THEN RETURN FALSE ELSE RETURN TRUE END
*)
ELSIF syscall = Sys.open THEN
pstr := SYSTEM.VAL(pstring, arg1);
d0 := Unix.Open(pstr^, SHORT(arg3), arg2);
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
ELSIF syscall = Sys.close THEN
d0 := Unix.Close(SHORT(arg1));
IF d0 = 0 THEN RETURN TRUE ELSE RETURN FALSE END
ELSIF syscall = Sys.lseek THEN
d0 := Unix.Lseek(SHORT(arg1), arg2, SHORT(arg3));
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
ELSIF syscall = Sys.ioctl THEN
d0 := Unix.Ioctl(SHORT(arg1), SHORT(arg2), arg3);
RETURN d0 >= 0;
ELSIF syscall = Sys.fcntl THEN
d0 := Unix.Fcntl (SHORT(arg1), SHORT(arg2), arg3);
RETURN d0 >= 0;
ELSIF syscall = Sys.dup THEN
d0 := Unix.Dup(SHORT(arg1));
RETURN d0 > 0;
ELSIF syscall = Sys.pipe THEN
d0 := Unix.Pipe(arg1);
RETURN d0 >= 0;
ELSIF syscall = Sys.newstat THEN
pst := SYSTEM.VAL(pstatus, arg2);
pstr := SYSTEM.VAL(pstring, arg1);
d0 := Unix.Stat(pstr^, pst^);
RETURN d0 >= 0
ELSIF syscall = Sys.newfstat THEN
pst := SYSTEM.VAL(pstatus, arg2);
d0 := Unix.Fstat(SHORT(arg1), pst^);
RETURN d0 >= 0;
END
END UNIXCALL;
PROCEDURE UNIXFORK(VAR pid: LONGINT) : BOOLEAN;
BEGIN
END UNIXFORK;
PROCEDURE UNIXSIGNAL(signo: INTEGER; p: PROCEDURE;
VAR old: PROCEDURE; VAR error: INTEGER) : BOOLEAN;
BEGIN
END UNIXSIGNAL;
PROCEDURE WMOVE*(from, to, n : LONGINT);
VAR l : LONGINT;
BEGIN
SYSTEM.MOVE(from, to, n);
END WMOVE;
END ulmSYSTEM.

View file

@ -3,7 +3,7 @@ MODULE testFiles;
IMPORT Files, Texts, Console;
CONST file="makefile";
CONST file="testFiles.Mod";
VAR
T : Texts.Text;
@ -22,7 +22,6 @@ IF F # NIL THEN
WHILE ~R.eot DO
Texts.Read (R, ch);
Console.Char(ch);
END;
ELSE

BIN
voc

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.