(*
Copyright 2016 Anton Krotov
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE HOST;
IMPORT sys := SYSTEM, API;
CONST
OS* = "KOS";
Slash* = "/";
TYPE
FILENAME = ARRAY 2048 OF CHAR;
OFSTRUCT = RECORD
subfunc, pos, hpos, bytes, buf: INTEGER;
name: FILENAME
END;
VAR
con_init : PROCEDURE [stdcall] (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER);
con_exit : PROCEDURE [stdcall] (bCloseWindow: BOOLEAN);
con_write_asciiz : PROCEDURE [stdcall] (string: INTEGER);
fsize, sec*, dsec*: INTEGER;
PROCEDURE [stdcall] sysfunc1(arg1: INTEGER): INTEGER;
BEGIN
sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *)
sys.CODE("CD40"); (* int 40h *)
sys.CODE("C9"); (* leave *)
sys.CODE("C20400"); (* ret 04h *)
RETURN 0
END sysfunc1;
PROCEDURE [stdcall] sysfunc2(arg1, arg2: INTEGER): INTEGER;
BEGIN
sys.CODE("53"); (* push ebx *)
sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *)
sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *)
sys.CODE("CD40"); (* int 40h *)
sys.CODE("5B"); (* pop ebx *)
sys.CODE("C9"); (* leave *)
sys.CODE("C20800"); (* ret 08h *)
RETURN 0
END sysfunc2;
PROCEDURE [stdcall] sysfunc3(arg1, arg2, arg3: INTEGER): INTEGER;
BEGIN
sys.CODE("53"); (* push ebx *)
sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *)
sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *)
sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *)
sys.CODE("CD40"); (* int 40h *)
sys.CODE("5B"); (* pop ebx *)
sys.CODE("C9"); (* leave *)
sys.CODE("C20C00"); (* ret 0Ch *)
RETURN 0
END sysfunc3;
PROCEDURE [stdcall] sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER;
BEGIN
sys.CODE("53"); (* push ebx *)
sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *)
sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *)
sys.CODE("CD40"); (* int 40h *)
sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *)
sys.CODE("8919"); (* mov [ecx], ebx *)
sys.CODE("5B"); (* pop ebx *)
sys.CODE("C9"); (* leave *)
sys.CODE("C20C00"); (* ret 0Ch *)
RETURN 0
END sysfunc22;
PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER;
VAR cur, procname, adr: INTEGER;
PROCEDURE streq(str1, str2: INTEGER): BOOLEAN;
VAR c1, c2: CHAR;
BEGIN
REPEAT
sys.GET(str1, c1);
sys.GET(str2, c2);
INC(str1);
INC(str2)
UNTIL (c1 # c2) OR (c1 = 0X)
RETURN c1 = c2
END streq;
BEGIN
adr := 0;
IF (lib # 0) & (name # "") THEN
cur := lib;
REPEAT
sys.GET(cur, procname);
INC(cur, 8)
UNTIL (procname = 0) OR streq(procname, sys.ADR(name[0]));
IF procname # 0 THEN
sys.GET(cur - 4, adr)
END
END
RETURN adr
END GetProcAdr;
PROCEDURE Time*(VAR sec, dsec: INTEGER);
VAR t: INTEGER;
BEGIN
t := sysfunc2(26, 9);
sec := t DIV 100;
dsec := t MOD 100
END Time;
PROCEDURE init*;
VAR Lib: INTEGER;
PROCEDURE GetProc(v: INTEGER; name: ARRAY OF CHAR);
VAR a: INTEGER;
BEGIN
a := GetProcAdr(name, Lib);
sys.PUT(v, a)
END GetProc;
BEGIN
Time(sec, dsec);
Lib := sysfunc3(68, 19, sys.ADR("/rd/1/lib/console.obj"));
IF Lib # 0 THEN
GetProc(sys.ADR(con_init), "con_init");
GetProc(sys.ADR(con_exit), "con_exit");
GetProc(sys.ADR(con_write_asciiz), "con_write_asciiz");
IF con_init # NIL THEN
con_init(-1, -1, -1, -1, sys.ADR("Oberon-07/11 for KolibriOS"))
END
END
END init;
PROCEDURE ExitProcess* (n: INTEGER);
BEGIN
IF con_exit # NIL THEN
con_exit(FALSE)
END;
n := sysfunc1(-1)
END ExitProcess;
PROCEDURE GetCommandLine*(): INTEGER;
VAR param: INTEGER;
BEGIN
sys.GET(28, param)
RETURN param
END GetCommandLine;
PROCEDURE GetName*(): INTEGER;
VAR name: INTEGER;
BEGIN
sys.GET(32, name)
RETURN name
END GetName;
PROCEDURE malloc*(size: INTEGER): INTEGER;
RETURN sysfunc3(68, 12, size)
END malloc;
PROCEDURE CloseFile*(hObject: INTEGER);
VAR pFS: POINTER TO OFSTRUCT;
BEGIN
sys.PUT(sys.ADR(pFS), hObject);
DISPOSE(pFS)
END CloseFile;
PROCEDURE _OCFile(FileName: ARRAY OF CHAR; VAR FS: OFSTRUCT; mode: INTEGER; VAR fsize: INTEGER): INTEGER;
VAR buf: ARRAY 40 OF CHAR; res: INTEGER;
BEGIN
FS.subfunc := mode;
FS.pos := 0;
FS.hpos := 0;
FS.bytes := 0;
FS.buf := sys.ADR(buf);
COPY(FileName, FS.name);
IF sysfunc22(70, sys.ADR(FS), res) = 0 THEN
res := sys.ADR(FS);
sys.GET(sys.ADR(buf) + 32, fsize)
ELSE
res := 0
END
RETURN res
END _OCFile;
PROCEDURE IOFile(VAR FS: OFSTRUCT; Buffer, bytes, io: INTEGER): INTEGER;
VAR res1, res: INTEGER;
BEGIN
FS.subfunc := io;
FS.bytes := bytes;
FS.buf := Buffer;
res1 := sysfunc22(70, sys.ADR(FS), res);
IF res = -1 THEN
res := 0
END;
FS.pos := FS.pos + res
RETURN res
END IOFile;
PROCEDURE OCFile(FName: ARRAY OF CHAR; mode: INTEGER): INTEGER;
VAR FS: OFSTRUCT; pFS: POINTER TO OFSTRUCT; res: INTEGER;
BEGIN
IF _OCFile(FName, FS, mode, fsize) # 0 THEN
NEW(pFS);
IF pFS = NIL THEN
res := 0
ELSE
sys.GET(sys.ADR(pFS), res);
pFS^ := FS
END
ELSE
res := 0
END
RETURN res
END OCFile;
PROCEDURE CreateFile* (FName: ARRAY OF CHAR): INTEGER;
RETURN OCFile(FName, 2)
END CreateFile;
PROCEDURE OpenFile* (FName: ARRAY OF CHAR): INTEGER;
RETURN OCFile(FName, 5)
END OpenFile;
PROCEDURE FileSize* (F: INTEGER): INTEGER;
RETURN fsize
END FileSize;
PROCEDURE FileRW* (hFile, Buffer, nNumberOfBytes: INTEGER; write: BOOLEAN): INTEGER;
VAR pFS: POINTER TO OFSTRUCT; res: INTEGER;
BEGIN
IF hFile # 0 THEN
sys.PUT(sys.ADR(pFS), hFile);
res := IOFile(pFS^, Buffer, nNumberOfBytes, 3 * ORD(write))
ELSE
res := 0
END
RETURN res
END FileRW;
PROCEDURE OutString* (str: ARRAY OF CHAR);
VAR n: INTEGER;
BEGIN
n := ORD(str[0] = 3X);
IF con_write_asciiz # NIL THEN
con_write_asciiz(sys.ADR(str[n]))
ELSE
API.DebugMsg(sys.ADR(str[n]), 0)
END
END OutString;
END HOST.