Subversion Repositories Kolibri OS

(*

    BSD 2-Clause License

    Copyright (c) 2018-2020, Anton Krotov

    All rights reserved.

*)

MODULE HOST;

IMPORT SYSTEM, RTL;

CONST

    slash* = "\";

    eol* = 0DX + 0AX;

    bit_depth* = RTL.bit_depth;

    maxint* = RTL.maxint;

    minint* = RTL.minint;

    MAX_PARAM = 1024;

    OFS_MAXPATHNAME = 128;

TYPE

    POverlapped = POINTER TO OVERLAPPED;

    OVERLAPPED = RECORD

        Internal:       INTEGER;

        InternalHigh:   INTEGER;

        Offset:         INTEGER;

        OffsetHigh:     INTEGER;

        hEvent:         INTEGER

    END;

    OFSTRUCT = RECORD

        cBytes:         CHAR;

        fFixedDisk:     CHAR;

        nErrCode:       WCHAR;

        Reserved1:      WCHAR;

        Reserved2:      WCHAR;

        szPathName:     ARRAY OFS_MAXPATHNAME OF CHAR

    END;

    PSecurityAttributes = POINTER TO TSecurityAttributes;

    TSecurityAttributes = RECORD

        nLength:               INTEGER;

        lpSecurityDescriptor:  INTEGER;

        bInheritHandle:        INTEGER

    END;

VAR

    hConsoleOutput: INTEGER;

    Params: ARRAY MAX_PARAM, 2 OF INTEGER;

    argc: INTEGER;

    maxreal*: REAL;

PROCEDURE [windows-, "kernel32.dll", "GetTickCount"]

    _GetTickCount (): INTEGER;

PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"]

    _GetStdHandle (nStdHandle: INTEGER): INTEGER;

PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"]

    _GetCommandLine (): INTEGER;

PROCEDURE [windows-, "kernel32.dll", "ReadFile"]

    _ReadFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER;

PROCEDURE [windows-, "kernel32.dll", "WriteFile"]

    _WriteFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER;

PROCEDURE [windows-, "kernel32.dll", "CloseHandle"]

    _CloseHandle (hObject: INTEGER): INTEGER;

PROCEDURE [windows-, "kernel32.dll", "CreateFileA"]

    _CreateFile (

        lpFileName, dwDesiredAccess, dwShareMode: INTEGER;

        lpSecurityAttributes: PSecurityAttributes;

        dwCreationDisposition, dwFlagsAndAttributes,

        hTemplateFile: INTEGER): INTEGER;

PROCEDURE [windows-, "kernel32.dll", "OpenFile"]

    _OpenFile (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER;

PROCEDURE [windows-, "kernel32.dll", "GetCurrentDirectoryA"]

    _GetCurrentDirectory (nBufferLength, lpBuffer: INTEGER): INTEGER;

PROCEDURE [windows, "kernel32.dll", "ExitProcess"]

    _ExitProcess (code: INTEGER);

PROCEDURE [windows, "msvcrt.dll", "time"]

    _time (ptr: INTEGER): INTEGER;

PROCEDURE ExitProcess* (code: INTEGER);

BEGIN

    _ExitProcess(code)

END ExitProcess;

PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);

VAR

    n: INTEGER;

BEGIN

    n := _GetCurrentDirectory(LEN(path), SYSTEM.ADR(path[0]));

    path[n] := slash;

    path[n + 1] := 0X

END GetCurrentDirectory;

PROCEDURE GetChar (adr: INTEGER): CHAR;

VAR

    res: CHAR;

BEGIN

    SYSTEM.GET(adr, res)

    RETURN res

END GetChar;

PROCEDURE ParamParse;

VAR

    p, count, cond: INTEGER;

    c: CHAR;

    PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR);

    BEGIN

        IF (c <= 20X) & (c # 0X) THEN

            cond := A

        ELSIF c = 22X THEN

            cond := B

        ELSIF c = 0X THEN

            cond := 6

        ELSE

            cond := C

        END

    END ChangeCond;

BEGIN

    p := _GetCommandLine();

    cond := 0;

    count := 0;

    WHILE (count < MAX_PARAM) & (cond # 6) DO

        c := GetChar(p);

        CASE cond OF

        |0: ChangeCond(0, 4, 1, cond, c); IF cond = 1 THEN Params[count, 0] := p END

        |1: ChangeCond(0, 3, 1, cond, c); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END

        |3: ChangeCond(3, 1, 3, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END

        |4: ChangeCond(5, 0, 5, cond, c); IF cond = 5 THEN Params[count, 0] := p END

        |5: ChangeCond(5, 1, 5, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END

        |6:

        END;

        INC(p)

    END;

    argc := count

END ParamParse;

PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);

VAR

    i, j, len: INTEGER;

    c: CHAR;

BEGIN

    j := 0;

    IF n < argc THEN

        len := LEN(s) - 1;

        i := Params[n, 0];

        WHILE (j < len) & (i <= Params[n, 1]) DO

            c := GetChar(i);

            IF c # 22X THEN

                s[j] := c;

                INC(j)

            END;

            INC(i)

        END

    END;

    s[j] := 0X

END GetArg;

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

VAR

    res: INTEGER;

BEGIN

    IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, res, NIL) = 0 THEN

        res := -1

    END

    RETURN res

END FileRead;

PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;

VAR

    res: INTEGER;

BEGIN

    IF _WriteFile(F, SYSTEM.ADR(Buffer[0]), bytes, res, NIL) = 0 THEN

        res := -1

    END

    RETURN res

END FileWrite;

PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;

    RETURN _CreateFile(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0)

END FileCreate;

PROCEDURE FileClose* (F: INTEGER);

BEGIN

    _CloseHandle(F)

END FileClose;

PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;

VAR

    ofstr: OFSTRUCT;

    res:   INTEGER;

BEGIN

    res := _OpenFile(SYSTEM.ADR(FName[0]), ofstr, 0);

    IF res = 0FFFFFFFFH THEN

        res := -1

    END

    RETURN res

END FileOpen;

PROCEDURE chmod* (FName: ARRAY OF CHAR);

END chmod;

PROCEDURE OutChar* (c: CHAR);

VAR

    count: INTEGER;

BEGIN

    _WriteFile(hConsoleOutput, SYSTEM.ADR(c), 1, count, NIL)

END OutChar;

PROCEDURE GetTickCount* (): INTEGER;

    RETURN _GetTickCount() DIV 10

END GetTickCount;

PROCEDURE letter (c: CHAR): BOOLEAN;

    RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z")

END letter;

PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;

    RETURN ~(letter(path[0]) & (path[1] = ":"))

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;

BEGIN

    maxreal := 1.9;

    PACK(maxreal, 1023);

    hConsoleOutput := _GetStdHandle(-11);

    ParamParse

END HOST.