vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 16:52:25 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Update system source to V2.

Browse source
This commit is contained in:
David Brown 2016-06-16 14:14:39 +01:00
parent efb7b6b030
commit 4245c6e8b3
10 changed files with 2150 additions and 1482 deletions
Download patch file Download diff file Expand all files Collapse all files

914
src/system/Platformunix.Mod
View file

@ -1,519 +1,551 @@
MODULE Unix; (* Josef Templ, 5.3.90 Linux system calls *)
(* ported to gnu x86_64 and added system(), sleep() functions, noch *)
(* Module Unix provides a system call interface to Linux.
Naming conventions:
Procedure and Type-names always start with a capital letter.
error numbers as defined in Unix
other constants start with lower case letters *)
MODULE Platform;
IMPORT SYSTEM;
CONST
(* various important constants *)
stdin* = 0; stdout* =1; stderr* = 2;
LOCKEX* = 2; LOCKUN* = 8; (* /usr/include/file.h *)
AFINET* = 2; (* /usr/include/sys/socket.h *)
PFINET* = AFINET; (* /usr/include/linux/socket.h *)
SOCKSTREAM* = 1; (* /usr/include/linux/socket.h *)
FIONREAD* = 541BH; (* in /usr/include/asm/termios.h *)
SETFL* = 4; (* set file descriptor flags; in asm/fcntl.h *)
TCP* = 0;
(* flag sets, cf. /usr/include/asm/fcntl.h *)
rdonly* = {}; wronly* = {0}; rdwr* = {1}; creat* = {6}; excl* = {7}; trunc* = {9}; append* = {10}; ndelay = {11};
(* error numbers *)
EPERM* = 1; (* Not owner *)
ENOENT* = 2; (* No such file or directory *)
ESRCH* = 3; (* No such process *)
EINTR* = 4; (* Interrupted system call *)
EIO* = 5; (* I/O error *)
ENXIO* = 6; (* No such device or address *)
E2BIG* = 7; (* Arg list too long *)
ENOEXEC* = 8; (* Exec format error *)
EBADF* = 9; (* Bad file number *)
ECHILD* = 10; (* No children *)
EAGAIN* = 11; (* No more processes *)
ENOMEM* = 12; (* Not enough core *)
EACCES* = 13; (* Permission denied *)
EFAULT* = 14; (* Bad address *)
ENOTBLK* = 15; (* Block device required *)
EBUSY* = 16; (* Mount device busy *)
EEXIST* = 17; (* File exists *)
EXDEV* = 18; (* Cross-device link *)
ENODEV* = 19; (* No such device *)
ENOTDIR* = 20; (* Not a directory*)
EISDIR* = 21; (* Is a directory *)
EINVAL* = 22; (* Invalid argument *)
ENFILE* = 23; (* File table overflow *)
EMFILE* = 24; (* Too many open files *)
ENOTTY* = 25; (* Not a typewriter *)
ETXTBSY* = 26; (* Text file busy *)
EFBIG* = 27; (* File too large *)
ENOSPC* = 28; (* No space left on device *)
ESPIPE* = 29; (* Illegal seek *)
EROFS* = 30; (* Read-only file system *)
EMLINK* = 31; (* Too many links *)
EPIPE* = 32; (* Broken pipe *)
EDOM* = 33; (* Argument too large *)
ERANGE* = 34; (* Result too large *)
EDEADLK* = 35; (* Resource deadlock would occur *)
ENAMETOOLONG* = 36; (* File name too long *)
ENOLCK* = 37; (* No record locks available *)
ENOSYS* = 38; (* Function not implemented *)
ENOTEMPTY* = 39; (* Directory not empty *)
ELOOP* = 40; (* Too many symbolic links encountered *)
EWOULDBLOCK* = EAGAIN; (* Operation would block *)
ENOMSG* = 42; (* No message of desired type *)
EIDRM* = 43; (* Identifier removed *)
ECHRNG* = 44; (* Channel number out of range *)
EL2NSYNC* = 45; (* Level 2 not synchronized *)
EL3HLT* = 46; (* Level 3 halted *)
EL3RST* = 47; (* Level 3 reset *)
ELNRNG* = 48; (* Link number out of range *)
EUNATCH* = 49; (* Protocol driver not attached *)
ENOCSI* = 50; (* No CSI structure available *)
EL2HLT* = 51; (* Level 2 halted *)
EBADE* = 52; (* Invalid exchange *)
EBADR* = 53; (* Invalid request descriptor *)
EXFULL* = 54; (* Exchange full *)
ENOANO* = 55; (* No anode *)
EBADRQC* = 56; (* Invalid request code *)
EBADSLT* = 57; (* Invalid slot *)
EDEADLOCK* = 58; (* File locking deadlock error *)
EBFONT* = 59; (* Bad font file format *)
ENOSTR* = 60; (* Device not a stream *)
ENODATA* = 61; (* No data available *)
ETIME* = 62; (* Timer expired *)
ENOSR* = 63; (* Out of streams resources *)
ENONET* = 64; (* Machine is not on the network *)
ENOPKG* = 65; (* Package not installed *)
EREMOTE* = 66; (* Object is remote *)
ENOLINK* = 67; (* Link has been severed *)
EADV* = 68; (* Advertise error *)
ESRMNT* = 69; (* Srmount error *)
ECOMM* = 70; (* Communication error on send *)
EPROTO* = 71; (* Protocol error *)
EMULTIHOP* = 72; (* Multihop attempted *)
EDOTDOT* = 73; (* RFS specific error *)
EBADMSG* = 74; (* Not a data message *)
EOVERFLOW* = 75; (* Value too large for defined data type *)
ENOTUNIQ* = 76; (* Name not unique on network *)
EBADFD* = 77; (* File descriptor in bad state *)
EREMCHG* = 78; (* Remote address changed *)
ELIBACC* = 79; (* Can not access a needed shared library *)
ELIBBAD* = 80; (* Accessing a corrupted shared library *)
ELIBSCN* = 81; (* .lib section in a.out corrupted *)
ELIBMAX* = 82; (* Attempting to link in too many shared libraries *)
ELIBEXEC* = 83; (* Cannot exec a shared library directly *)
EILSEQ* = 84; (* Illegal byte sequence *)
ERESTART* = 85; (* Interrupted system call should be restarted *)
ESTRPIPE* = 86; (* Streams pipe error *)
EUSERS* = 87; (* Too many users *)
ENOTSOCK* = 88; (* Socket operation on non-socket *)
EDESTADDRREQ* = 89; (* Destination address required *)
EMSGSIZE* = 90; (* Message too long *)
EPROTOTYPE* = 91; (* Protocol wrong type for socket *)
ENOPROTOOPT* = 92; (* Protocol not available *)
EPROTONOSUPPORT* = 93; (* Protocol not supported *)
ESOCKTNOSUPPORT* = 94; (* Socket type not supported *)
EOPNOTSUPP* = 95; (* Operation not supported on transport endpoint *)
EPFNOSUPPORT* = 96; (* Protocol family not supported *)
EAFNOSUPPORT* = 97; (* Address family not supported by protocol *)
EADDRINUSE* = 98; (* Address already in use *)
EADDRNOTAVAIL* = 99; (* Cannot assign requested address *)
ENETDOWN* = 100; (* Network is down *)
ENETUNREACH* = 101; (* Network is unreachable *)
ENETRESET* = 102; (* Network dropped connection because of reset *)
ECONNABORTED* = 103; (* Software caused connection abort *)
ECONNRESET* = 104; (* Connection reset by peer *)
ENOBUFS* = 105; (* No buffer space available *)
EISCONN* = 106; (* Transport endpoint is already connected *)
ENOTCONN* = 107; (* Transport endpoint is not connected *)
ESHUTDOWN* = 108; (* Cannot send after transport endpoint shutdown *)
ETOOMANYREFS* = 109; (* Too many references: cannot splice *)
ETIMEDOUT* = 110; (* Connection timed out *)
ECONNREFUSED* = 111; (* Connection refused *)
EHOSTDOWN* = 112; (* Host is down *)
EHOSTUNREACH* = 113; (* No route to host *)
EALREADY* = 114; (* Operation already in progress *)
EINPROGRESS* = 115; (* Operation now in progress *)
ESTALE* = 116; (* Stale NFS file handle *)
EUCLEAN* = 117; (* Structure needs cleaning *)
ENOTNAM* = 118; (* Not a XENIX named type file *)
ENAVAIL* = 119; (* No XENIX semaphores available *)
EISNAM* = 120; (* Is a named type file *)
EREMOTEIO* = 121; (* Remote I/O error *)
EDQUOT* = 122; (* Quota exceeded *)
CONST sigsetarrlength = 1024 / 8 * SIZE(LONGINT);
StdIn- = 0;
StdOut- = 1;
StdErr- = 2;
TYPE
(* cpp /usr/include/setjmp.h
struct __jmp_buf_tag
{
__jmp_buf __jmpbuf;
int __mask_was_saved;
__sigset_t __saved_mask;
};
HaltProcedure = PROCEDURE(n: LONGINT);
SignalHandler = PROCEDURE(signal: INTEGER);
typedef struct __jmp_buf_tag jmp_buf[1];
ErrorCode* = INTEGER;
FileHandle* = LONGINT;
__sigset_t is 128 byte long in glibc on arm, x86, x86_64
__jmp_buf is 24 bytes long in glibc on x86
256 bytes long in glibc on armv6
64 bytes long in glibc on x86_64
*)
JmpBuf* = RECORD
jmpbuf: ARRAY 8 OF LONGINT; (* 8 * 8 = 64 *)
maskWasSaved*: INTEGER;
savedMask*: ARRAY 16 OF LONGINT; (* 16 * 8 = 128 *)
END ;
Status* = RECORD (* struct stat *)
dev* : LONGINT; (* dev_t 8 *)
ino* : LONGINT; (* ino 8 *)
nlink* : LONGINT;
mode* : INTEGER;
uid*, gid*: INTEGER;
pad0* : INTEGER;
rdev* : LONGINT;
size* : LONGINT;
blksize* : LONGINT;
blocks* : LONGINT;
atime* : LONGINT;
atimences* : LONGINT;
mtime* : LONGINT;
mtimensec* : LONGINT;
ctime* : LONGINT;
ctimensec* : LONGINT;
unused0*, unused1*, unused2*: LONGINT;
END ;
(* from /usr/include/bits/time.h
struct timeval
{
__time_t tv_sec; /* Seconds. */ //__time_t 8
__suseconds_t tv_usec; /* Microseconds. */ __suseconds_t 8
};
*)
Timeval* = RECORD
sec*, usec*: LONGINT
END ;
(*
from man gettimeofday
struct timezone {
int tz_minuteswest; /* minutes west of Greenwich */ int 4
int tz_dsttime; /* type of DST correction */ int 4
};
*)
Timezone* = RECORD
(*minuteswest*, dsttime*: LONGINT*)
minuteswest*, dsttime*: INTEGER
END ;
Itimerval* = RECORD
interval*, value*: Timeval
END ;
FdSet* = ARRAY 8 OF SET;
SigCtxPtr* = POINTER TO SigContext;
SigContext* = RECORD
END ;
SignalHandler* = PROCEDURE (sig, code: LONGINT; scp: SigCtxPtr);
Dirent* = RECORD
ino, off: LONGINT;
reclen: INTEGER;
name: ARRAY 256 OF CHAR;
END ;
Rusage* = RECORD
utime*, stime*: Timeval;
maxrss*, ixrss*, idrss*, isrss*,
minflt*, majflt*, nswap*, inblock*,
oublock*, msgsnd*, msgrcv*, nsignals*,
nvcsw*, nivcsw*: LONGINT
END ;
Iovec* = RECORD
base*, len*: LONGINT
END ;
SocketPair* = ARRAY 2 OF LONGINT;
Pollfd* = RECORD
fd*: LONGINT;
events*, revents*: INTEGER
END ;
Sockaddr* = RECORD
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*: INTEGER;
addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*)
FileIdentity* = RECORD
volume*: LONGINT; (* dev on Unix filesystems, volume serial number on NTFS *)
index*: LONGINT; (* inode on Unix filesystems, file id on NTFS *)
mtime*: LONGINT; (* File modification time, value is system dependent *)
END;
Name* = ARRAY OF CHAR;
EnvPtr = POINTER TO ARRAY 1024 OF CHAR;
ArgPtr = POINTER TO ARRAY 1024 OF CHAR;
ArgVec = POINTER TO ARRAY 1024 OF ArgPtr;
ArgVecPtr = POINTER TO ARRAY 1 OF LONGINT;
PROCEDURE -includeStat()
"#include <sys/stat.h>";
PROCEDURE -includeErrno()
"#include <errno.h>";
VAR
LittleEndian-: BOOLEAN;
MainStackFrame-: LONGINT;
HaltCode-: LONGINT;
PID-: INTEGER; (* Note: Must be updated by Fork implementation *)
CWD-: ARRAY 256 OF CHAR;
ArgCount-: INTEGER;
(* for read(), write() and sleep() *)
PROCEDURE -includeUnistd()
"#include <unistd.h>";
ArgVector-: LONGINT;
HaltHandler: HaltProcedure;
TimeStart: LONGINT;
(* for system() *)
PROCEDURE -includeStdlib()
"#include <stdlib.h>";
SeekSet-: INTEGER;
SeekCur-: INTEGER;
SeekEnd-: INTEGER;
(* for nanosleep() *)
PROCEDURE -includeTime()
"#include <time.h>";
nl-: ARRAY 3 OF CHAR; (* Platform specific newline representation *)
(* for select() *)
PROCEDURE -includeSelect()
"#include <sys/select.h>";
PROCEDURE -err(): INTEGER
"errno";
PROCEDURE errno*(): INTEGER;
BEGIN
RETURN err()
END errno;
(* Unix headers to be included *)
PROCEDURE -Exit*(n: INTEGER)
"exit(n)";
PROCEDURE -Aincludesystime '#include <sys/time.h>'; (* for gettimeofday *)
PROCEDURE -Aincludetime '#include <time.h>'; (* for localtime *)
PROCEDURE -Aincludesystypes '#include <sys/types.h>';
PROCEDURE -Aincludeunistd '#include <unistd.h>';
PROCEDURE -Aincludesysstat '#include <sys/stat.h>';
PROCEDURE -Aincludefcntl '#include <fcntl.h>';
PROCEDURE -Aincludeerrno '#include <errno.h>';
PROCEDURE -Astdlib '#include <stdlib.h>';
PROCEDURE -Astdio '#include <stdio.h>';
PROCEDURE -Aerrno '#include <errno.h>';
PROCEDURE -Fork*(): INTEGER
"fork()";
PROCEDURE -Wait*(VAR status: INTEGER): INTEGER
"wait(status)";
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) : INTEGER
"gettimeofday(tv, tz)";
(* Error code tests *)
PROCEDURE -Read* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT
"read(fd, buf, nbyte)";
PROCEDURE -EMFILE(): ErrorCode 'EMFILE';
PROCEDURE -ENFILE(): ErrorCode 'ENFILE';
PROCEDURE -ENOENT(): ErrorCode 'ENOENT';
PROCEDURE -EXDEV(): ErrorCode 'EXDEV';
PROCEDURE -EACCES(): ErrorCode 'EACCES';
PROCEDURE -EROFS(): ErrorCode 'EROFS';
PROCEDURE -EAGAIN(): ErrorCode 'EAGAIN';
PROCEDURE -ETIMEDOUT(): ErrorCode 'ETIMEDOUT';
PROCEDURE -ECONNREFUSED(): ErrorCode 'ECONNREFUSED';
PROCEDURE -ECONNABORTED(): ErrorCode 'ECONNABORTED';
PROCEDURE -ENETUNREACH(): ErrorCode 'ENETUNREACH';
PROCEDURE -EHOSTUNREACH(): ErrorCode 'EHOSTUNREACH';
PROCEDURE -ReadBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT
"read(fd, buf, buf__len)";
PROCEDURE -Write* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT
"write(fd, buf, nbyte)";
PROCEDURE -WriteBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT
"write(fd, buf, buf__len)";
PROCEDURE -Dup*(fd: INTEGER): INTEGER
"dup(fd)";
PROCEDURE TooManyFiles*(e: ErrorCode): BOOLEAN;
BEGIN RETURN (e = EMFILE()) OR (e = ENFILE()) END TooManyFiles;
PROCEDURE -Dup2*(fd1, fd2: INTEGER): INTEGER
"dup(fd1, fd2)";
PROCEDURE NoSuchDirectory*(e: ErrorCode): BOOLEAN;
BEGIN RETURN e = ENOENT() END NoSuchDirectory;
PROCEDURE -Pipe*(fds : LONGINT): INTEGER
"pipe(fds)";
PROCEDURE DifferentFilesystems*(e: ErrorCode): BOOLEAN;
BEGIN RETURN e = EXDEV() END DifferentFilesystems;
PROCEDURE -Getpid*(): INTEGER
"getpid()";
PROCEDURE Inaccessible*(e: ErrorCode): BOOLEAN;
BEGIN RETURN (e = EACCES()) OR (e = EROFS()) OR (e = EAGAIN()) END Inaccessible;
PROCEDURE -Getuid*(): INTEGER
"getuid()";
PROCEDURE Absent*(e: ErrorCode): BOOLEAN;
BEGIN RETURN (e = ENOENT()) END Absent;
PROCEDURE -Geteuid*(): INTEGER
"geteuid()";
PROCEDURE TimedOut*(e: ErrorCode): BOOLEAN;
BEGIN RETURN (e = ETIMEDOUT()) END TimedOut;
PROCEDURE -Getgid*(): INTEGER
"getgid()";
PROCEDURE ConnectionFailed*(e: ErrorCode): BOOLEAN;
BEGIN RETURN (e = ECONNREFUSED()) OR (e = ECONNABORTED())
OR (e = ENETUNREACH()) OR (e = EHOSTUNREACH()) END ConnectionFailed;
PROCEDURE -Getegid*(): INTEGER
"getegid()";
PROCEDURE -Unlink*(name: Name): INTEGER
"unlink(name)";
PROCEDURE -Open*(name: Name; flag: INTEGER; mode: LONGINT): INTEGER
"open(name, flag, mode)";
PROCEDURE -Close*(fd: INTEGER): INTEGER
"close(fd)";
(* OS memory allocaton *)
PROCEDURE -stat(name: Name; VAR statbuf: Status): INTEGER
"stat((const char*)name, (struct stat*)statbuf)";
PROCEDURE -allocate(size: LONGINT): LONGINT "(LONGINT)(uintptr_t)((void*)malloc((size_t)size))";
PROCEDURE OSAllocate*(size: LONGINT): LONGINT; BEGIN RETURN allocate(size) END OSAllocate;
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!) *)
(* don't understand this
INC(statbuf.dev, statbuf.devX);
INC(statbuf.rdev, statbuf.rdevX); *)
RETURN res;
END Stat;
PROCEDURE -free(address: LONGINT) "free((void*)(uintptr_t)address)";
PROCEDURE OSFree*(address: LONGINT); BEGIN free(address) END OSFree;
PROCEDURE -fstat(fd: INTEGER; VAR statbuf: Status): INTEGER
"fstat(fd, (struct stat*)statbuf)";
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!) *)
(*INC(statbuf.dev, statbuf.devX);
INC(statbuf.rdev, statbuf.rdevX); *)
RETURN res;
END Fstat;
PROCEDURE -Fchmod*(fd, mode: INTEGER): INTEGER
"fchmod(fd, mode)";
PROCEDURE -Chmod*(path: Name; mode: INTEGER): INTEGER
"chmod(path, mode)";
(* Program startup *)
PROCEDURE -Lseek*(fd: INTEGER; offset: LONGINT; origin: INTEGER): LONGINT
"lseek(fd, offset, origin)";
PROCEDURE -ExternInitHeap "extern void Heap_InitHeap();";
PROCEDURE -HeapInitHeap() "Heap_InitHeap()";
PROCEDURE -Fsync*(fd: INTEGER): INTEGER
"fsync(fd)";
PROCEDURE Init*(argc: INTEGER; argvadr: LONGINT);
VAR av: ArgVecPtr;
BEGIN
MainStackFrame := argvadr;
ArgCount := argc;
av := SYSTEM.VAL(ArgVecPtr, argvadr);
ArgVector := av[0];
HaltCode := -128;
PROCEDURE -Fcntl*(fd: INTEGER; cmd: INTEGER; arg: LONGINT ): INTEGER
"fcntl(fd, cmd, arg)";
(* This function (Platform.Init) is called at program startup BEFORE any
modules have been initalised. In turn we must initialise the heap
before module startup (xxx__init) code is run. *)
HeapInitHeap();
END Init;
PROCEDURE -Flock*(fd, operation: INTEGER): INTEGER
"flock(fd, operation)";
PROCEDURE -Ftruncate*(fd: INTEGER; length: LONGINT): INTEGER
"ftruncate(fd, length)";
PROCEDURE -Readblk*(fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT
"read(fd, buf, len)";
PROCEDURE -Rename*(old, new: Name): INTEGER
"rename(old, new)";
(* Program arguments and environment access *)
PROCEDURE -Chdir*(path: Name): INTEGER
"chdir(path)";
PROCEDURE -getenv(var: ARRAY OF CHAR): EnvPtr "(Platform_EnvPtr)getenv((char*)var)";
PROCEDURE -Ioctl*(fd: INTEGER; request, arg: LONGINT): INTEGER
"ioctl(fd, request, arg)";
PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN;
VAR p: EnvPtr;
BEGIN
p := getenv(var);
IF p # NIL THEN COPY(p^, val) END;
RETURN p # NIL;
END getEnv;
PROCEDURE -Kill*(pid, sig: INTEGER): INTEGER
"kill(pid, sig)";
PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR);
BEGIN
IF ~ getEnv(var, val) THEN val[0] := 0X END;
END GetEnv;
PROCEDURE -Sigsetmask*(mask: INTEGER): INTEGER
"sigsetmask(mask)";
PROCEDURE GetArg*(n: INTEGER; VAR val: ARRAY OF CHAR);
VAR av: ArgVec;
BEGIN
IF n < ArgCount THEN
av := SYSTEM.VAL(ArgVec,ArgVector);
COPY(av[n]^, val)
END
END GetArg;
PROCEDURE -Sleep*(ms : INTEGER): INTEGER
"(INTEGER)sleep(ms)";
PROCEDURE GetIntArg*(n: INTEGER; VAR val: LONGINT);
VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT;
BEGIN
s := ""; GetArg(n, s); i := 0;
IF s[0] = "-" THEN i := 1 END ;
k := 0; d := ORD(s[i]) - ORD("0");
WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ;
IF s[0] = "-" THEN k := -k; DEC(i) END ;
IF i > 0 THEN val := k END
END GetIntArg;
PROCEDURE -Nanosleep*(VAR req : Timeval; VAR rem : Timeval): INTEGER
"(INTEGER)nanosleep(req, rem)";
PROCEDURE ArgPos*(s: ARRAY OF CHAR): INTEGER;
VAR i: INTEGER; arg: ARRAY 256 OF CHAR;
BEGIN
i := 0; GetArg(i, arg);
WHILE (i < ArgCount) & (s # arg) DO INC(i); GetArg(i, arg) END ;
RETURN i
END ArgPos;
(* TCP/IP networking *)
PROCEDURE -Gethostbyname*(name: Name): HostEntry
"(Unix_HostEntry)gethostbyname(name)";
PROCEDURE -Gethostname*(VAR name: Name): INTEGER
"gethostname(name, name__len)";
PROCEDURE -Socket*(af, type, protocol: INTEGER): INTEGER
"socket(af, type, protocol)";
PROCEDURE -Connect*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER
"connect(socket, &(name), namelen)";
(* Signals and traps *)
PROCEDURE -Getsockname*(socket: INTEGER; VAR name: Sockaddr; VAR namelen: INTEGER): INTEGER
"getsockname(socket, name, namelen)";
PROCEDURE -sethandler(s: INTEGER; h: SignalHandler) "SystemSetHandler(s, (uintptr_t)h)";
PROCEDURE -Bind*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER
"bind(socket, &(name), namelen)";
PROCEDURE SetInterruptHandler*(handler: SignalHandler);
BEGIN sethandler(2, handler); END SetInterruptHandler;
PROCEDURE -Listen*(socket, backlog: INTEGER): INTEGER
"listen(socket, backlog)";
PROCEDURE SetQuitHandler*(handler: SignalHandler);
BEGIN sethandler(3, handler); END SetQuitHandler;
PROCEDURE -Accept*(socket: INTEGER; VAR addr: Sockaddr; VAR addrlen: INTEGER): LONGINT
"accept(socket, addr, addrlen)";
PROCEDURE SetBadInstructionHandler*(handler: SignalHandler);
BEGIN sethandler(4, handler); END SetBadInstructionHandler;
PROCEDURE -Recv*(socket: INTEGER; bufadr, buflen: LONGINT; flags: INTEGER): LONGINT
"recv(socket, bufadr, buflen, flags)";
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 *)
"system(str)";
PROCEDURE system*(cmd : ARRAY OF CHAR);
VAR r : INTEGER;
BEGIN
r := sys(cmd);
END system;
(* Time of day *)
PROCEDURE System*(cmd : ARRAY OF CHAR): INTEGER;
VAR r : INTEGER;
BEGIN
r := sys(cmd);
RETURN r
END System;
PROCEDURE -gettimeval "struct timeval tv; gettimeofday(&tv,0)";
PROCEDURE -tvsec(): LONGINT "tv.tv_sec";
PROCEDURE -tvusec(): LONGINT "tv.tv_usec";
PROCEDURE -sectotm(s: LONGINT) "struct tm *time = localtime((time_t*)&s)";
PROCEDURE -tmsec(): LONGINT "(LONGINT)time->tm_sec";
PROCEDURE -tmmin(): LONGINT "(LONGINT)time->tm_min";
PROCEDURE -tmhour(): LONGINT "(LONGINT)time->tm_hour";
PROCEDURE -tmmday(): LONGINT "(LONGINT)time->tm_mday";
PROCEDURE -tmmon(): LONGINT "(LONGINT)time->tm_mon";
PROCEDURE -tmyear(): LONGINT "(LONGINT)time->tm_year";
PROCEDURE -SizeofUnixStat(): INTEGER
"sizeof(Unix_Status)";
PROCEDURE YMDHMStoClock(ye,mo,da,ho,mi,se: LONGINT; VAR t, d: LONGINT);
BEGIN
d := ASH(ye MOD 100, 9) + ASH(mo+1, 5) + da;
t := ASH(ho, 12) + ASH(mi, 6) + se;
END YMDHMStoClock;
PROCEDURE -SizeofStat(): INTEGER
"sizeof(struct stat)";
PROCEDURE GetClock*(VAR t, d: LONGINT);
BEGIN
gettimeval; sectotm(tvsec());
YMDHMStoClock(tmyear(), tmmon(), tmmday(), tmhour(), tmmin(), tmsec(), t, d);
END GetClock;
PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER)
"write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)";
PROCEDURE GetTimeOfDay*(VAR sec, usec: LONGINT);
BEGIN
gettimeval; sec := tvsec(); usec := tvusec();
END GetTimeOfDay;
PROCEDURE StatCheck;
VAR x, y: LONGINT;
BEGIN
x := SizeofUnixStat();
y := SizeofStat();
IF x # y THEN
Error("Unix.StatCheck: inconsistent usage of struct stat", 49);
Exit(1);
END
END StatCheck;
PROCEDURE Time*(): LONGINT;
VAR ms: LONGINT;
BEGIN
gettimeval;
ms := (tvusec() DIV 1000) + (tvsec() * 1000);
RETURN (ms - TimeStart) MOD 7FFFFFFFH;
END Time;
PROCEDURE -nanosleep(s: LONGINT; ns: LONGINT) "struct timespec req, rem; req.tv_sec = s; req.tv_nsec = ns; nanosleep(&req, &rem)";
PROCEDURE Delay*(ms: LONGINT);
VAR s, ns: LONGINT;
BEGIN
s := ms DIV 1000;
ns := (ms MOD 1000) * 1000000;
nanosleep(s, ns);
END Delay;
(* System call *)
PROCEDURE -system(str: ARRAY OF CHAR): INTEGER "system((char*)str)";
PROCEDURE -err(): INTEGER "errno";
PROCEDURE System*(cmd : ARRAY OF CHAR): INTEGER;
BEGIN RETURN system(cmd); END System;
PROCEDURE Error*(): ErrorCode; BEGIN RETURN err() END Error;
(* File system *)
(* Note: Consider also using flags O_SYNC and O_DIRECT as we do buffering *)
PROCEDURE -openrw (n: ARRAY OF CHAR): INTEGER "open((char*)n, O_RDWR)";
PROCEDURE -openro (n: ARRAY OF CHAR): INTEGER "open((char*)n, O_RDONLY)";
PROCEDURE -opennew(n: ARRAY OF CHAR): INTEGER "open((char*)n, O_CREAT | O_TRUNC | O_RDWR, 0664)";
(* File APIs *)
PROCEDURE OldRO*(VAR n: ARRAY OF CHAR; VAR h: FileHandle): ErrorCode;
VAR fd: INTEGER;
BEGIN
fd := openro(n);
IF (fd < 0) THEN RETURN err() ELSE h := fd; RETURN 0 END;
END OldRO;
PROCEDURE OldRW*(VAR n: ARRAY OF CHAR; VAR h: FileHandle): ErrorCode;
VAR fd: INTEGER;
BEGIN
fd := openrw(n);
IF (fd < 0) THEN RETURN err() ELSE h := fd; RETURN 0 END;
END OldRW;
PROCEDURE New*(VAR n: ARRAY OF CHAR; VAR h: FileHandle): ErrorCode;
VAR fd: INTEGER;
BEGIN
fd := opennew(n);
IF (fd < 0) THEN RETURN err() ELSE h := fd; RETURN 0 END;
END New;
PROCEDURE -closefile (fd: LONGINT): INTEGER "close(fd)";
PROCEDURE Close*(h: FileHandle): ErrorCode;
BEGIN
IF closefile(h) < 0 THEN RETURN err() ELSE RETURN 0 END
END Close;
PROCEDURE -fstat(fd: LONGINT): INTEGER "fstat(fd, &s)";
PROCEDURE -stat(n: ARRAY OF CHAR): INTEGER "stat((char*)n, &s)";
PROCEDURE -structstats "struct stat s";
PROCEDURE -statdev(): LONGINT "(LONGINT)s.st_dev";
PROCEDURE -statino(): LONGINT "(LONGINT)s.st_ino";
PROCEDURE -statmtime(): LONGINT "(LONGINT)s.st_mtime";
PROCEDURE -statsize(): LONGINT "(LONGINT)s.st_size";
PROCEDURE Identify*(h: FileHandle; VAR identity: FileIdentity): ErrorCode;
BEGIN
structstats;
IF fstat(h) < 0 THEN RETURN err() END;
identity.volume := statdev();
identity.index := statino();
identity.mtime := statmtime();
RETURN 0
END Identify;
PROCEDURE IdentifyByName*(n: ARRAY OF CHAR; VAR identity: FileIdentity): ErrorCode;
BEGIN
structstats;
IF stat(n) < 0 THEN RETURN err() END;
identity.volume := statdev();
identity.index := statino();
identity.mtime := statmtime();
RETURN 0
END IdentifyByName;
PROCEDURE SameFile*(i1, i2: FileIdentity): BOOLEAN;
BEGIN RETURN (i1.index = i2.index) & (i1.volume = i2.volume)
END SameFile;
PROCEDURE SameFileTime*(i1, i2: FileIdentity): BOOLEAN;
BEGIN RETURN i1.mtime = i2.mtime
END SameFileTime;
PROCEDURE SetMTime*(VAR target: FileIdentity; source: FileIdentity);
BEGIN target.mtime := source.mtime;
END SetMTime;
PROCEDURE MTimeAsClock*(i: FileIdentity; VAR t, d: LONGINT);
BEGIN
sectotm(i.mtime);
YMDHMStoClock(tmyear(), tmmon(), tmmday(), tmhour(), tmmin(), tmsec(), t, d);
END MTimeAsClock;
PROCEDURE Size*(h: FileHandle; VAR l: LONGINT): ErrorCode;
BEGIN
structstats;
IF fstat(h) < 0 THEN RETURN err() END;
l := statsize();
RETURN 0;
END Size;
PROCEDURE -readfile (fd: LONGINT; p: LONGINT; l: LONGINT): LONGINT
"read(fd, (void*)(uintptr_t)(p), l)";
PROCEDURE Read*(h: FileHandle; p: LONGINT; l: LONGINT; VAR n: LONGINT): ErrorCode;
BEGIN
n := readfile(h, p, l);
IF n < 0 THEN n := 0; RETURN err() ELSE RETURN 0 END
END Read;
PROCEDURE ReadBuf*(h: FileHandle; VAR b: ARRAY OF SYSTEM.BYTE; VAR n: LONGINT): ErrorCode;
BEGIN
n := readfile(h, SYSTEM.ADR(b), LEN(b));
IF n < 0 THEN n := 0; RETURN err() ELSE RETURN 0 END
END ReadBuf;
PROCEDURE -writefile(fd: LONGINT; p: LONGINT; l: LONGINT): LONGINT
"write(fd, (void*)(uintptr_t)(p), l)";
PROCEDURE Write*(h: FileHandle; p: LONGINT; l: LONGINT): ErrorCode;
VAR written: LONGINT;
BEGIN
written := writefile(h, p, l);
IF written < 0 THEN RETURN err() ELSE RETURN 0 END
END Write;
PROCEDURE -fsync(fd: LONGINT): INTEGER "fsync(fd)";
PROCEDURE Sync*(h: FileHandle): ErrorCode;
BEGIN
IF fsync(h) < 0 THEN RETURN err() ELSE RETURN 0 END
END Sync;
PROCEDURE -lseek(fd: LONGINT; o: LONGINT; w: INTEGER): INTEGER "lseek(fd, o, w)";
PROCEDURE -seekset(): INTEGER "SEEK_SET";
PROCEDURE -seekcur(): INTEGER "SEEK_CUR";
PROCEDURE -seekend(): INTEGER "SEEK_END";
PROCEDURE Seek*(h: FileHandle; offset: LONGINT; whence: INTEGER): ErrorCode;
BEGIN
IF lseek(h, offset, whence) < 0 THEN RETURN err() ELSE RETURN 0 END
END Seek;
PROCEDURE -ftruncate(fd: LONGINT; l: LONGINT): INTEGER "ftruncate(fd, l)";
PROCEDURE Truncate*(h: FileHandle; l: LONGINT): ErrorCode;
BEGIN
IF (ftruncate(h, l) < 0) THEN RETURN err() ELSE RETURN 0 END;
END Truncate;
PROCEDURE -unlink(n: ARRAY OF CHAR): INTEGER "unlink((char*)n)";
PROCEDURE Unlink*(VAR n: ARRAY OF CHAR): ErrorCode;
BEGIN
IF unlink(n) < 0 THEN RETURN err() ELSE RETURN 0 END
END Unlink;
PROCEDURE -chdir(n: ARRAY OF CHAR): INTEGER "chdir((char*)n)";
PROCEDURE -getcwd(VAR cwd: ARRAY OF CHAR) "getcwd((char*)cwd, cwd__len)";
PROCEDURE Chdir*(VAR n: ARRAY OF CHAR): ErrorCode;
VAR r: INTEGER;
BEGIN
r := chdir(n); getcwd(CWD);
IF r < 0 THEN RETURN err() ELSE RETURN 0 END
END Chdir;
PROCEDURE -rename(o,n: ARRAY OF CHAR): INTEGER "rename((char*)o, (char*)n)";
PROCEDURE Rename*(VAR o,n: ARRAY OF CHAR): ErrorCode;
BEGIN
IF rename(o,n) < 0 THEN RETURN err() ELSE RETURN 0 END
END Rename;
(* Process termination *)
PROCEDURE -exit(code: INTEGER) "exit(code)";
PROCEDURE Exit*(code: INTEGER);
BEGIN exit(code) END Exit;
PROCEDURE -errstring(s: ARRAY OF CHAR) 'write(1, s, s__len-1)';
PROCEDURE -errc (c: CHAR) 'write(1, &c, 1)';
PROCEDURE errch(c: CHAR); BEGIN errc(c) END errch;
PROCEDURE errln; BEGIN errch(0DX); errch(0AX) END errln;
PROCEDURE errposint(l: LONGINT);
BEGIN IF l>10 THEN errposint(l DIV 10) END; errch(CHR(ORD('0') + (l MOD 10))) END errposint;
PROCEDURE errint(l: LONGINT);
BEGIN IF l<0 THEN errch('-'); l := -l END; errposint(l) END errint;
PROCEDURE DisplayHaltCode(code: LONGINT);
BEGIN
CASE code OF
| -1: errstring("Assertion failure.")
| -2: errstring("Index out of range.")
| -3: errstring("Reached end of function without reaching RETURN.")
| -4: errstring("CASE statement: no matching label and no ELSE.")
| -5: errstring("Type guard failed.")
| -6: errstring("Implicit type guard in record assignment failed.")
| -7: errstring("Invalid case in WITH statement.")
| -8: errstring("Value out of range.")
| -9: errstring("Heap interrupted while locked, but lockdepth = 0 at unlock.")
|-10: errstring("NIL access.");
|-11: errstring("Alignment error.");
|-12: errstring("Divide by zero.");
|-13: errstring("Arithmetic overflow/underflow.");
|-14: errstring("Invalid function argument.");
|-15: errstring("Internal error, e.g. Type descriptor size mismatch.")
|-20: errstring("Too many, or negative number of, elements in dynamic array.")
ELSE
END
END DisplayHaltCode;
PROCEDURE Halt*(code: LONGINT);
VAR e: ErrorCode;
BEGIN
HaltCode := code;
IF HaltHandler # NIL THEN HaltHandler(code) END;
errstring("Terminated by Halt("); errint(code); errstring("). ");
IF code < 0 THEN DisplayHaltCode(code) END;
errln;
exit(SYSTEM.VAL(INTEGER,code));
END Halt;
PROCEDURE AssertFail*(code: LONGINT);
VAR e: ErrorCode;
BEGIN
errstring("Assertion failure.");
IF code # 0 THEN errstring(" ASSERT code "); errint(code); errstring("."); END;
errln;
exit(SYSTEM.VAL(INTEGER,code));
END AssertFail;
PROCEDURE SetHalt*(p: HaltProcedure);
BEGIN HaltHandler := p; END SetHalt;
PROCEDURE TestLittleEndian;
VAR i: INTEGER;
BEGIN i := 1; SYSTEM.GET(SYSTEM.ADR(i), LittleEndian); END TestLittleEndian;
PROCEDURE -getpid(): INTEGER "(INTEGER)getpid()";
BEGIN
TestLittleEndian;
StatCheck();
HaltCode := -128;
HaltHandler := NIL;
TimeStart := Time();
CWD := ""; getcwd(CWD);
PID := getpid();
SeekSet := seekset();
SeekCur := seekcur();
SeekEnd := seekend();
nl[0] := 0AX; (* LF *)
nl[1] := 0X;
END Platform.
END Unix.