kolibrios/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07

(*
    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.