diff --git a/drivers/examples/oberon_drv/API.ob07 b/drivers/examples/oberon_drv/API.ob07 new file mode 100644 index 0000000000..f093528e10 --- /dev/null +++ b/drivers/examples/oberon_drv/API.ob07 @@ -0,0 +1,122 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018-2022, Anton Krotov + All rights reserved. +*) + +MODULE API; + +IMPORT SYSTEM; + +CONST + eol* = 0DX + 0AX; + BIT_DEPTH* = 32; + +VAR + action*, cmdline*: INTEGER; + + +PROCEDURE [stdcall-] sysfunc3* (arg1, arg2, arg3: INTEGER): INTEGER; +BEGIN + SYSTEM.CODE( + 053H, (* push ebx *) + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *) + 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) + 0CDH, 040H, (* int 64 *) + 05BH, (* pop ebx *) + 0C9H, (* leave *) + 0C2H, 00CH, 000H (* ret 12 *) + ) + RETURN 0 +END sysfunc3; + + +PROCEDURE OutChar* (c: CHAR); +BEGIN + sysfunc3(63, 1, ORD(c)) +END OutChar; + + +PROCEDURE OutLn*; +BEGIN + OutChar(0DX); + OutChar(0AX) +END OutLn; + + +PROCEDURE OutStr (pchar: INTEGER); +VAR + c: CHAR; +BEGIN + IF pchar # 0 THEN + REPEAT + SYSTEM.GET(pchar, c); + IF c # 0X THEN + OutChar(c) + END; + INC(pchar) + UNTIL c = 0X + END +END OutStr; + + +PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); +BEGIN + IF lpCaption # 0 THEN + OutLn; + OutStr(lpCaption); + OutChar(":"); + OutLn + END; + OutStr(lpText); + IF lpCaption # 0 THEN + OutLn + END +END DebugMsg; + + +PROCEDURE _NEW* (size: INTEGER): INTEGER; + RETURN sysfunc3(68, 12, size) +END _NEW; + + +PROCEDURE _DISPOSE* (ptr: INTEGER): INTEGER; +BEGIN + sysfunc3(68, 13, ptr) + RETURN 0 +END _DISPOSE; + + +PROCEDURE init* (reserved, code: INTEGER); +BEGIN + sysfunc3(68, 11, 0) +END init; + + +PROCEDURE exit* (code: INTEGER); +BEGIN + sysfunc3(-1, 0, 0) +END exit; + + +PROCEDURE exit_thread* (code: INTEGER); +BEGIN + sysfunc3(-1, 0, 0) +END exit_thread; + + +PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; +BEGIN + action := hinstDLL; + cmdline := fdwReason + RETURN action +END dllentry; + + +PROCEDURE sofinit*; +END sofinit; + + +END API. \ No newline at end of file diff --git a/drivers/examples/oberon_drv/RTL.ob07 b/drivers/examples/oberon_drv/RTL.ob07 new file mode 100644 index 0000000000..0818bca97d --- /dev/null +++ b/drivers/examples/oberon_drv/RTL.ob07 @@ -0,0 +1,543 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018-2021, Anton Krotov + All rights reserved. +*) + +MODULE RTL; + +IMPORT SYSTEM, API; + + +CONST + + minint = ROR(1, 1); + + WORD = API.BIT_DEPTH DIV 8; + + +VAR + + name: INTEGER; + types: INTEGER; + + +PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER); +BEGIN + SYSTEM.CODE( + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 085H, 0C0H, (* test eax, eax *) + 07EH, 019H, (* jle L *) + 0FCH, (* cld *) + 057H, (* push edi *) + 056H, (* push esi *) + 08BH, 075H, 010H, (* mov esi, dword [ebp + 16] *) + 08BH, 07DH, 00CH, (* mov edi, dword [ebp + 12] *) + 089H, 0C1H, (* mov ecx, eax *) + 0C1H, 0E9H, 002H, (* shr ecx, 2 *) + 0F3H, 0A5H, (* rep movsd *) + 089H, 0C1H, (* mov ecx, eax *) + 083H, 0E1H, 003H, (* and ecx, 3 *) + 0F3H, 0A4H, (* rep movsb *) + 05EH, (* pop esi *) + 05FH (* pop edi *) + (* L: *) + ) +END _move; + + +PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + IF len_src > len_dst THEN + res := FALSE + ELSE + _move(len_src * base_size, dst, src); + res := TRUE + END + + RETURN res +END _arrcpy; + + +PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); +BEGIN + _move(MIN(len_dst, len_src) * chr_size, dst, src) +END _strcpy; + + +PROCEDURE [stdcall] _rot* (Len, Ptr: INTEGER); +BEGIN + SYSTEM.CODE( + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- Len *) + 08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- Ptr *) + 049H, (* dec ecx *) + 053H, (* push ebx *) + 08BH, 018H, (* mov ebx, dword [eax] *) + (* L: *) + 08BH, 050H, 004H, (* mov edx, dword [eax + 4] *) + 089H, 010H, (* mov dword [eax], edx *) + 083H, 0C0H, 004H, (* add eax, 4 *) + 049H, (* dec ecx *) + 075H, 0F5H, (* jnz L *) + 089H, 018H, (* mov dword [eax], ebx *) + 05BH, (* pop ebx *) + 05DH, (* pop ebp *) + 0C2H, 008H, 000H (* ret 8 *) + ) +END _rot; + + +PROCEDURE [stdcall] _set* (b, a: INTEGER); (* {a..b} -> eax *) +BEGIN + SYSTEM.CODE( + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- b *) + 08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- a *) + 039H, 0C8H, (* cmp eax, ecx *) + 07FH, 033H, (* jg L1 *) + 083H, 0F8H, 01FH, (* cmp eax, 31 *) + 07FH, 02EH, (* jg L1 *) + 085H, 0C9H, (* test ecx, ecx *) + 07CH, 02AH, (* jl L1 *) + 083H, 0F9H, 01FH, (* cmp ecx, 31 *) + 07EH, 005H, (* jle L3 *) + 0B9H, 01FH, 000H, 000H, 000H, (* mov ecx, 31 *) + (* L3: *) + 085H, 0C0H, (* test eax, eax *) + 07DH, 002H, (* jge L2 *) + 031H, 0C0H, (* xor eax, eax *) + (* L2: *) + 089H, 0CAH, (* mov edx, ecx *) + 029H, 0C2H, (* sub edx, eax *) + 0B8H, 000H, 000H, 000H, 080H, (* mov eax, 0x80000000 *) + 087H, 0CAH, (* xchg edx, ecx *) + 0D3H, 0F8H, (* sar eax, cl *) + 087H, 0CAH, (* xchg edx, ecx *) + 083H, 0E9H, 01FH, (* sub ecx, 31 *) + 0F7H, 0D9H, (* neg ecx *) + 0D3H, 0E8H, (* shr eax, cl *) + 05DH, (* pop ebp *) + 0C2H, 008H, 000H, (* ret 8 *) + (* L1: *) + 031H, 0C0H, (* xor eax, eax *) + 05DH, (* pop ebp *) + 0C2H, 008H, 000H (* ret 8 *) + ) +END _set; + + +PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *) +BEGIN + SYSTEM.CODE( + 031H, 0C0H, (* xor eax, eax *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- a *) + 083H, 0F9H, 01FH, (* cmp ecx, 31 *) + 077H, 003H, (* ja L *) + 00FH, 0ABH, 0C8H (* bts eax, ecx *) + (* L: *) + ) +END _set1; + + +PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *) +BEGIN + SYSTEM.CODE( + 053H, (* push ebx *) + 08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- x *) + 031H, 0D2H, (* xor edx, edx *) + 085H, 0C0H, (* test eax, eax *) + 074H, 018H, (* je L2 *) + 07FH, 002H, (* jg L1 *) + 0F7H, 0D2H, (* not edx *) + (* L1: *) + 089H, 0C3H, (* mov ebx, eax *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- y *) + 0F7H, 0F9H, (* idiv ecx *) + 085H, 0D2H, (* test edx, edx *) + 074H, 009H, (* je L2 *) + 031H, 0CBH, (* xor ebx, ecx *) + 085H, 0DBH, (* test ebx, ebx *) + 07DH, 003H, (* jge L2 *) + 048H, (* dec eax *) + 001H, 0CAH, (* add edx, ecx *) + (* L2: *) + 05BH (* pop ebx *) + ) +END _divmod; + + +PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); +BEGIN + ptr := API._NEW(size); + IF ptr # 0 THEN + SYSTEM.PUT(ptr, t); + INC(ptr, WORD) + END +END _new; + + +PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER); +BEGIN + IF ptr # 0 THEN + ptr := API._DISPOSE(ptr - WORD) + END +END _dispose; + + +PROCEDURE [stdcall] _length* (len, str: INTEGER); +BEGIN + SYSTEM.CODE( + 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) + 048H, (* dec eax *) + (* L1: *) + 040H, (* inc eax *) + 080H, 038H, 000H, (* cmp byte [eax], 0 *) + 074H, 003H, (* jz L2 *) + 0E2H, 0F8H, (* loop L1 *) + 040H, (* inc eax *) + (* L2: *) + 02BH, 045H, 00CH (* sub eax, dword [ebp + 0Ch] *) + ) +END _length; + + +PROCEDURE [stdcall] _lengthw* (len, str: INTEGER); +BEGIN + SYSTEM.CODE( + 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) + 048H, (* dec eax *) + 048H, (* dec eax *) + (* L1: *) + 040H, (* inc eax *) + 040H, (* inc eax *) + 066H, 083H, 038H, 000H, (* cmp word [eax], 0 *) + 074H, 004H, (* jz L2 *) + 0E2H, 0F6H, (* loop L1 *) + 040H, (* inc eax *) + 040H, (* inc eax *) + (* L2: *) + 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *) + 0D1H, 0E8H (* shr eax, 1 *) + ) +END _lengthw; + + +PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER; +BEGIN + SYSTEM.CODE( + 056H, (* push esi *) + 057H, (* push edi *) + 053H, (* push ebx *) + 08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *) + 08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *) + 08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *) + 031H, 0C9H, (* xor ecx, ecx *) + 031H, 0D2H, (* xor edx, edx *) + 0B8H, + 000H, 000H, 000H, 080H, (* mov eax, minint *) + (* L1: *) + 085H, 0DBH, (* test ebx, ebx *) + 07EH, 017H, (* jle L3 *) + 08AH, 00EH, (* mov cl, byte[esi] *) + 08AH, 017H, (* mov dl, byte[edi] *) + 046H, (* inc esi *) + 047H, (* inc edi *) + 04BH, (* dec ebx *) + 039H, 0D1H, (* cmp ecx, edx *) + 074H, 006H, (* je L2 *) + 089H, 0C8H, (* mov eax, ecx *) + 029H, 0D0H, (* sub eax, edx *) + 0EBH, 006H, (* jmp L3 *) + (* L2: *) + 085H, 0C9H, (* test ecx, ecx *) + 075H, 0E7H, (* jne L1 *) + 031H, 0C0H, (* xor eax, eax *) + (* L3: *) + 05BH, (* pop ebx *) + 05FH, (* pop edi *) + 05EH, (* pop esi *) + 05DH, (* pop ebp *) + 0C2H, 00CH, 000H (* ret 12 *) + ) + RETURN 0 +END strncmp; + + +PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER; +BEGIN + SYSTEM.CODE( + 056H, (* push esi *) + 057H, (* push edi *) + 053H, (* push ebx *) + 08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *) + 08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *) + 08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *) + 031H, 0C9H, (* xor ecx, ecx *) + 031H, 0D2H, (* xor edx, edx *) + 0B8H, + 000H, 000H, 000H, 080H, (* mov eax, minint *) + (* L1: *) + 085H, 0DBH, (* test ebx, ebx *) + 07EH, 01BH, (* jle L3 *) + 066H, 08BH, 00EH, (* mov cx, word[esi] *) + 066H, 08BH, 017H, (* mov dx, word[edi] *) + 046H, (* inc esi *) + 046H, (* inc esi *) + 047H, (* inc edi *) + 047H, (* inc edi *) + 04BH, (* dec ebx *) + 039H, 0D1H, (* cmp ecx, edx *) + 074H, 006H, (* je L2 *) + 089H, 0C8H, (* mov eax, ecx *) + 029H, 0D0H, (* sub eax, edx *) + 0EBH, 006H, (* jmp L3 *) + (* L2: *) + 085H, 0C9H, (* test ecx, ecx *) + 075H, 0E3H, (* jne L1 *) + 031H, 0C0H, (* xor eax, eax *) + (* L3: *) + 05BH, (* pop ebx *) + 05FH, (* pop edi *) + 05EH, (* pop esi *) + 05DH, (* pop ebp *) + 0C2H, 00CH, 000H (* ret 12 *) + ) + RETURN 0 +END strncmpw; + + +PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; +VAR + res: INTEGER; + bRes: BOOLEAN; + c: CHAR; + +BEGIN + res := strncmp(str1, str2, MIN(len1, len2)); + IF res = minint THEN + IF len1 > len2 THEN + SYSTEM.GET(str1 + len2, c); + res := ORD(c) + ELSIF len1 < len2 THEN + SYSTEM.GET(str2 + len1, c); + res := -ORD(c) + ELSE + res := 0 + END + END; + + CASE op OF + |0: bRes := res = 0 + |1: bRes := res # 0 + |2: bRes := res < 0 + |3: bRes := res <= 0 + |4: bRes := res > 0 + |5: bRes := res >= 0 + END + + RETURN bRes +END _strcmp; + + +PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; +VAR + res: INTEGER; + bRes: BOOLEAN; + c: WCHAR; + +BEGIN + res := strncmpw(str1, str2, MIN(len1, len2)); + IF res = minint THEN + IF len1 > len2 THEN + SYSTEM.GET(str1 + len2 * 2, c); + res := ORD(c) + ELSIF len1 < len2 THEN + SYSTEM.GET(str2 + len1 * 2, c); + res := -ORD(c) + ELSE + res := 0 + END + END; + + CASE op OF + |0: bRes := res = 0 + |1: bRes := res # 0 + |2: bRes := res < 0 + |3: bRes := res <= 0 + |4: bRes := res > 0 + |5: bRes := res >= 0 + END + + RETURN bRes +END _strcmpw; + + +PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); +VAR + c: CHAR; + i: INTEGER; + +BEGIN + i := 0; + REPEAT + SYSTEM.GET(pchar, c); + s[i] := c; + INC(pchar); + INC(i) + UNTIL c = 0X +END PCharToStr; + + +PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR); +VAR + i, a: INTEGER; + +BEGIN + i := 0; + a := x; + REPEAT + INC(i); + a := a DIV 10 + UNTIL a = 0; + + str[i] := 0X; + + REPEAT + DEC(i); + str[i] := CHR(x MOD 10 + ORD("0")); + x := x DIV 10 + UNTIL x = 0 +END IntToStr; + + +PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); +VAR + n1, n2: INTEGER; + +BEGIN + n1 := LENGTH(s1); + n2 := LENGTH(s2); + + ASSERT(n1 + n2 < LEN(s1)); + + SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2); + s1[n1 + n2] := 0X +END append; + + +PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER); +VAR + s, temp: ARRAY 1024 OF CHAR; + +BEGIN + CASE err OF + | 1: s := "assertion failure" + | 2: s := "NIL dereference" + | 3: s := "bad divisor" + | 4: s := "NIL procedure call" + | 5: s := "type guard error" + | 6: s := "index out of range" + | 7: s := "invalid CASE" + | 8: s := "array assignment error" + | 9: s := "CHR out of range" + |10: s := "WCHR out of range" + |11: s := "BYTE out of range" + END; + + append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp); + append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp); + + API.DebugMsg(SYSTEM.ADR(s[0]), name); + + API.exit_thread(0) +END _error; + + +PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER; +BEGIN + SYSTEM.GET(t0 + t1 + types, t0) + RETURN t0 MOD 2 +END _isrec; + + +PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER; +BEGIN + IF p # 0 THEN + SYSTEM.GET(p - WORD, p); + SYSTEM.GET(t0 + p + types, p) + END + + RETURN p MOD 2 +END _is; + + +PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER; +BEGIN + SYSTEM.GET(t0 + t1 + types, t0) + RETURN t0 MOD 2 +END _guardrec; + + +PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER; +BEGIN + SYSTEM.GET(p, p); + IF p # 0 THEN + SYSTEM.GET(p - WORD, p); + SYSTEM.GET(t0 + p + types, p) + ELSE + p := 1 + END + + RETURN p MOD 2 +END _guard; + + +PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; + RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) +END _dllentry; + + +PROCEDURE [stdcall] _sofinit*; +BEGIN + API.sofinit +END _sofinit; + + +PROCEDURE [stdcall] _exit* (code: INTEGER); +BEGIN + API.exit(code) +END _exit; + + +PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER); +VAR + t0, t1, i, j: INTEGER; + +BEGIN + SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *) + API.init(param, code); + + types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER)); + ASSERT(types # 0); + FOR i := 0 TO tcount - 1 DO + FOR j := 0 TO tcount - 1 DO + t0 := i; t1 := j; + + WHILE (t1 # 0) & (t1 # t0) DO + SYSTEM.GET(_types + t1 * WORD, t1) + END; + + SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) + END + END; + + name := modname +END _init; + + +END RTL. \ No newline at end of file diff --git a/drivers/examples/oberon_drv/build.sh b/drivers/examples/oberon_drv/build.sh new file mode 100644 index 0000000000..4519d1621b --- /dev/null +++ b/drivers/examples/oberon_drv/build.sh @@ -0,0 +1,3 @@ +#SHS +/kolibrios/develop/oberon07/compiler.kex drv.ob07 win32dll -out /tmp0/1/test_drv.sys +exit \ No newline at end of file diff --git a/drivers/examples/oberon_drv/drv.ob07 b/drivers/examples/oberon_drv/drv.ob07 new file mode 100644 index 0000000000..4f5d3e32ec --- /dev/null +++ b/drivers/examples/oberon_drv/drv.ob07 @@ -0,0 +1,53 @@ +MODULE drv; + +IMPORT SYSTEM, API; + +TYPE + ioctl_t = RECORD + handle, + io_code, + input, + inp_size, + output, + out_size: INTEGER + END; + + +PROCEDURE [stdcall-, "core.dll", ""] RegService (name, adr: INTEGER): INTEGER; + +PROCEDURE [stdcall] service_proc (my_ctl: ioctl_t): INTEGER; +VAR + a, b, res: INTEGER; +BEGIN + IF my_ctl.io_code = 0 THEN + SYSTEM.GET(my_ctl.input, a); + SYSTEM.GET(my_ctl.input + SYSTEM.SIZE(INTEGER), b); + SYSTEM.PUT(my_ctl.output, a + b); + res := 0 + ELSE + res := -1 + END + RETURN res +END service_proc; + + +PROCEDURE [stdcall-] entry (action: INTEGER; cmdline: INTEGER): INTEGER; +VAR + res: INTEGER; +BEGIN + IF action = 1 THEN + res := RegService(SYSTEM.SADR("test_drv"), SYSTEM.ADR(service_proc)) + ELSE + res := 0 + END + RETURN res +END entry; + + +BEGIN + entry(API.action, API.cmdline); + SYSTEM.CODE( + 0C9H, (* leave *) + 0C3H (* ret *) + ) +END drv. \ No newline at end of file