(*
    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 KOSAPI;

IMPORT sys := SYSTEM;

TYPE STRING = ARRAY 1024 OF CHAR;

VAR DLL_INIT: PROCEDURE [stdcall] (entry: 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] sysfunc4*(arg1, arg2, arg3, arg4: 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("8B5514");           (* mov     edx, [ebp + 14h] *)
  sys.CODE("CD40");             (* int     40h              *)
  sys.CODE("5B");               (* pop     ebx              *)
  sys.CODE("C9");               (* leave                    *)
  sys.CODE("C21000");           (* ret     10h              *)
  RETURN 0
END sysfunc4;

PROCEDURE [stdcall] sysfunc5*(arg1, arg2, arg3, arg4, arg5: INTEGER): INTEGER;
BEGIN
  sys.CODE("53");               (* push    ebx              *)
  sys.CODE("56");               (* push    esi              *)
  sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
  sys.CODE("8B5D0C");           (* mov     ebx, [ebp + 0Ch] *)
  sys.CODE("8B4D10");           (* mov     ecx, [ebp + 10h] *)
  sys.CODE("8B5514");           (* mov     edx, [ebp + 14h] *)
  sys.CODE("8B7518");           (* mov     esi, [ebp + 18h] *)
  sys.CODE("CD40");             (* int     40h              *)
  sys.CODE("5E");               (* pop     esi              *)
  sys.CODE("5B");               (* pop     ebx              *)
  sys.CODE("C9");               (* leave                    *)
  sys.CODE("C21400");           (* ret     14h              *)
  RETURN 0
END sysfunc5;

PROCEDURE [stdcall] sysfunc6*(arg1, arg2, arg3, arg4, arg5, arg6: INTEGER): INTEGER;
BEGIN
  sys.CODE("53");               (* push    ebx              *)
  sys.CODE("56");               (* push    esi              *)
  sys.CODE("57");               (* push    edi              *)
  sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
  sys.CODE("8B5D0C");           (* mov     ebx, [ebp + 0Ch] *)
  sys.CODE("8B4D10");           (* mov     ecx, [ebp + 10h] *)
  sys.CODE("8B5514");           (* mov     edx, [ebp + 14h] *)
  sys.CODE("8B7518");           (* mov     esi, [ebp + 18h] *)
  sys.CODE("8B7D1C");           (* mov     edi, [ebp + 1Ch] *)
  sys.CODE("CD40");             (* int     40h              *)
  sys.CODE("5F");               (* pop     edi              *)
  sys.CODE("5E");               (* pop     esi              *)
  sys.CODE("5B");               (* pop     ebx              *)
  sys.CODE("C9");               (* leave                    *)
  sys.CODE("C21800");           (* ret     18h              *)
  RETURN 0
END sysfunc6;

PROCEDURE [stdcall] sysfunc7*(arg1, arg2, arg3, arg4, arg5, arg6, arg7: INTEGER): INTEGER;
BEGIN
  sys.CODE("53");               (* push    ebx              *)
  sys.CODE("56");               (* push    esi              *)
  sys.CODE("57");               (* push    edi              *)
  sys.CODE("55");               (* push    ebp              *)
  sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
  sys.CODE("8B5D0C");           (* mov     ebx, [ebp + 0Ch] *)
  sys.CODE("8B4D10");           (* mov     ecx, [ebp + 10h] *)
  sys.CODE("8B5514");           (* mov     edx, [ebp + 14h] *)
  sys.CODE("8B7518");           (* mov     esi, [ebp + 18h] *)
  sys.CODE("8B7D1C");           (* mov     edi, [ebp + 1Ch] *)
  sys.CODE("8B6D20");           (* mov     ebp, [ebp + 20h] *)
  sys.CODE("CD40");             (* int     40h              *)
  sys.CODE("5D");               (* pop     ebp              *)
  sys.CODE("5F");               (* pop     edi              *)
  sys.CODE("5E");               (* pop     esi              *)
  sys.CODE("5B");               (* pop     ebx              *)
  sys.CODE("C9");               (* leave                    *)
  sys.CODE("C21C00");           (* ret     1Ch              *)
  RETURN 0
END sysfunc7;

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 mem_commit(adr, size: INTEGER);
VAR tmp: INTEGER;
BEGIN
  FOR tmp := adr TO adr + size - 1 BY 4096 DO
    sys.PUT(tmp, 0)
  END
END mem_commit;

PROCEDURE [stdcall] malloc*(size: INTEGER): INTEGER;
VAR ptr: INTEGER;
BEGIN
  sys.CODE("60"); (* pusha *)
  IF sysfunc2(18, 16) > ASR(size, 10) THEN
    ptr := sysfunc3(68, 12, size);
    IF ptr # 0 THEN
      mem_commit(ptr, size)
    END
  ELSE
    ptr := 0
  END;
  sys.CODE("61")  (* popa  *)
  RETURN ptr
END malloc;

PROCEDURE [stdcall] free*(ptr: INTEGER): INTEGER;
BEGIN
  sys.CODE("60"); (* pusha *)
  IF ptr # 0 THEN
    ptr := sysfunc3(68, 13, ptr)
  END;
  sys.CODE("61")  (* popa  *)
  RETURN 0
END free;

PROCEDURE [stdcall] realloc*(ptr, size: INTEGER): INTEGER;
BEGIN
  sys.CODE("60"); (* pusha *)
  ptr := sysfunc4(68, 20, size, ptr);
  sys.CODE("61")  (* popa  *)
  RETURN ptr
END realloc;

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 [stdcall] dll_init2(arg1, arg2, arg3, arg4, arg5: INTEGER);
BEGIN
  sys.CODE("60");               (* pusha                    *)
  sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
  sys.CODE("8B5D0C");           (* mov     ebx, [ebp + 0Ch] *)
  sys.CODE("8B4D10");           (* mov     ecx, [ebp + 10h] *)
  sys.CODE("8B5514");           (* mov     edx, [ebp + 14h] *)
  sys.CODE("8B7518");           (* mov     esi, [ebp + 18h] *)
  sys.CODE("FFD6");             (* call    esi              *)
  sys.CODE("61");               (* popa                     *)
  sys.CODE("C9");               (* leave                    *)
  sys.CODE("C21400");           (* ret     14h              *)
END dll_init2;

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 init(dll: INTEGER);
VAR lib_init: INTEGER;
BEGIN
  lib_init := GetProcAdr("lib_init", dll);
  IF lib_init # 0 THEN
    DLL_INIT(lib_init)
  END;
  lib_init := GetProcAdr("START", dll);
  IF lib_init # 0 THEN
    DLL_INIT(lib_init)
  END;
END init;

PROCEDURE [stdcall] dll_Load(import_table: INTEGER): INTEGER;
VAR imp, lib, exp, proc, res: INTEGER;
    fail, done: BOOLEAN;
    procname, libname: STRING;

  PROCEDURE GetStr(adr, i: INTEGER; VAR str: STRING);
  VAR c: CHAR;
  BEGIN
    REPEAT
      sys.GET(adr, c); INC(adr);
      str[i] := c; INC(i)
    UNTIL c = 0X
  END GetStr;

BEGIN
  sys.CODE("60"); (* pusha *)
  fail := FALSE;
  done := FALSE;
  res := 0;
  libname := "/rd/1/lib/";
  REPEAT
    sys.GET(import_table, imp);
    IF imp # 0 THEN
      sys.GET(import_table + 4, lib);
      GetStr(lib, 10, libname);
      exp := sysfunc3(68, 19, sys.ADR(libname[0]));
      fail := exp = 0;
    ELSE
      done := TRUE
    END;
    IF fail THEN
      done := TRUE
    END;
    IF (imp # 0) & ~fail THEN
      REPEAT
	sys.GET(imp, proc);
	IF proc # 0 THEN
	  GetStr(proc, 0, procname);
	  proc := GetProcAdr(procname, exp);
	  IF proc # 0 THEN
	    sys.PUT(imp, proc);
	    INC(imp, 4);
	  END
	END
      UNTIL proc = 0;
      init(exp);
      INC(import_table, 8)
    END
  UNTIL done;
  IF fail THEN
    res := 1
  END;
  import_table := res;
  sys.CODE("61") (* popa *)
  RETURN import_table
END dll_Load;

PROCEDURE [stdcall] dll_Init(entry: INTEGER);
BEGIN
  sys.CODE("60"); (* pusha *)
  IF entry # 0 THEN
    dll_init2(sys.ADR(malloc), sys.ADR(free), sys.ADR(realloc), sys.ADR(dll_Load), entry)
  END;
  sys.CODE("61"); (* popa  *)
END dll_Init;

PROCEDURE LoadLib*(name: ARRAY OF CHAR): INTEGER;
VAR Lib: INTEGER;
BEGIN
  DLL_INIT := dll_Init;
  Lib := sysfunc3(68, 19, sys.ADR(name[0]));
  IF Lib # 0 THEN
    init(Lib)
  END
  RETURN Lib
END LoadLib;

END KOSAPI.