Egor00f/kolibrios
1
0
Fork 0
forked from KolibriOS/kolibrios
Code Pull Requests Activity

oberon07: update library

Browse Source 
git-svn-id: svn://kolibrios.org@9646 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
Anton Krotov 2022-01-16 07:38:55 +00:00
parent e2efa4256f
commit ba891ca6a6
5 changed files with 75 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
programs/develop/oberon07/Compiler.kex
View File

Binary file not shown.

58
programs/develop/oberon07/lib/KolibriOS/API.ob07
View File

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2020-2021, Anton Krotov Copyright (c) 2018, 2020-2022, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -36,7 +36,7 @@ VAR
CriticalSection: CRITICAL_SECTION; CriticalSection: CRITICAL_SECTION;
_import*, multi: BOOLEAN; multi: BOOLEAN;
base*: INTEGER; base*: INTEGER;
@ -226,19 +226,6 @@ BEGIN
END exit_thread; 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); PROCEDURE OutStr (pchar: INTEGER);
VAR VAR
c: CHAR; c: CHAR;
@ -247,7 +234,7 @@ BEGIN
REPEAT REPEAT
SYSTEM.GET(pchar, c); SYSTEM.GET(pchar, c);
IF c # 0X THEN IF c # 0X THEN
OutChar(c) K.OutChar(c)
END; END;
INC(pchar) INC(pchar)
UNTIL c = 0X UNTIL c = 0X
@ -258,54 +245,25 @@ END OutStr;
PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
BEGIN BEGIN
IF lpCaption # 0 THEN IF lpCaption # 0 THEN
OutLn; K.OutLn;
OutStr(lpCaption); OutStr(lpCaption);
OutChar(":"); K.OutChar(":");
OutLn K.OutLn
END; END;
OutStr(lpText); OutStr(lpText);
IF lpCaption # 0 THEN IF lpCaption # 0 THEN
OutLn K.OutLn
END END
END DebugMsg; 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); PROCEDURE init* (import_, code: INTEGER);
BEGIN BEGIN
multi := FALSE; multi := FALSE;
base := code - SizeOfHeader; base := code - SizeOfHeader;
K.sysfunc2(68, 11); K.sysfunc2(68, 11);
InitializeCriticalSection(CriticalSection); InitializeCriticalSection(CriticalSection);
K._init; K._init(import_)
_import := (K.dll_Load(import_) = 0) & (K.imp_error.error = 0);
IF ~_import THEN
imp_error
END
END init; END init;

2
programs/develop/oberon07/lib/KolibriOS/HOST.ob07
View File

@ -539,7 +539,7 @@ BEGIN
maxreal := 1.9; maxreal := 1.9;
PACK(maxreal, 1023); PACK(maxreal, 1023);
Console := API._import; Console := TRUE;
IF Console THEN IF Console THEN
con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS")) con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS"))
END; END;

119
programs/develop/oberon07/lib/KolibriOS/KOSAPI.ob07
View File

