Subversion Repositories Kolibri OS

(*

    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 .

*)

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.