ruberon/lib/Linux/HOST.ob07

(*
    BSD 2-Clause License

    Copyright (c) 2019-2022, Anton Krotov
    All rights reserved.
*)

MODULE HOST;

IMPORT SYSTEM, API;


CONST

    slash* = "/";
    eol* = 0AX;

    bit_depth* = (ORD(LSL(1, 31) > 0) + 1) * 32;
    maxint* = ROR(-2, 1);
    minint* = ROR(1, 1);

    RTLD_LAZY = 1;


TYPE

    TP = ARRAY 2 OF INTEGER;


VAR

    maxreal*, inf*: REAL;

    argc: INTEGER;

    libc, librt: INTEGER;

    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);
    getcwd        : PROCEDURE [linux] (dir, len: INTEGER): INTEGER;


PROCEDURE ExitProcess* (code: INTEGER);
BEGIN
    exit(code)
END ExitProcess;


PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
VAR
    i, len, ptr: INTEGER;
    c: CHAR;

BEGIN
    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;

BEGIN
    n := getcwd(SYSTEM.ADR(path[0]), LEN(path) - 2);
    n := LENGTH(path);
    path[n] := slash;
    path[n + 1] := 0X
END GetCurrentDirectory;


PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
VAR
    res: INTEGER;

BEGIN
    res := fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
    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;

BEGIN
    res := fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
    IF res <= 0 THEN
        res := -1
    END

    RETURN res
END FileWrite;


PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
    RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("wb"))
END FileCreate;


PROCEDURE FileClose* (File: INTEGER);
BEGIN
    File := fclose(File)
END FileClose;


PROCEDURE chmod* (FName: ARRAY OF CHAR);
VAR
    res: INTEGER;
BEGIN
    res := _chmod(SYSTEM.ADR(FName[0]), {0, 2..8}) (* rwxrwxr-x *)
END chmod;


PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
    RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("rb"))
END FileOpen;


PROCEDURE OutChar* (c: CHAR);
VAR
    res: INTEGER;

BEGIN
    res := fwrite(SYSTEM.ADR(c), 1, 1, stdout)
END OutChar;


PROCEDURE GetTickCount* (): INTEGER;
VAR
    tp:  TP;
    res: INTEGER;

BEGIN
    IF clock_gettime(0, tp) = 0 THEN
        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;
    RETURN time(0)
END UnixTime;


PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
VAR
    res: INTEGER;

BEGIN
    a := 0;
    b := 0;
    SYSTEM.GET32(SYSTEM.ADR(x), a);
    SYSTEM.GET32(SYSTEM.ADR(x) + 4, b);
    SYSTEM.GET(SYSTEM.ADR(x), res)
    RETURN res
END splitf;


PROCEDURE d2s* (x: REAL): INTEGER;
VAR
    h, l, s, e: INTEGER;

BEGIN
    e := splitf(x, l, h);

    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;
        IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN
            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;


PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
VAR
    sym: INTEGER;

BEGIN
    sym := API.dlsym(lib, SYSTEM.ADR(name[0]));
    ASSERT(sym # 0);
    SYSTEM.PUT(VarAdr, sym)
END GetSym;


BEGIN
    inf := SYSTEM.INF();
    maxreal := 1.9;
    PACK(maxreal, 1023);
    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, "getcwd", SYSTEM.ADR(getcwd));
    GetSym(libc, "stdout", SYSTEM.ADR(stdout)); SYSTEM.GET(stdout, stdout);

    librt := API.dlopen(SYSTEM.SADR("librt.so.1"), RTLD_LAZY);
    GetSym(librt, "clock_gettime", SYSTEM.ADR(clock_gettime))
END HOST.