1MODULE Platform;
2IMPORT SYSTEM;
3
4CONST
5  StdIn-  = 0;
6  StdOut- = 1;
7  StdErr- = 2;
8
9TYPE
10  SignalHandler = PROCEDURE(signal: SYSTEM.INT32);
11
12  ErrorCode*  = INTEGER;
13  FileHandle* = LONGINT;
14
15  FileIdentity* = RECORD
16    volume: LONGINT;  (* dev on Unix filesystems, volume serial number on NTFS *)
17    index:  LONGINT;  (* inode on Unix filesystems, file id on NTFS *)
18    mtime:  LONGINT;  (* File modification time, value is system dependent *)
19  END;
20
21VAR
22  LittleEndian-:   BOOLEAN;
23  PID-:            INTEGER;    (* Note: Must be updated by Fork implementation *)
24  CWD-:            ARRAY 256 OF CHAR;
25  TimeStart:       LONGINT;
26
27  SeekSet-:        INTEGER;
28  SeekCur-:        INTEGER;
29  SeekEnd-:        INTEGER;
30
31  NL-:             ARRAY 3 OF CHAR;  (* Platform specific newline representation *)
32
33
34
35(* Unix headers to be included *)
36
37PROCEDURE -Aincludesystime  '#include <sys/time.h>';  (* for gettimeofday *)
38PROCEDURE -Aincludetime     '#include <time.h>';      (* for localtime *)
39PROCEDURE -Aincludesystypes '#include <sys/types.h>';
40PROCEDURE -Aincludeunistd   '#include <unistd.h>';
41PROCEDURE -Aincludesysstat  '#include <sys/stat.h>';
42PROCEDURE -Aincludefcntl    '#include <fcntl.h>';
43PROCEDURE -Aincludeerrno    '#include <errno.h>';
44PROCEDURE -Astdlib          '#include <stdlib.h>';
45PROCEDURE -Astdio           '#include <stdio.h>';
46PROCEDURE -Aerrno           '#include <errno.h>';
47PROCEDURE -Alimits          '#include <limits.h>';
48
49
50
51
52(* Error code tests *)
53
54PROCEDURE -EMFILE():       ErrorCode 'EMFILE';
55PROCEDURE -ENFILE():       ErrorCode 'ENFILE';
56PROCEDURE -ENOENT():       ErrorCode 'ENOENT';
57PROCEDURE -EXDEV():        ErrorCode 'EXDEV';
58PROCEDURE -EACCES():       ErrorCode 'EACCES';
59PROCEDURE -EROFS():        ErrorCode 'EROFS';
60PROCEDURE -EAGAIN():       ErrorCode 'EAGAIN';
61PROCEDURE -ETIMEDOUT():    ErrorCode 'ETIMEDOUT';
62PROCEDURE -ECONNREFUSED(): ErrorCode 'ECONNREFUSED';
63PROCEDURE -ECONNABORTED(): ErrorCode 'ECONNABORTED';
64PROCEDURE -ENETUNREACH():  ErrorCode 'ENETUNREACH';
65PROCEDURE -EHOSTUNREACH(): ErrorCode 'EHOSTUNREACH';
66PROCEDURE -EINTR():        ErrorCode 'EINTR';
67
68
69
70PROCEDURE TooManyFiles*(e: ErrorCode): BOOLEAN;
71BEGIN RETURN (e = EMFILE()) OR (e = ENFILE()) END TooManyFiles;
72
73PROCEDURE NoSuchDirectory*(e: ErrorCode): BOOLEAN;
74BEGIN RETURN e = ENOENT() END NoSuchDirectory;
75
76PROCEDURE DifferentFilesystems*(e: ErrorCode): BOOLEAN;
77BEGIN RETURN e = EXDEV() END DifferentFilesystems;
78
79PROCEDURE Inaccessible*(e: ErrorCode): BOOLEAN;
80BEGIN RETURN (e = EACCES()) OR (e = EROFS()) OR (e = EAGAIN()) END Inaccessible;
81
82PROCEDURE Absent*(e: ErrorCode): BOOLEAN;
83BEGIN RETURN e = ENOENT() END Absent;
84
85PROCEDURE TimedOut*(e: ErrorCode): BOOLEAN;
86BEGIN RETURN e = ETIMEDOUT() END TimedOut;
87
88PROCEDURE ConnectionFailed*(e: ErrorCode): BOOLEAN;
89BEGIN RETURN (e = ECONNREFUSED()) OR (e = ECONNABORTED())
90          OR (e = ENETUNREACH())  OR (e = EHOSTUNREACH()) END ConnectionFailed;
91
92PROCEDURE Interrupted*(e: ErrorCode): BOOLEAN;
93BEGIN RETURN e = EINTR() END Interrupted;
94
95
96
97
98(* Expose file and path name length limits *)
99
100PROCEDURE -NAMEMAX(): INTEGER 'NAME_MAX';
101PROCEDURE -PATHMAX(): INTEGER 'PATH_MAX';
102
103PROCEDURE MaxNameLength*(): INTEGER;  BEGIN RETURN NAMEMAX() END MaxNameLength;
104PROCEDURE MaxPathLength*(): INTEGER;  BEGIN RETURN PATHMAX() END MaxPathLength;
105
106
107
108
109(* OS memory allocaton *)
110
111PROCEDURE -allocate  (size: SYSTEM.ADDRESS): SYSTEM.ADDRESS "(ADDRESS)((void*)malloc((size_t)size))";
112PROCEDURE OSAllocate*(size: SYSTEM.ADDRESS): SYSTEM.ADDRESS; BEGIN RETURN allocate(size) END OSAllocate;
113
114PROCEDURE -free(address: SYSTEM.ADDRESS) "free((void*)address)";
115PROCEDURE OSFree*(address: SYSTEM.ADDRESS); BEGIN free(address) END OSFree;
116
117
118
119
120(* Program arguments and environment access *)
121
122PROCEDURE -getenv(var: ARRAY OF CHAR): SYSTEM.ADDRESS "getenv((char*)var)";
123
124PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN;
125TYPE EnvPtr = POINTER TO ARRAY 1024 OF CHAR;
126VAR  p: EnvPtr;
127BEGIN
128  p := SYSTEM.VAL(EnvPtr, getenv(var));
129  IF p # NIL THEN COPY(p^, val) END;
130  RETURN p # NIL;
131END getEnv;
132
133PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR);
134BEGIN
135  IF ~getEnv(var, val) THEN val[0] := 0X END;
136END GetEnv;
137
138
139
140
141
142
143(* Signals and traps *)
144
145PROCEDURE -sethandler(s: INTEGER; h: SignalHandler) "SystemSetHandler(s, (ADDRESS)h)";
146
147PROCEDURE SetInterruptHandler*(handler: SignalHandler);
148BEGIN sethandler(2, handler); END SetInterruptHandler;
149
150PROCEDURE SetQuitHandler*(handler: SignalHandler);
151BEGIN sethandler(3, handler); END SetQuitHandler;
152
153PROCEDURE SetBadInstructionHandler*(handler: SignalHandler);
154BEGIN sethandler(4, handler); END SetBadInstructionHandler;
155
156
157
158
159(* Time of day *)
160
161PROCEDURE -gettimeval          "struct timeval tv; gettimeofday(&tv,0)";
162PROCEDURE -tvsec():  LONGINT   "tv.tv_sec";
163PROCEDURE -tvusec(): LONGINT   "tv.tv_usec";
164PROCEDURE -sectotm(s: LONGINT) "struct tm *time = localtime((time_t*)&s)";
165PROCEDURE -tmsec():  LONGINT   "(LONGINT)time->tm_sec";
166PROCEDURE -tmmin():  LONGINT   "(LONGINT)time->tm_min";
167PROCEDURE -tmhour(): LONGINT   "(LONGINT)time->tm_hour";
168PROCEDURE -tmmday(): LONGINT   "(LONGINT)time->tm_mday";
169PROCEDURE -tmmon():  LONGINT   "(LONGINT)time->tm_mon";
170PROCEDURE -tmyear(): LONGINT   "(LONGINT)time->tm_year";
171
172PROCEDURE YMDHMStoClock(ye,mo,da,ho,mi,se: LONGINT; VAR t, d: LONGINT);
173BEGIN
174  d := ASH(ye MOD 100, 9) + ASH(mo+1, 5) + da;
175  t := ASH(ho, 12)        + ASH(mi, 6)   + se;
176END YMDHMStoClock;
177
178PROCEDURE GetClock*(VAR t, d: LONGINT);
179BEGIN
180  gettimeval; sectotm(tvsec());
181  YMDHMStoClock(tmyear(), tmmon(), tmmday(), tmhour(), tmmin(), tmsec(), t, d);
182END GetClock;
183
184PROCEDURE GetTimeOfDay*(VAR sec, usec: LONGINT);
185BEGIN
186  gettimeval; sec := tvsec(); usec := tvusec();
187END GetTimeOfDay;
188
189PROCEDURE Time*(): LONGINT;
190VAR ms: LONGINT;
191BEGIN
192  gettimeval;
193  ms := (tvusec() DIV 1000) + (tvsec() * 1000);
194  RETURN (ms - TimeStart) MOD 7FFFFFFFH;
195END Time;
196
197
198PROCEDURE -nanosleep(s: LONGINT; ns: LONGINT) "struct timespec req, rem; req.tv_sec = s; req.tv_nsec = ns; nanosleep(&req, &rem)";
199
200PROCEDURE Delay*(ms: LONGINT);
201VAR s, ns: LONGINT;
202BEGIN
203  s  :=  ms DIV 1000;
204  ns := (ms MOD 1000) * 1000000;
205  nanosleep(s, ns);
206END Delay;
207
208
209
210
211(* System call *)
212
213PROCEDURE -system(str: ARRAY OF CHAR): INTEGER "system((char*)str)";
214PROCEDURE -err(): INTEGER "errno";
215
216
217PROCEDURE System*(cmd : ARRAY OF CHAR): INTEGER;
218BEGIN RETURN system(cmd); END System;
219
220PROCEDURE Error*(): ErrorCode; BEGIN RETURN err() END Error;
221
222
223
224
225(* File system *)
226
227(* Note: Consider also using flags O_SYNC and O_DIRECT as we do buffering *)
228PROCEDURE -openrw (n: ARRAY OF CHAR): INTEGER "open((char*)n, O_RDWR)";
229PROCEDURE -openro (n: ARRAY OF CHAR): INTEGER "open((char*)n, O_RDONLY)";
230PROCEDURE -opennew(n: ARRAY OF CHAR): INTEGER "open((char*)n, O_CREAT | O_TRUNC | O_RDWR, 0664)";
231
232(* File APIs *)
233
234PROCEDURE OldRO*(VAR n: ARRAY OF CHAR; VAR h: FileHandle): ErrorCode;
235VAR fd: INTEGER;
236BEGIN
237  fd := openro(n);
238  IF (fd < 0) THEN RETURN err() ELSE h := fd; RETURN 0 END;
239END OldRO;
240
241PROCEDURE OldRW*(VAR n: ARRAY OF CHAR; VAR h: FileHandle): ErrorCode;
242VAR fd: INTEGER;
243BEGIN
244  fd := openrw(n);
245  IF (fd < 0) THEN RETURN err() ELSE h := fd; RETURN 0 END;
246END OldRW;
247
248PROCEDURE New*(VAR n: ARRAY OF CHAR; VAR h: FileHandle): ErrorCode;
249VAR fd: INTEGER;
250BEGIN
251  fd := opennew(n);
252  IF (fd < 0) THEN RETURN err() ELSE h := fd; RETURN 0 END;
253END New;
254
255
256
257PROCEDURE -closefile(fd: LONGINT): INTEGER "close(fd)";
258
259PROCEDURE Close*(h: FileHandle): ErrorCode;
260BEGIN
261  IF closefile(h) < 0 THEN RETURN err() ELSE RETURN 0 END
262END Close;
263
264
265PROCEDURE -isatty(fd: LONGINT): INTEGER "isatty(fd)";
266
267PROCEDURE IsConsole*(h: FileHandle): BOOLEAN;
268BEGIN RETURN isatty(h) # 0 END IsConsole;
269
270
271
272PROCEDURE -fstat(fd: LONGINT):     INTEGER "fstat(fd, &s)";
273PROCEDURE -stat(n: ARRAY OF CHAR): INTEGER "stat((char*)n, &s)";
274PROCEDURE -structstats                     "struct stat s";
275PROCEDURE -statdev():              LONGINT "(LONGINT)s.st_dev";
276PROCEDURE -statino():              LONGINT "(LONGINT)s.st_ino";
277PROCEDURE -statmtime():            LONGINT "(LONGINT)s.st_mtime";
278PROCEDURE -statsize():             LONGINT "(ADDRESS)s.st_size";
279
280PROCEDURE Identify*(h: FileHandle; VAR identity: FileIdentity): ErrorCode;
281BEGIN
282  structstats;
283  IF fstat(h) < 0 THEN RETURN err() END;
284  identity.volume := statdev();
285  identity.index  := statino();
286  identity.mtime  := statmtime();
287  RETURN 0
288END Identify;
289
290PROCEDURE IdentifyByName*(n: ARRAY OF CHAR; VAR identity: FileIdentity): ErrorCode;
291BEGIN
292  structstats;
293  IF stat(n) < 0 THEN RETURN err() END;
294  identity.volume := statdev();
295  identity.index  := statino();
296  identity.mtime  := statmtime();
297  RETURN 0
298END IdentifyByName;
299
300
301PROCEDURE SameFile*(i1, i2: FileIdentity): BOOLEAN;
302BEGIN RETURN (i1.index = i2.index) & (i1.volume = i2.volume)
303END SameFile;
304
305PROCEDURE SameFileTime*(i1, i2: FileIdentity): BOOLEAN;
306BEGIN RETURN i1.mtime = i2.mtime
307END SameFileTime;
308
309PROCEDURE SetMTime*(VAR target: FileIdentity; source: FileIdentity);
310BEGIN target.mtime := source.mtime;
311END SetMTime;
312
313PROCEDURE MTimeAsClock*(i: FileIdentity; VAR t, d: LONGINT);
314BEGIN
315  sectotm(i.mtime);
316  YMDHMStoClock(tmyear(), tmmon(), tmmday(), tmhour(), tmmin(), tmsec(), t, d);
317END MTimeAsClock;
318
319
320PROCEDURE Size*(h: FileHandle; VAR l: LONGINT): ErrorCode;
321BEGIN
322  structstats;
323  IF fstat(h) < 0 THEN RETURN err() END;
324  l := statsize();
325  RETURN 0;
326END Size;
327
328
329
330PROCEDURE -readfile (fd: LONGINT; p: SYSTEM.ADDRESS; l: LONGINT): LONGINT
331"(LONGINT)read(fd, (void*)(ADDRESS)(p), l)";
332
333PROCEDURE Read*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT; VAR n: LONGINT): ErrorCode;
334BEGIN
335  n := readfile(h, p, l);
336  IF n < 0 THEN n := 0; RETURN err() ELSE RETURN 0 END
337END Read;
338
339PROCEDURE ReadBuf*(h: FileHandle; VAR b: ARRAY OF SYSTEM.BYTE; VAR n: LONGINT): ErrorCode;
340BEGIN
341  n := readfile(h, SYSTEM.ADR(b), LEN(b));
342  IF n < 0 THEN n := 0; RETURN err() ELSE RETURN 0 END
343END ReadBuf;
344
345
346
347PROCEDURE -writefile(fd: LONGINT; p: SYSTEM.ADDRESS; l: LONGINT): SYSTEM.ADDRESS
348"write(fd, (void*)(ADDRESS)(p), l)";
349
350PROCEDURE Write*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT): ErrorCode;
351  VAR written: SYSTEM.ADDRESS;
352BEGIN
353  written := writefile(h, p, l);
354  IF written < 0 THEN RETURN err() ELSE RETURN 0 END
355END Write;
356
357
358
359PROCEDURE -fsync(fd: LONGINT): INTEGER "fsync(fd)";
360
361PROCEDURE Sync*(h: FileHandle): ErrorCode;
362BEGIN
363  IF fsync(h) < 0 THEN RETURN err() ELSE RETURN 0 END
364END Sync;
365
366
367
368PROCEDURE -lseek(fd: LONGINT; o: LONGINT; w: INTEGER): INTEGER "lseek(fd, o, w)";
369PROCEDURE -seekset(): INTEGER "SEEK_SET";
370PROCEDURE -seekcur(): INTEGER "SEEK_CUR";
371PROCEDURE -seekend(): INTEGER "SEEK_END";
372
373PROCEDURE Seek*(h: FileHandle; offset: LONGINT; whence: INTEGER): ErrorCode;
374BEGIN
375  IF lseek(h, offset, whence) < 0 THEN RETURN err() ELSE RETURN 0 END
376END Seek;
377
378
379
380PROCEDURE -ftruncate(fd: LONGINT; l: LONGINT): INTEGER "ftruncate(fd, l)";
381
382PROCEDURE Truncate*(h: FileHandle; l: LONGINT): ErrorCode;
383BEGIN
384  IF (ftruncate(h, l) < 0) THEN RETURN err() ELSE RETURN 0 END;
385END Truncate;
386
387
388
389PROCEDURE -unlink(n: ARRAY OF CHAR): INTEGER "unlink((char*)n)";
390
391PROCEDURE Unlink*(VAR n: ARRAY OF CHAR): ErrorCode;
392BEGIN
393  IF unlink(n) < 0 THEN RETURN err() ELSE RETURN 0 END
394END Unlink;
395
396
397
398PROCEDURE -chdir(n: ARRAY OF CHAR): INTEGER "chdir((char*)n)";
399PROCEDURE -getcwd(VAR cwd: ARRAY OF CHAR): SYSTEM.PTR "getcwd((char*)cwd, cwd__len)";
400
401PROCEDURE Chdir*(VAR n: ARRAY OF CHAR): ErrorCode;
402  VAR r: INTEGER;
403BEGIN
404  IF (chdir(n) >= 0) & (getcwd(CWD) # NIL) THEN RETURN 0
405  ELSE RETURN err() END
406END Chdir;
407
408
409
410PROCEDURE -rename(o,n: ARRAY OF CHAR): INTEGER "rename((char*)o, (char*)n)";
411
412PROCEDURE Rename*(VAR o,n: ARRAY OF CHAR): ErrorCode;
413BEGIN
414  IF rename(o,n) < 0 THEN RETURN err() ELSE RETURN 0 END
415END Rename;
416
417
418
419
420(* Process termination *)
421
422PROCEDURE -exit(code: LONGINT) "exit((int)code)";
423PROCEDURE Exit*(code: LONGINT); BEGIN exit(code) END Exit;
424
425
426
427PROCEDURE TestLittleEndian;
428  VAR i: INTEGER;
429 BEGIN i := 1; SYSTEM.GET(SYSTEM.ADR(i), LittleEndian); END TestLittleEndian;
430
431
432PROCEDURE -getpid(): INTEGER   "(INTEGER)getpid()";
433
434BEGIN
435  TestLittleEndian;
436
437  TimeStart   := 0;   TimeStart := Time();
438  PID         := getpid();
439  IF getcwd(CWD) = NIL THEN CWD := "" END;
440
441  SeekSet := seekset();
442  SeekCur := seekcur();
443  SeekEnd := seekend();
444
445  NL[0] := 0AX; (* LF *)
446  NL[1] := 0X;
447END Platform.
448