@ -19,13 +19,6 @@ VAR
DLL_INIT: PROCEDURE [stdcall] (entry: INTEGER); DLL_INIT: PROCEDURE [stdcall] (entry: INTEGER);
imp_error*: RECORD
proc*, lib*: STRING;
error*: INTEGER
END;
PROCEDURE [stdcall-] sysfunc1* (arg1: INTEGER): INTEGER; PROCEDURE [stdcall-] sysfunc1* (arg1: INTEGER): INTEGER;
BEGIN BEGIN
@ -176,7 +169,6 @@ END sysfunc22;
PROCEDURE mem_commit (adr, size: INTEGER); PROCEDURE mem_commit (adr, size: INTEGER);
VAR VAR
tmp: INTEGER; tmp: INTEGER;
BEGIN BEGIN
FOR tmp := adr TO adr + size - 1 BY 4096 DO FOR tmp := adr TO adr + size - 1 BY 4096 DO
SYSTEM.PUT(tmp, 0) SYSTEM.PUT(tmp, 0)
@ -187,7 +179,6 @@ END mem_commit;
PROCEDURE [stdcall] malloc* (size: INTEGER): INTEGER; PROCEDURE [stdcall] malloc* (size: INTEGER): INTEGER;
VAR VAR
ptr: INTEGER; ptr: INTEGER;
BEGIN BEGIN
SYSTEM.CODE(060H); (* pusha *) SYSTEM.CODE(060H); (* pusha *)
IF sysfunc2(18, 16) > ASR(size, 10) THEN IF sysfunc2(18, 16) > ASR(size, 10) THEN
@ -227,7 +218,6 @@ PROCEDURE AppAdr (): INTEGER;
VAR VAR
buf: ARRAY 1024 OF CHAR; buf: ARRAY 1024 OF CHAR;
a: INTEGER; a: INTEGER;
BEGIN BEGIN
a := sysfunc3(9, SYSTEM.ADR(buf), -1); a := sysfunc3(9, SYSTEM.ADR(buf), -1);
SYSTEM.GET(SYSTEM.ADR(buf) + 22, a) SYSTEM.GET(SYSTEM.ADR(buf) + 22, a)
@ -238,7 +228,6 @@ END AppAdr;
PROCEDURE GetCommandLine* (): INTEGER; PROCEDURE GetCommandLine* (): INTEGER;
VAR VAR
param: INTEGER; param: INTEGER;
BEGIN BEGIN
SYSTEM.GET(28 + AppAdr(), param) SYSTEM.GET(28 + AppAdr(), param)
RETURN param RETURN param
@ -248,7 +237,6 @@ END GetCommandLine;
PROCEDURE GetName* (): INTEGER; PROCEDURE GetName* (): INTEGER;
VAR VAR
name: INTEGER; name: INTEGER;
BEGIN BEGIN
SYSTEM.GET(32 + AppAdr(), name) SYSTEM.GET(32 + AppAdr(), name)
RETURN name RETURN name
@ -276,11 +264,9 @@ PROCEDURE GetProcAdr* (name: ARRAY OF CHAR; lib: INTEGER): INTEGER;
VAR VAR
cur, procname, adr: INTEGER; cur, procname, adr: INTEGER;
PROCEDURE streq (str1, str2: INTEGER): BOOLEAN; PROCEDURE streq (str1, str2: INTEGER): BOOLEAN;
VAR VAR
c1, c2: CHAR; c1, c2: CHAR;
BEGIN BEGIN
REPEAT REPEAT
SYSTEM.GET(str1, c1); SYSTEM.GET(str1, c1);
@ -292,7 +278,6 @@ VAR
RETURN c1 = c2 RETURN c1 = c2
END streq; END streq;
BEGIN BEGIN
adr := 0; adr := 0;
IF (lib # 0) & (name # "") THEN IF (lib # 0) & (name # "") THEN
@ -313,7 +298,6 @@ END GetProcAdr;
PROCEDURE init (dll: INTEGER); PROCEDURE init (dll: INTEGER);
VAR VAR
lib_init: INTEGER; lib_init: INTEGER;
BEGIN BEGIN
lib_init := GetProcAdr("lib_init", dll); lib_init := GetProcAdr("lib_init", dll);
IF lib_init # 0 THEN IF lib_init # 0 THEN
@ -326,6 +310,44 @@ BEGIN
END init; 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); PROCEDURE GetStr (adr, i: INTEGER; VAR str: STRING);
VAR VAR
c: CHAR; c: CHAR;
@ -337,63 +359,47 @@ BEGIN
END GetStr; END GetStr;
PROCEDURE [stdcall] dll_Load* (import_table: INTEGER): INTEGER; PROCEDURE [stdcall-] dll_Load* (import_table: INTEGER): INTEGER;
CONST CONST
path = "/sys/lib/"; path = "/sys/lib/";
VAR VAR
imp, lib, exp, proc, res, pathLen: INTEGER; imp, lib, exp, proc, pathLen: INTEGER;
fail, done: BOOLEAN;
procname, libname: STRING; procname, libname: STRING;
BEGIN BEGIN
SYSTEM.CODE(060H); (* pusha *) SYSTEM.CODE(060H); (* pusha *)
fail := FALSE;
done := FALSE;
res := 0;
libname := path; libname := path;
pathLen := LENGTH(libname); pathLen := LENGTH(libname);
REPEAT
SYSTEM.GET(import_table, imp); SYSTEM.GET(import_table, imp);
IF imp # 0 THEN WHILE imp # 0 DO
SYSTEM.GET(import_table + 4, lib); SYSTEM.GET(import_table + 4, lib);
GetStr(lib, pathLen, libname); GetStr(lib, pathLen, libname);
exp := sysfunc3(68, 19, SYSTEM.ADR(libname[0])); exp := sysfunc3(68, 19, SYSTEM.ADR(libname[0]));
fail := exp = 0; IF exp = 0 THEN
imp_error(libname, "")
ELSE 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 REPEAT
SYSTEM.GET(imp, proc); SYSTEM.GET(imp, proc);
IF proc # 0 THEN IF proc # 0 THEN
GetStr(proc, 0, procname); GetStr(proc, 0, procname);
proc := GetProcAdr(procname, exp); proc := GetProcAdr(procname, exp);
IF proc # 0 THEN IF proc # 0 THEN
SYSTEM.PUT(imp, proc); SYSTEM.PUT(imp, proc)
INC(imp, 4)
ELSE ELSE
imp_error.proc := procname; proc := 1;
imp_error.lib := libname; imp_error(libname, procname)
imp_error.error := 2 END;
END INC(imp, 4)
END END
UNTIL proc = 0; UNTIL proc = 0;
init(exp); init(exp)
INC(import_table, 8) END;
END INC(import_table, 8);
UNTIL done; SYSTEM.GET(import_table, imp);
IF fail THEN
res := 1
END; END;
import_table := res;
SYSTEM.CODE(061H) (* popa *) SYSTEM.CODE(061H) (* popa *)
RETURN import_table RETURN 0
END dll_Load; END dll_Load;
@ -410,7 +416,6 @@ END dll_Init;
PROCEDURE LoadLib* (name: ARRAY OF CHAR): INTEGER; PROCEDURE LoadLib* (name: ARRAY OF CHAR): INTEGER;
VAR VAR
Lib: INTEGER; Lib: INTEGER;
BEGIN BEGIN
DLL_INIT := dll_Init; DLL_INIT := dll_Init;
Lib := sysfunc3(68, 19, SYSTEM.ADR(name[0])); Lib := sysfunc3(68, 19, SYSTEM.ADR(name[0]));
@ -421,12 +426,10 @@ BEGIN
END LoadLib; END LoadLib;
PROCEDURE _init*; PROCEDURE _init* (import_table: INTEGER);
BEGIN BEGIN
DLL_INIT := dll_Init; DLL_INIT := dll_Init;
imp_error.lib := ""; dll_Load(import_table)
imp_error.proc := "";
imp_error.error := 0
END _init; END _init;

10
programs/develop/oberon07/lib/KolibriOS/RasterWorks.ob07
View File

@ -71,7 +71,7 @@ VAR
// calculate amount of valid chars in UTF-8 string // calculate amount of valid chars in UTF-8 string
// supports zero terminated string (set byteQuantity = -1) // 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 // calculate amount of chars that fits given width
@ -112,10 +112,10 @@ VAR Lib: INTEGER;
BEGIN BEGIN
Lib := KOSAPI.LoadLib("/sys/lib/RasterWorks.obj"); Lib := KOSAPI.LoadLib("/sys/lib/RasterWorks.obj");
ASSERT(Lib # 0); ASSERT(Lib # 0);
GetProc(Lib, sys.ADR(drawText), "drawText"); GetProc(Lib, sys.ADR(drawText), "drawText");
GetProc(Lib, sys.ADR(cntUTF_8), "cntUTF-8"); GetProc(Lib, sys.ADR(countUTF8Z), "countUTF8Z");
GetProc(Lib, sys.ADR(charsFit), "charsFit"); GetProc(Lib, sys.ADR(charsFit), "charsFit");
GetProc(Lib, sys.ADR(strWidth), "strWidth"); GetProc(Lib, sys.ADR(strWidth), "strWidth");
END main; END main;