(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
MODULE HOST;
IMPORT SYSTEM, K := KOSAPI, API, RTL;
CONST
slash* = "/";
OS* = "KOS";
bit_depth* = RTL.bit_depth;
maxint* = RTL.maxint;
minint* = RTL.minint;
MAX_PARAM = 1024;
TYPE
FNAME = ARRAY 520 OF CHAR;
FS = POINTER TO rFS;
rFS = RECORD
subfunc, pos, hpos, bytes, buffer: INTEGER;
name: FNAME
END;
FD = POINTER TO rFD;
rFD = RECORD
attr: INTEGER;
ntyp: CHAR;
reserved: ARRAY 3 OF CHAR;
time_create, date_create,
time_access, date_access,
time_modif, date_modif,
size, hsize: INTEGER;
name: FNAME
END;
VAR
Console: BOOLEAN;
Params: ARRAY MAX_PARAM, 2 OF INTEGER;
argc*: INTEGER;
eol*: ARRAY 3 OF CHAR;
maxreal*: REAL;
PROCEDURE [stdcall, "Console.obj", "con_init"] con_init (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER);
PROCEDURE [stdcall, "Console.obj", "con_exit"] con_exit (bCloseWindow: BOOLEAN);
PROCEDURE [stdcall, "Console.obj", "con_write_string"] con_write_string (string, length: INTEGER);
PROCEDURE ExitProcess* (p1: INTEGER);
BEGIN
IF Console THEN
con_exit(FALSE)
END;
K.sysfunc1(-1)
END ExitProcess;
PROCEDURE OutChar* (c: CHAR);
BEGIN
IF Console THEN
con_write_string(SYSTEM.ADR(c), 1)
ELSE
K.sysfunc3(63, 1, ORD(c))
END
END OutChar;
PROCEDURE GetFileInfo (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN;
VAR
res2: INTEGER;
fs: rFS;
BEGIN
fs.subfunc := 5;
fs.pos := 0;
fs.hpos := 0;
fs.bytes := 0;
fs.buffer := SYSTEM.ADR(Info);
COPY(FName, fs.name)
RETURN K.sysfunc22(70, SYSTEM.ADR(fs), res2) = 0
END GetFileInfo;
PROCEDURE Exists (FName: ARRAY OF CHAR): BOOLEAN;
VAR
fd: rFD;
BEGIN
RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr))
END Exists;
PROCEDURE Close (VAR F: FS);
BEGIN
IF F # NIL THEN
DISPOSE(F)
END
END Close;
PROCEDURE Open (FName: ARRAY OF CHAR): FS;
VAR
F: FS;
BEGIN
IF Exists(FName) THEN
NEW(F);
IF F # NIL THEN
F.subfunc := 0;
F.pos := 0;
F.hpos := 0;
F.bytes := 0;
F.buffer := 0;
COPY(FName, F.name)
END
ELSE
F := NIL
END
RETURN F
END Open;
PROCEDURE Read (F: FS; Buffer, Count: INTEGER): INTEGER;
VAR
res, res2: INTEGER;
BEGIN
IF F # NIL THEN
F.subfunc := 0;
F.bytes := Count;
F.buffer := Buffer;
res := K.sysfunc22(70, SYSTEM.ADR(F^), res2);
IF res2 > 0 THEN
F.pos := F.pos + res2
END
ELSE
res2 := 0
END
RETURN res2
END Read;
PROCEDURE Write (F: FS; Buffer, Count: INTEGER): INTEGER;
VAR
res, res2: INTEGER;
BEGIN
IF F # NIL THEN
F.subfunc := 3;
F.bytes := Count;
F.buffer := Buffer;
res := K.sysfunc22(70, SYSTEM.ADR(F^), res2);
IF res2 > 0 THEN
F.pos := F.pos + res2
END
ELSE
res2 := 0
END
RETURN res2
END Write;
PROCEDURE Create (FName: ARRAY OF CHAR): FS;
VAR
F: FS;
res2: INTEGER;
BEGIN
NEW(F);
IF F # NIL THEN
F.subfunc := 2;
F.pos := 0;
F.hpos := 0;
F.bytes := 0;
F.buffer := 0;
COPY(FName, F.name);
IF K.sysfunc22(70, SYSTEM.ADR(F^), res2) # 0 THEN
DISPOSE(F)
END
END
RETURN F
END Create;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
VAR
n: INTEGER;
fs: FS;
BEGIN
SYSTEM.GET(SYSTEM.ADR(F), fs);
n := Read(fs, SYSTEM.ADR(Buffer[0]), bytes);
IF n = 0 THEN
n := -1
END
RETURN n
END FileRead;
PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
VAR
n: INTEGER;
fs: FS;
BEGIN
SYSTEM.GET(SYSTEM.ADR(F), fs);
n := Write(fs, SYSTEM.ADR(Buffer[0]), bytes);
IF n = 0 THEN
n := -1
END
RETURN n
END FileWrite;
PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
VAR
fs: FS;
res: INTEGER;
BEGIN
fs := Create(FName);
SYSTEM.GET(SYSTEM.ADR(fs), res)
RETURN res
END FileCreate;
PROCEDURE FileClose* (F: INTEGER);
VAR
fs: FS;
BEGIN
SYSTEM.GET(SYSTEM.ADR(F), fs);
Close(fs)
END FileClose;
PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
VAR
fs: FS;
res: INTEGER;
BEGIN
fs := Open(FName);
SYSTEM.GET(SYSTEM.ADR(fs), res)
RETURN res
END FileOpen;
PROCEDURE GetTickCount* (): INTEGER;
RETURN K.sysfunc2(26, 9)
END GetTickCount;
PROCEDURE AppAdr (): INTEGER;
VAR
buf: ARRAY 1024 OF CHAR;
a: INTEGER;
BEGIN
a := K.sysfunc3(9, SYSTEM.ADR(buf), -1);
SYSTEM.GET(SYSTEM.ADR(buf) + 22, a)
RETURN a
END AppAdr;
PROCEDURE GetCommandLine (): INTEGER;
VAR
param: INTEGER;
BEGIN
SYSTEM.GET(28 + AppAdr(), param)
RETURN param
END GetCommandLine;
PROCEDURE GetName (): INTEGER;
VAR
name: INTEGER;
BEGIN
SYSTEM.GET(32 + AppAdr(), name)
RETURN name
END GetName;
PROCEDURE GetChar (adr: INTEGER): CHAR;
VAR
res: CHAR;
BEGIN
SYSTEM.GET(adr, res)
RETURN res
END GetChar;
PROCEDURE ParamParse;
VAR
p, count, name, cond: INTEGER;
c: CHAR;
PROCEDURE ChangeCond (A, B, C: INTEGER; c: CHAR; VAR cond: INTEGER);
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();
name := GetName();
Params[0, 0] := name;
WHILE GetChar(name) # 0X DO
INC(name)
END;
Params[0, 1] := name - 1;
cond := 0;
count := 1;
WHILE (argc < MAX_PARAM) & (cond # 6) DO
c := GetChar(p);
CASE cond OF
|0: ChangeCond(0, 4, 1, c, cond); IF cond = 1 THEN Params[count, 0] := p END
|1: ChangeCond(0, 3, 1, c, cond); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END
|3: ChangeCond(3, 1, 3, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
|4: ChangeCond(5, 0, 5, c, cond); IF cond = 5 THEN Params[count, 0] := p END
|5: ChangeCond(5, 1, 5, c, cond); 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 GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
VAR
n: INTEGER;
BEGIN
GetArg(0, path);
n := LENGTH(path) - 1;
WHILE path[n] # slash DO
DEC(n)
END;
path[n + 1] := 0X
END GetCurrentDirectory;
PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
RETURN path[0] # slash
END isRelative;
PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER);
VAR
date, time: INTEGER;
BEGIN
date := K.sysfunc1(29);
time := K.sysfunc1(3);
year := date MOD 16;
date := date DIV 16;
year := (date MOD 16) * 10 + year;
date := date DIV 16;
month := date MOD 16;
date := date DIV 16;
month := (date MOD 16) * 10 + month;
date := date DIV 16;
day := date MOD 16;
date := date DIV 16;
day := (date MOD 16) * 10 + day;
date := date DIV 16;
hour := time MOD 16;
time := time DIV 16;
hour := (time MOD 16) * 10 + hour;
time := time DIV 16;
min := time MOD 16;
time := time DIV 16;
min := (time MOD 16) * 10 + min;
time := time DIV 16;
sec := time MOD 16;
time := time DIV 16;
sec := (time MOD 16) * 10 + sec;
time := time DIV 16;
year := year + 2000
END now;
PROCEDURE UnixTime* (): INTEGER;
RETURN 0
END UnixTime;
PROCEDURE d2s* (x: REAL): INTEGER;
VAR
h, l, s, e: INTEGER;
BEGIN
SYSTEM.GET(SYSTEM.ADR(x), l);
SYSTEM.GET(SYSTEM.ADR(x) + 4, 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 (l # 0) 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 splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
BEGIN
SYSTEM.GET(SYSTEM.ADR(x), a);
SYSTEM.GET(SYSTEM.ADR(x) + 4, b)
RETURN a
END splitf;
BEGIN
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
maxreal := 1.9;
PACK(maxreal, 1023);
Console := API.import;
IF Console THEN
con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS"))
END;
ParamParse
END HOST.