(*
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 [stdcall] malloc*(size: INTEGER): INTEGER;
BEGIN
sys.CODE("60"); (* pusha *)
size := sysfunc3(68, 12, size);
sys.CODE("61") (* popa *)
RETURN size
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
Lib := sysfunc3(68, 19, sys.ADR(name[0]));
IF Lib # 0 THEN
init(Lib)
END
RETURN Lib
END LoadLib;
BEGIN
DLL_INIT := dll_Init
END KOSAPI.