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