forked from KolibriOS/kolibrios
oberon07: update library
git-svn-id: svn://kolibrios.org@9646 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
Anton Krotov
parent
e2efa4256f
commit
ba891ca6a6
Binary file not shown.
@ -1,7 +1,7 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018, 2020-2021, Anton Krotov
|
||||
Copyright (c) 2018, 2020-2022, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
@ -36,7 +36,7 @@ VAR
|
||||
|
||||
CriticalSection: CRITICAL_SECTION;
|
||||
|
||||
_import*, multi: BOOLEAN;
|
||||
multi: BOOLEAN;
|
||||
|
||||
base*: INTEGER;
|
||||
|
||||
@ -226,19 +226,6 @@ BEGIN
|
||||
END exit_thread;
|
||||
|
||||
|
||||
PROCEDURE OutChar (c: CHAR);
|
||||
BEGIN
|
||||
K.sysfunc3(63, 1, ORD(c))
|
||||
END OutChar;
|
||||
|
||||
|
||||
PROCEDURE OutLn;
|
||||
BEGIN
|
||||
OutChar(0DX);
|
||||
OutChar(0AX)
|
||||
END OutLn;
|
||||
|
||||
|
||||
PROCEDURE OutStr (pchar: INTEGER);
|
||||
VAR
|
||||
c: CHAR;
|
||||
@ -247,7 +234,7 @@ BEGIN
|
||||
REPEAT
|
||||
SYSTEM.GET(pchar, c);
|
||||
IF c # 0X THEN
|
||||
OutChar(c)
|
||||
K.OutChar(c)
|
||||
END;
|
||||
INC(pchar)
|
||||
UNTIL c = 0X
|
||||
@ -258,54 +245,25 @@ END OutStr;
|
||||
PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
|
||||
BEGIN
|
||||
IF lpCaption # 0 THEN
|
||||
OutLn;
|
||||
K.OutLn;
|
||||
OutStr(lpCaption);
|
||||
OutChar(":");
|
||||
OutLn
|
||||
K.OutChar(":");
|
||||
K.OutLn
|
||||
END;
|
||||
OutStr(lpText);
|
||||
IF lpCaption # 0 THEN
|
||||
OutLn
|
||||
K.OutLn
|
||||
END
|
||||
END DebugMsg;
|
||||
|
||||
|
||||
PROCEDURE OutString (s: ARRAY OF CHAR);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (i < LEN(s)) & (s[i] # 0X) DO
|
||||
OutChar(s[i]);
|
||||
INC(i)
|
||||
END
|
||||
END OutString;
|
||||
|
||||
|
||||
PROCEDURE imp_error;
|
||||
BEGIN
|
||||
OutString("import error: ");
|
||||
IF K.imp_error.error = 1 THEN
|
||||
OutString("can't load '"); OutString(K.imp_error.lib)
|
||||
ELSIF K.imp_error.error = 2 THEN
|
||||
OutString("not found '"); OutString(K.imp_error.proc); OutString("' in '"); OutString(K.imp_error.lib)
|
||||
END;
|
||||
OutString("'");
|
||||
OutLn
|
||||
END imp_error;
|
||||
|
||||
|
||||
PROCEDURE init* (import_, code: INTEGER);
|
||||
BEGIN
|
||||
multi := FALSE;
|
||||
base := code - SizeOfHeader;
|
||||
K.sysfunc2(68, 11);
|
||||
InitializeCriticalSection(CriticalSection);
|
||||
K._init;
|
||||
_import := (K.dll_Load(import_) = 0) & (K.imp_error.error = 0);
|
||||
IF ~_import THEN
|
||||
imp_error
|
||||
END
|
||||
K._init(import_)
|
||||
END init;
|
||||
|
||||
|
||||
|
||||
@ -539,7 +539,7 @@ BEGIN
|
||||
|
||||
maxreal := 1.9;
|
||||
PACK(maxreal, 1023);
|
||||
Console := API._import;
|
||||
Console := TRUE;
|
||||
IF Console THEN
|
||||
con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS"))
|
||||
END;
|
||||
|
||||
@ -19,13 +19,6 @@ VAR
|
||||
|
||||
DLL_INIT: PROCEDURE [stdcall] (entry: INTEGER);
|
||||
|
||||
imp_error*: RECORD
|
||||
|
||||
proc*, lib*: STRING;
|
||||
error*: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
|
||||
PROCEDURE [stdcall-] sysfunc1* (arg1: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
@ -176,7 +169,6 @@ END sysfunc22;
|
||||
PROCEDURE mem_commit (adr, size: INTEGER);
|
||||
VAR
|
||||
tmp: INTEGER;
|
||||
|
||||
BEGIN
|
||||
FOR tmp := adr TO adr + size - 1 BY 4096 DO
|
||||
SYSTEM.PUT(tmp, 0)
|
||||
@ -187,7 +179,6 @@ END mem_commit;
|
||||
PROCEDURE [stdcall] malloc* (size: INTEGER): INTEGER;
|
||||
VAR
|
||||
ptr: INTEGER;
|
||||
|
||||
BEGIN
|
||||
SYSTEM.CODE(060H); (* pusha *)
|
||||
IF sysfunc2(18, 16) > ASR(size, 10) THEN
|
||||
@ -227,7 +218,6 @@ PROCEDURE AppAdr (): INTEGER;
|
||||
VAR
|
||||
buf: ARRAY 1024 OF CHAR;
|
||||
a: INTEGER;
|
||||
|
||||
BEGIN
|
||||
a := sysfunc3(9, SYSTEM.ADR(buf), -1);
|
||||
SYSTEM.GET(SYSTEM.ADR(buf) + 22, a)
|
||||
@ -238,7 +228,6 @@ END AppAdr;
|
||||
PROCEDURE GetCommandLine* (): INTEGER;
|
||||
VAR
|
||||
param: INTEGER;
|
||||
|
||||
BEGIN
|
||||
SYSTEM.GET(28 + AppAdr(), param)
|
||||
RETURN param
|
||||
@ -248,7 +237,6 @@ END GetCommandLine;
|
||||
PROCEDURE GetName* (): INTEGER;
|
||||
VAR
|
||||
name: INTEGER;
|
||||
|
||||
BEGIN
|
||||
SYSTEM.GET(32 + AppAdr(), name)
|
||||
RETURN name
|
||||
@ -276,11 +264,9 @@ 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
|
||||
SYSTEM.GET(str1, c1);
|
||||
@ -292,7 +278,6 @@ VAR
|
||||
RETURN c1 = c2
|
||||
END streq;
|
||||
|
||||
|
||||
BEGIN
|
||||
adr := 0;
|
||||
IF (lib # 0) & (name # "") THEN
|
||||
@ -313,7 +298,6 @@ END GetProcAdr;
|
||||
PROCEDURE init (dll: INTEGER);
|
||||
VAR
|
||||
lib_init: INTEGER;
|
||||
|
||||
BEGIN
|
||||
lib_init := GetProcAdr("lib_init", dll);
|
||||
IF lib_init # 0 THEN
|
||||
@ -326,6 +310,44 @@ BEGIN
|
||||
END init;
|
||||
|
||||
|
||||
PROCEDURE OutChar* (c: CHAR);
|
||||
BEGIN
|
||||
sysfunc3(63, 1, ORD(c))
|
||||
END OutChar;
|
||||
|
||||
|
||||
PROCEDURE OutLn*;
|
||||
BEGIN
|
||||
OutChar(0DX);
|
||||
OutChar(0AX)
|
||||
END OutLn;
|
||||
|
||||
|
||||
PROCEDURE OutString (s: ARRAY OF CHAR);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (i < LEN(s)) & (s[i] # 0X) DO
|
||||
OutChar(s[i]);
|
||||
INC(i)
|
||||
END
|
||||
END OutString;
|
||||
|
||||
|
||||
PROCEDURE imp_error (lib, proc: STRING);
|
||||
BEGIN
|
||||
OutString("import error: ");
|
||||
IF proc = "" THEN
|
||||
OutString("can't load '")
|
||||
ELSE
|
||||
OutString("not found '"); OutString(proc); OutString("' in '")
|
||||
END;
|
||||
OutString(lib);
|
||||
OutString("'" + 0DX + 0AX)
|
||||
END imp_error;
|
||||
|
||||
|
||||
PROCEDURE GetStr (adr, i: INTEGER; VAR str: STRING);
|
||||
VAR
|
||||
c: CHAR;
|
||||
@ -337,63 +359,47 @@ BEGIN
|
||||
END GetStr;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] dll_Load* (import_table: INTEGER): INTEGER;
|
||||
PROCEDURE [stdcall-] dll_Load* (import_table: INTEGER): INTEGER;
|
||||
CONST
|
||||
path = "/sys/lib/";
|
||||
VAR
|
||||
imp, lib, exp, proc, res, pathLen: INTEGER;
|
||||
fail, done: BOOLEAN;
|
||||
imp, lib, exp, proc, pathLen: INTEGER;
|
||||
procname, libname: STRING;
|
||||
|
||||
BEGIN
|
||||
SYSTEM.CODE(060H); (* pusha *)
|
||||
fail := FALSE;
|
||||
done := FALSE;
|
||||
res := 0;
|
||||
libname := path;
|
||||
pathLen := LENGTH(libname);
|
||||
REPEAT
|
||||
SYSTEM.GET(import_table, imp);
|
||||
IF imp # 0 THEN
|
||||
SYSTEM.GET(import_table + 4, lib);
|
||||
GetStr(lib, pathLen, libname);
|
||||
exp := sysfunc3(68, 19, SYSTEM.ADR(libname[0]));
|
||||
fail := exp = 0;
|
||||
|
||||
SYSTEM.GET(import_table, imp);
|
||||
WHILE imp # 0 DO
|
||||
SYSTEM.GET(import_table + 4, lib);
|
||||
GetStr(lib, pathLen, libname);
|
||||
exp := sysfunc3(68, 19, SYSTEM.ADR(libname[0]));
|
||||
IF exp = 0 THEN
|
||||
imp_error(libname, "")
|
||||
ELSE
|
||||
done := TRUE
|
||||
END;
|
||||
IF fail THEN
|
||||
done := TRUE;
|
||||
imp_error.proc := "";
|
||||
imp_error.lib := libname;
|
||||
imp_error.error := 1
|
||||
END;
|
||||
IF (imp # 0) & ~fail THEN
|
||||
REPEAT
|
||||
SYSTEM.GET(imp, proc);
|
||||
IF proc # 0 THEN
|
||||
GetStr(proc, 0, procname);
|
||||
proc := GetProcAdr(procname, exp);
|
||||
IF proc # 0 THEN
|
||||
SYSTEM.PUT(imp, proc);
|
||||
INC(imp, 4)
|
||||
SYSTEM.PUT(imp, proc)
|
||||
ELSE
|
||||
imp_error.proc := procname;
|
||||
imp_error.lib := libname;
|
||||
imp_error.error := 2
|
||||
END
|
||||
proc := 1;
|
||||
imp_error(libname, procname)
|
||||
END;
|
||||
INC(imp, 4)
|
||||
END
|
||||
UNTIL proc = 0;
|
||||
init(exp);
|
||||
INC(import_table, 8)
|
||||
END
|
||||
UNTIL done;
|
||||
IF fail THEN
|
||||
res := 1
|
||||
init(exp)
|
||||
END;
|
||||
INC(import_table, 8);
|
||||
SYSTEM.GET(import_table, imp);
|
||||
END;
|
||||
import_table := res;
|
||||
|
||||
SYSTEM.CODE(061H) (* popa *)
|
||||
RETURN import_table
|
||||
RETURN 0
|
||||
END dll_Load;
|
||||
|
||||
|
||||
@ -410,7 +416,6 @@ END dll_Init;
|
||||
PROCEDURE LoadLib* (name: ARRAY OF CHAR): INTEGER;
|
||||
VAR
|
||||
Lib: INTEGER;
|
||||
|
||||
BEGIN
|
||||
DLL_INIT := dll_Init;
|
||||
Lib := sysfunc3(68, 19, SYSTEM.ADR(name[0]));
|
||||
@ -421,12 +426,10 @@ BEGIN
|
||||
END LoadLib;
|
||||
|
||||
|
||||
PROCEDURE _init*;
|
||||
PROCEDURE _init* (import_table: INTEGER);
|
||||
BEGIN
|
||||
DLL_INIT := dll_Init;
|
||||
imp_error.lib := "";
|
||||
imp_error.proc := "";
|
||||
imp_error.error := 0
|
||||
dll_Load(import_table)
|
||||
END _init;
|
||||
|
||||
|
||||
|
||||
@ -71,7 +71,7 @@ VAR
|
||||
|
||||
// calculate amount of valid chars in UTF-8 string
|
||||
// supports zero terminated string (set byteQuantity = -1)
|
||||
cntUTF_8 *: PROCEDURE (string, byteQuantity: INTEGER): INTEGER;
|
||||
countUTF8Z *: PROCEDURE (string, byteQuantity: INTEGER): INTEGER;
|
||||
|
||||
|
||||
// calculate amount of chars that fits given width
|
||||
@ -112,10 +112,10 @@ VAR Lib: INTEGER;
|
||||
BEGIN
|
||||
Lib := KOSAPI.LoadLib("/sys/lib/RasterWorks.obj");
|
||||
ASSERT(Lib # 0);
|
||||
GetProc(Lib, sys.ADR(drawText), "drawText");
|
||||
GetProc(Lib, sys.ADR(cntUTF_8), "cntUTF-8");
|
||||
GetProc(Lib, sys.ADR(charsFit), "charsFit");
|
||||
GetProc(Lib, sys.ADR(strWidth), "strWidth");
|
||||
GetProc(Lib, sys.ADR(drawText), "drawText");
|
||||
GetProc(Lib, sys.ADR(countUTF8Z), "countUTF8Z");
|
||||
GetProc(Lib, sys.ADR(charsFit), "charsFit");
|
||||
GetProc(Lib, sys.ADR(strWidth), "strWidth");
|
||||
END main;
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user