2020-05-25 22:48:33 +02:00
|
|
|
(*
|
2019-03-11 09:59:55 +01:00
|
|
|
BSD 2-Clause License
|
2016-10-24 01:30:27 +02:00
|
|
|
|
2020-05-25 22:48:33 +02:00
|
|
|
Copyright (c) 2019-2020, Anton Krotov
|
2019-03-11 09:59:55 +01:00
|
|
|
All rights reserved.
|
2016-10-24 01:30:27 +02:00
|
|
|
*)
|
|
|
|
|
|
|
|
MODULE HOST;
|
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
IMPORT SYSTEM, API, RTL;
|
|
|
|
|
2016-10-24 01:30:27 +02:00
|
|
|
|
|
|
|
CONST
|
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
slash* = "/";
|
2020-10-13 09:58:51 +02:00
|
|
|
eol* = 0AX;
|
2019-03-11 09:59:55 +01:00
|
|
|
|
|
|
|
bit_depth* = RTL.bit_depth;
|
|
|
|
maxint* = RTL.maxint;
|
|
|
|
minint* = RTL.minint;
|
|
|
|
|
2020-10-13 09:58:51 +02:00
|
|
|
RTLD_LAZY = 1;
|
|
|
|
|
|
|
|
|
|
|
|
TYPE
|
|
|
|
|
|
|
|
TP = ARRAY 2 OF INTEGER;
|
|
|
|
|
2016-10-24 01:30:27 +02:00
|
|
|
|
|
|
|
VAR
|
|
|
|
|
2020-10-13 09:58:51 +02:00
|
|
|
maxreal*: REAL;
|
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
argc: INTEGER;
|
2016-10-24 01:30:27 +02:00
|
|
|
|
2020-10-13 09:58:51 +02:00
|
|
|
libc, librt: INTEGER;
|
2016-10-24 01:30:27 +02:00
|
|
|
|
2020-10-13 09:58:51 +02:00
|
|
|
stdout: INTEGER;
|
|
|
|
|
|
|
|
fread, fwrite : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER;
|
|
|
|
fopen : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER;
|
|
|
|
fclose : PROCEDURE [linux] (file: INTEGER): INTEGER;
|
|
|
|
_chmod : PROCEDURE [linux] (fname: INTEGER; mode: SET): INTEGER;
|
|
|
|
time : PROCEDURE [linux] (ptr: INTEGER): INTEGER;
|
|
|
|
clock_gettime : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER;
|
|
|
|
exit : PROCEDURE [linux] (code: INTEGER);
|
2020-05-25 22:48:33 +02:00
|
|
|
|
2016-10-24 01:30:27 +02:00
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
PROCEDURE ExitProcess* (code: INTEGER);
|
2016-10-24 01:30:27 +02:00
|
|
|
BEGIN
|
2020-10-13 09:58:51 +02:00
|
|
|
exit(code)
|
2019-03-11 09:59:55 +01:00
|
|
|
END ExitProcess;
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
|
|
|
|
VAR
|
|
|
|
i, len, ptr: INTEGER;
|
|
|
|
c: CHAR;
|
2016-10-24 01:30:27 +02:00
|
|
|
|
|
|
|
BEGIN
|
2019-03-11 09:59:55 +01:00
|
|
|
i := 0;
|
|
|
|
len := LEN(s) - 1;
|
|
|
|
IF (n < argc) & (len > 0) THEN
|
|
|
|
SYSTEM.GET(API.MainParam + (n + 1) * SYSTEM.SIZE(INTEGER), ptr);
|
|
|
|
REPEAT
|
|
|
|
SYSTEM.GET(ptr, c);
|
|
|
|
s[i] := c;
|
|
|
|
INC(i);
|
|
|
|
INC(ptr)
|
|
|
|
UNTIL (c = 0X) OR (i = len)
|
|
|
|
END;
|
|
|
|
s[i] := 0X
|
|
|
|
END GetArg;
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
|
|
|
|
VAR
|
|
|
|
n: INTEGER;
|
|
|
|
|
2016-10-24 01:30:27 +02:00
|
|
|
BEGIN
|
2019-03-11 09:59:55 +01:00
|
|
|
GetArg(0, path);
|
|
|
|
n := LENGTH(path) - 1;
|
|
|
|
WHILE path[n] # slash DO
|
|
|
|
DEC(n)
|
|
|
|
END;
|
|
|
|
path[n + 1] := 0X
|
|
|
|
END GetCurrentDirectory;
|
|
|
|
|
2016-10-24 01:30:27 +02:00
|
|
|
|
2019-10-06 19:55:12 +02:00
|
|
|
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
|
2019-03-11 09:59:55 +01:00
|
|
|
VAR
|
|
|
|
res: INTEGER;
|
2016-10-24 01:30:27 +02:00
|
|
|
|
|
|
|
BEGIN
|
2020-10-13 09:58:51 +02:00
|
|
|
res := fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
|
2019-03-11 09:59:55 +01:00
|
|
|
IF res <= 0 THEN
|
|
|
|
res := -1
|
|
|
|
END
|
|
|
|
|
|
|
|
RETURN res
|
|
|
|
END FileRead;
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
|
|
|
|
VAR
|
|
|
|
res: INTEGER;
|
|
|
|
|
2016-10-24 01:30:27 +02:00
|
|
|
BEGIN
|
2020-10-13 09:58:51 +02:00
|
|
|
res := fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
|
2019-03-11 09:59:55 +01:00
|
|
|
IF res <= 0 THEN
|
|
|
|
res := -1
|
|
|
|
END
|
2016-10-24 01:30:27 +02:00
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
RETURN res
|
|
|
|
END FileWrite;
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
|
2020-10-13 09:58:51 +02:00
|
|
|
RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("wb"))
|
2019-03-11 09:59:55 +01:00
|
|
|
END FileCreate;
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE FileClose* (File: INTEGER);
|
2016-10-24 01:30:27 +02:00
|
|
|
BEGIN
|
2020-10-13 09:58:51 +02:00
|
|
|
File := fclose(File)
|
2019-03-11 09:59:55 +01:00
|
|
|
END FileClose;
|
|
|
|
|
|
|
|
|
2020-10-13 09:58:51 +02:00
|
|
|
PROCEDURE chmod* (FName: ARRAY OF CHAR);
|
|
|
|
VAR
|
|
|
|
res: INTEGER;
|
|
|
|
BEGIN
|
|
|
|
res := _chmod(SYSTEM.ADR(FName[0]), {0, 2..8}) (* rwxrwxr-x *)
|
|
|
|
END chmod;
|
|
|
|
|
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
|
2020-10-13 09:58:51 +02:00
|
|
|
RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("rb"))
|
2019-03-11 09:59:55 +01:00
|
|
|
END FileOpen;
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE OutChar* (c: CHAR);
|
2020-10-13 09:58:51 +02:00
|
|
|
VAR
|
|
|
|
res: INTEGER;
|
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
BEGIN
|
2020-10-13 09:58:51 +02:00
|
|
|
res := fwrite(SYSTEM.ADR(c), 1, 1, stdout)
|
2019-03-11 09:59:55 +01:00
|
|
|
END OutChar;
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE GetTickCount* (): INTEGER;
|
|
|
|
VAR
|
2020-10-13 09:58:51 +02:00
|
|
|
tp: TP;
|
2019-03-11 09:59:55 +01:00
|
|
|
res: INTEGER;
|
2016-10-24 01:30:27 +02:00
|
|
|
|
|
|
|
BEGIN
|
2020-10-13 09:58:51 +02:00
|
|
|
IF clock_gettime(0, tp) = 0 THEN
|
2019-03-11 09:59:55 +01:00
|
|
|
res := tp[0] * 100 + tp[1] DIV 10000000
|
|
|
|
ELSE
|
|
|
|
res := 0
|
|
|
|
END
|
|
|
|
|
|
|
|
RETURN res
|
|
|
|
END GetTickCount;
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
|
|
|
|
RETURN path[0] # slash
|
|
|
|
END isRelative;
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE UnixTime* (): INTEGER;
|
2020-10-13 09:58:51 +02:00
|
|
|
RETURN time(0)
|
2019-03-11 09:59:55 +01:00
|
|
|
END UnixTime;
|
|
|
|
|
|
|
|
|
2020-10-13 09:58:51 +02:00
|
|
|
PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
|
|
|
|
BEGIN
|
|
|
|
SYSTEM.GET32(SYSTEM.ADR(x), a);
|
|
|
|
SYSTEM.GET32(SYSTEM.ADR(x) + 4, b)
|
|
|
|
RETURN a
|
|
|
|
END splitf;
|
|
|
|
|
|
|
|
|
2020-05-25 22:48:33 +02:00
|
|
|
PROCEDURE d2s* (x: REAL): INTEGER;
|
|
|
|
VAR
|
|
|
|
h, l, s, e: INTEGER;
|
|
|
|
|
|
|
|
BEGIN
|
2020-10-13 09:58:51 +02:00
|
|
|
e := splitf(x, l, h);
|
2020-05-25 22:48:33 +02:00
|
|
|
|
|
|
|
s := ASR(h, 31) MOD 2;
|
|
|
|
e := (h DIV 100000H) MOD 2048;
|
|
|
|
IF e <= 896 THEN
|
|
|
|
h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H;
|
|
|
|
REPEAT
|
|
|
|
h := h DIV 2;
|
|
|
|
INC(e)
|
|
|
|
UNTIL e = 897;
|
|
|
|
e := 896;
|
|
|
|
l := (h MOD 8) * 20000000H;
|
|
|
|
h := h DIV 8
|
|
|
|
ELSIF (1151 <= e) & (e < 2047) THEN
|
|
|
|
e := 1151;
|
|
|
|
h := 0;
|
|
|
|
l := 0
|
|
|
|
ELSIF e = 2047 THEN
|
|
|
|
e := 1151;
|
2020-10-13 09:58:51 +02:00
|
|
|
IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN
|
2020-05-25 22:48:33 +02:00
|
|
|
h := 80000H;
|
|
|
|
l := 0
|
|
|
|
END
|
|
|
|
END;
|
|
|
|
DEC(e, 896)
|
|
|
|
|
|
|
|
RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8
|
|
|
|
END d2s;
|
|
|
|
|
|
|
|
|
2020-10-13 09:58:51 +02:00
|
|
|
PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
|
2019-03-11 09:59:55 +01:00
|
|
|
VAR
|
2020-10-13 09:58:51 +02:00
|
|
|
sym: INTEGER;
|
2019-03-11 09:59:55 +01:00
|
|
|
|
2016-10-24 01:30:27 +02:00
|
|
|
BEGIN
|
2020-10-13 09:58:51 +02:00
|
|
|
sym := API.dlsym(lib, SYSTEM.ADR(name[0]));
|
|
|
|
ASSERT(sym # 0);
|
|
|
|
SYSTEM.PUT(VarAdr, sym)
|
|
|
|
END GetSym;
|
2016-10-24 01:30:27 +02:00
|
|
|
|
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
BEGIN
|
2020-05-25 22:48:33 +02:00
|
|
|
maxreal := 1.9;
|
|
|
|
PACK(maxreal, 1023);
|
2020-10-13 09:58:51 +02:00
|
|
|
SYSTEM.GET(API.MainParam, argc);
|
|
|
|
|
|
|
|
libc := API.libc;
|
|
|
|
GetSym(libc, "fread", SYSTEM.ADR(fread));
|
|
|
|
GetSym(libc, "fwrite", SYSTEM.ADR(fwrite));
|
|
|
|
GetSym(libc, "fopen", SYSTEM.ADR(fopen));
|
|
|
|
GetSym(libc, "fclose", SYSTEM.ADR(fclose));
|
|
|
|
GetSym(libc, "chmod", SYSTEM.ADR(_chmod));
|
|
|
|
GetSym(libc, "time", SYSTEM.ADR(time));
|
|
|
|
GetSym(libc, "exit", SYSTEM.ADR(exit));
|
|
|
|
GetSym(libc, "stdout", SYSTEM.ADR(stdout)); SYSTEM.GET(stdout - SYSTEM.SIZE(INTEGER), stdout);
|
|
|
|
|
|
|
|
librt := API.dlopen(SYSTEM.SADR("librt.so.1"), RTLD_LAZY);
|
|
|
|
GetSym(librt, "clock_gettime", SYSTEM.ADR(clock_gettime))
|
2020-05-25 22:48:33 +02:00
|
|
|
END HOST.
|