| /programs/develop/oberon07/Lib/Linux32/API.ob07 |
|---|
| 0,0 → 1,143 |
| (* |
| 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 API; |
| IMPORT sys := SYSTEM; |
| TYPE |
| TP* = ARRAY 2 OF INTEGER; |
| VAR |
| Param*: INTEGER; |
| sec* : INTEGER; |
| dsec* : INTEGER; |
| stdin* : INTEGER; |
| stdout* : INTEGER; |
| stderr* : INTEGER; |
| dlopen* : PROCEDURE [cdecl] (filename, flag: INTEGER): INTEGER; |
| dlsym* : PROCEDURE [cdecl] (handle, symbol: INTEGER): INTEGER; |
| _malloc* : PROCEDURE [cdecl] (size: INTEGER): INTEGER; |
| free* : PROCEDURE [cdecl] (ptr: INTEGER); |
| fopen* : PROCEDURE [cdecl] (fname, fmode: INTEGER): INTEGER; |
| fclose*, ftell* : PROCEDURE [cdecl] (file: INTEGER): INTEGER; |
| fwrite*, fread* : PROCEDURE [cdecl] (buffer, bytes, blocks, file: INTEGER): INTEGER; |
| fseek* : PROCEDURE [cdecl] (file, offset, origin: INTEGER): INTEGER; |
| exit* : PROCEDURE [cdecl] (code: INTEGER); |
| strncmp* : PROCEDURE [cdecl] (str1, str2, n: INTEGER): INTEGER; |
| strlen* : PROCEDURE [cdecl] (str: INTEGER): INTEGER; |
| clock_gettime* : PROCEDURE [cdecl] (clock_id: INTEGER; VAR tp: TP): INTEGER; |
| PROCEDURE [stdcall] zeromem* (size, adr: INTEGER); |
| BEGIN |
| sys.CODE("578B7D0C8B4D0833C09CFCF3AB9D5F") |
| END zeromem; |
| PROCEDURE Align(n, m: INTEGER): INTEGER; |
| RETURN n + (m - n MOD m) MOD m |
| END Align; |
| PROCEDURE malloc* (Bytes: INTEGER): INTEGER; |
| VAR res: INTEGER; |
| BEGIN |
| Bytes := Align(Bytes, 4); |
| res := _malloc(Bytes); |
| IF res # 0 THEN |
| zeromem(ASR(Bytes, 2), res) |
| END |
| RETURN res |
| END malloc; |
| PROCEDURE Free* (hMem: INTEGER): INTEGER; |
| BEGIN |
| free(hMem) |
| RETURN 0 |
| END Free; |
| PROCEDURE _NEW*(size: INTEGER): INTEGER; |
| RETURN malloc(size) |
| END _NEW; |
| PROCEDURE _DISPOSE*(p: INTEGER): INTEGER; |
| RETURN Free(p) |
| END _DISPOSE; |
| PROCEDURE ConOut(str, length: INTEGER); |
| BEGIN |
| length := fwrite(str, length, 1, stdout) |
| END ConOut; |
| PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); |
| VAR eol: ARRAY 3 OF CHAR; |
| BEGIN |
| eol[0] := 0DX; |
| eol[1] := 0AX; |
| eol[2] := 00X; |
| ConOut(sys.ADR(eol), 2); |
| ConOut(lpCaption, strlen(lpCaption)); |
| ConOut(sys.ADR(":"), 1); |
| ConOut(sys.ADR(eol), 2); |
| ConOut(lpText, strlen(lpText)); |
| ConOut(sys.ADR(eol), 2); |
| END DebugMsg; |
| PROCEDURE ExitProcess* (code: INTEGER); |
| BEGIN |
| exit(code) |
| END ExitProcess; |
| PROCEDURE GetProc(name: ARRAY OF CHAR; hMOD, adr: INTEGER); |
| VAR H: INTEGER; |
| BEGIN |
| H := dlsym(hMOD, sys.ADR(name[0])); |
| ASSERT(H # 0); |
| sys.PUT(adr, H); |
| END GetProc; |
| PROCEDURE init* (esp: INTEGER); |
| VAR lib, proc: INTEGER; |
| BEGIN |
| Param := esp; |
| sys.MOVE(Param + 12, sys.ADR(dlopen), 4); |
| sys.MOVE(Param + 16, sys.ADR(dlsym), 4); |
| sys.MOVE(Param + 20, sys.ADR(exit), 4); |
| sys.MOVE(Param + 24, sys.ADR(stdin), 4); |
| sys.MOVE(Param + 28, sys.ADR(stdout), 4); |
| sys.MOVE(Param + 32, sys.ADR(stderr), 4); |
| sys.MOVE(Param + 36, sys.ADR(_malloc), 4); |
| sys.MOVE(Param + 40, sys.ADR(free), 4); |
| sys.MOVE(Param + 44, sys.ADR(fopen), 4); |
| sys.MOVE(Param + 48, sys.ADR(fclose), 4); |
| sys.MOVE(Param + 52, sys.ADR(fwrite), 4); |
| sys.MOVE(Param + 56, sys.ADR(fread), 4); |
| sys.MOVE(Param + 60, sys.ADR(fseek), 4); |
| sys.MOVE(Param + 64, sys.ADR(ftell), 4); |
| lib := dlopen(sys.ADR("libc.so.6"), 1); |
| ASSERT(lib # 0); |
| GetProc("strncmp", lib, sys.ADR(strncmp)); |
| GetProc("strlen", lib, sys.ADR(strlen)); |
| lib := dlopen(sys.ADR("librt.so.1"), 1); |
| ASSERT(lib # 0); |
| GetProc("clock_gettime", lib, sys.ADR(clock_gettime)); |
| END init; |
| END API. |
| /programs/develop/oberon07/Lib/Linux32/HOST.ob07 |
|---|
| 0,0 → 1,121 |
| (* |
| 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 HOST; |
| IMPORT sys := SYSTEM, API; |
| CONST |
| OS* = "LNX"; |
| Slash* = "/"; |
| VAR |
| fsize : INTEGER; |
| sec* : INTEGER; |
| dsec* : INTEGER; |
| PROCEDURE GetCommandLine* (): INTEGER; |
| RETURN API.Param |
| END GetCommandLine; |
| PROCEDURE CloseFile* (File: INTEGER); |
| BEGIN |
| File := API.fclose(File) |
| END CloseFile; |
| PROCEDURE FileRW* (hFile, Buffer, nNumberOfBytes: INTEGER; write: BOOLEAN): INTEGER; |
| VAR res: INTEGER; |
| BEGIN |
| IF write THEN |
| res := API.fwrite(Buffer, nNumberOfBytes, 1, hFile) * nNumberOfBytes |
| ELSE |
| res := API.fread(Buffer, nNumberOfBytes, 1, hFile) * nNumberOfBytes |
| END |
| RETURN res |
| END FileRW; |
| PROCEDURE OutString* (str: ARRAY OF CHAR); |
| VAR res: INTEGER; |
| BEGIN |
| res := FileRW(API.stdout, sys.ADR(str), LENGTH(str), TRUE) |
| END OutString; |
| PROCEDURE CreateFile* (FName: ARRAY OF CHAR): INTEGER; |
| RETURN API.fopen(sys.ADR(FName), sys.ADR("wb")) |
| END CreateFile; |
| PROCEDURE OpenFile* (FName: ARRAY OF CHAR): INTEGER; |
| VAR F, res: INTEGER; |
| BEGIN |
| F := API.fopen(sys.ADR(FName), sys.ADR("rb")); |
| IF F # 0 THEN |
| res := API.fseek(F, 0, 2); |
| fsize := API.ftell(F); |
| res := API.fseek(F, 0, 0) |
| END |
| RETURN F |
| END OpenFile; |
| PROCEDURE FileSize* (F: INTEGER): INTEGER; |
| RETURN fsize |
| END FileSize; |
| PROCEDURE Align(n, m: INTEGER): INTEGER; |
| RETURN n + (m - n MOD m) MOD m |
| END Align; |
| PROCEDURE malloc* (Bytes: INTEGER): INTEGER; |
| VAR res: INTEGER; |
| BEGIN |
| Bytes := Align(Bytes, 4); |
| res := API.malloc(Bytes); |
| IF res # 0 THEN |
| API.zeromem(ASR(Bytes, 2), res) |
| END |
| RETURN res |
| END malloc; |
| PROCEDURE ExitProcess* (code: INTEGER); |
| BEGIN |
| API.exit(code) |
| END ExitProcess; |
| PROCEDURE Time* (VAR sec, dsec: INTEGER); |
| VAR tp: API.TP; |
| BEGIN |
| IF API.clock_gettime(0, tp) = 0 THEN |
| sec := tp[0]; |
| dsec := tp[1] DIV 10000000 |
| ELSE |
| sec := 0; |
| dsec := 0 |
| END |
| END Time; |
| PROCEDURE init*; |
| BEGIN |
| Time(sec, dsec) |
| END init; |
| PROCEDURE GetName*(): INTEGER; |
| RETURN 0 |
| END GetName; |
| END HOST. |
| /programs/develop/oberon07/Lib/Linux32/RTL.ob07 |
|---|
| 0,0 → 1,279 |
| (* |
| 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 RTL; |
| IMPORT sys := SYSTEM, API; |
| TYPE |
| IntArray = ARRAY 2048 OF INTEGER; |
| STRING = ARRAY 2048 OF CHAR; |
| PROC = PROCEDURE; |
| VAR |
| SelfName, rtab: INTEGER; CloseProc: PROC; |
| PROCEDURE [stdcall] _halt*(n: INTEGER); |
| BEGIN |
| API.ExitProcess(n) |
| END _halt; |
| PROCEDURE [stdcall] _newrec*(size, t: INTEGER; VAR ptr: INTEGER); |
| BEGIN |
| ptr := API._NEW(size); |
| IF ptr # 0 THEN |
| sys.PUT(ptr, t); |
| INC(ptr, 4) |
| END |
| END _newrec; |
| PROCEDURE [stdcall] _disprec*(VAR ptr: INTEGER); |
| BEGIN |
| IF ptr # 0 THEN |
| ptr := API._DISPOSE(ptr - 4) |
| END |
| END _disprec; |
| PROCEDURE [stdcall] _rset*(y, x: INTEGER); |
| BEGIN |
| sys.CODE("8B45088B4D0C3BC87F0A83F91F760B83F81F760633C0C9C2080083F9007D0233C983F81F7E05B81F000000BA000000802BC8F7D9D3FA83E81F8BC8F7D9D3EA8BC2C9C20800") |
| END _rset; |
| PROCEDURE [stdcall] _inset*(y, x: INTEGER); |
| BEGIN |
| sys.CODE("8B45088B4D0C83F91F7709D3E883E001C9C20800C933C0C20800") |
| END _inset; |
| PROCEDURE [stdcall] _checktype*(table, t, r: INTEGER); |
| BEGIN |
| table := rtab; |
| sys.CODE("8B450C8B4D1085C975076A0158C9C20C008B51FC8B4D083BD0740D85D27409C1E20203D18B12EBEF33C93BC20F94C18BC1C9C20C00") |
| END _checktype; |
| PROCEDURE [stdcall] _savearr*(size, source, dest: INTEGER); |
| BEGIN |
| sys.CODE("9CFC8BD78BC68B7D108B750C8B4D08F3A48BFA8BF09D") |
| END _savearr; |
| PROCEDURE [stdcall] _saverec*(dyn, stat, size, source, dest: INTEGER): BOOLEAN; |
| VAR res: BOOLEAN; |
| BEGIN |
| res := dyn = stat; |
| IF res THEN |
| _savearr(size, source, dest) |
| END |
| RETURN res |
| END _saverec; |
| PROCEDURE [stdcall] _arrayidx*(Dim: INTEGER; VAR Arr: IntArray; bsize, idx, c: INTEGER); |
| VAR i, m: INTEGER; |
| BEGIN |
| m := bsize * idx; |
| FOR i := 4 TO Dim + 2 DO |
| m := m * Arr[i] |
| END; |
| IF (Arr[3] > idx) & (idx >= 0) THEN |
| Arr[3] := c + m |
| ELSE |
| Arr[3] := 0 |
| END |
| END _arrayidx; |
| PROCEDURE [stdcall] _arrayidx1*(VAR Arr: IntArray; bsize, idx, c: INTEGER); |
| BEGIN |
| IF (Arr[3] > idx) & (idx >= 0) THEN |
| Arr[3] := bsize * idx + c |
| ELSE |
| Arr[3] := 0 |
| END |
| END _arrayidx1; |
| PROCEDURE [stdcall] _arrayrot*(m, n: INTEGER; VAR Arr: IntArray); |
| VAR i, j, t: INTEGER; |
| BEGIN |
| FOR i := 1 TO n DO |
| t := Arr[0]; |
| FOR j := 0 TO m + n - 1 DO |
| Arr[j] := Arr[j + 1] |
| END; |
| Arr[m + n] := t |
| END |
| END _arrayrot; |
| PROCEDURE Min(a, b: INTEGER): INTEGER; |
| BEGIN |
| IF a > b THEN |
| a := b |
| END |
| RETURN a |
| END Min; |
| PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER; |
| BEGIN |
| sys.CODE("8B4508"); // mov eax, [ebp + 08h] |
| sys.CODE("8B4D0C"); // mov ecx, [ebp + 0Ch] |
| sys.CODE("48"); // dec eax |
| // L1: |
| sys.CODE("40"); // inc eax |
| sys.CODE("803800"); // cmp byte ptr [eax], 0 |
| sys.CODE("7403"); // jz L2 |
| sys.CODE("E2F8"); // loop L1 |
| sys.CODE("40"); // inc eax |
| // L2: |
| sys.CODE("2B4508"); // sub eax, [ebp + 08h] |
| sys.CODE("C9"); // leave |
| sys.CODE("C20800"); // ret 08h |
| RETURN 0 |
| END _length; |
| PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER); |
| BEGIN |
| _savearr(Min(alen, blen), a, b); |
| IF blen > alen THEN |
| sys.PUT(b + alen, 0X) |
| END |
| END _strcopy; |
| PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN; |
| VAR i: INTEGER; Res: BOOLEAN; |
| BEGIN |
| i := API.strncmp(sys.ADR(a), sys.ADR(b), Min(LEN(a), LEN(b))); |
| IF i = 0 THEN |
| i := _length(a) - _length(b) |
| END; |
| CASE op OF |
| |0: Res := i = 0 |
| |1: Res := i # 0 |
| |2: Res := i < 0 |
| |3: Res := i > 0 |
| |4: Res := i <= 0 |
| |5: Res := i >= 0 |
| ELSE |
| END |
| RETURN Res |
| END _strcmp; |
| PROCEDURE [stdcall] _lstrcmp*(op: INTEGER; b: CHAR; a: ARRAY OF CHAR): BOOLEAN; |
| VAR s: ARRAY 2 OF CHAR; |
| BEGIN |
| s[0] := b; |
| s[1] := 0X; |
| RETURN _strcmp(op, s, a) |
| END _lstrcmp; |
| PROCEDURE [stdcall] _rstrcmp*(op: INTEGER; b: ARRAY OF CHAR; a: CHAR): BOOLEAN; |
| VAR s: ARRAY 2 OF CHAR; |
| BEGIN |
| s[0] := a; |
| s[1] := 0X; |
| RETURN _strcmp(op, b, s) |
| END _rstrcmp; |
| PROCEDURE Int(x: INTEGER; VAR str: STRING); |
| VAR i, a, b: INTEGER; c: CHAR; |
| BEGIN |
| i := 0; |
| a := 0; |
| REPEAT |
| str[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10; |
| INC(i) |
| UNTIL x = 0; |
| b := i - 1; |
| WHILE a < b DO |
| c := str[a]; |
| str[a] := str[b]; |
| str[b] := c; |
| INC(a); |
| DEC(b) |
| END; |
| str[i] := 0X |
| END Int; |
| PROCEDURE [stdcall] _assrt*(code, m: INTEGER; modname: STRING; line: INTEGER); |
| VAR msg, int: STRING; pos, n: INTEGER; |
| PROCEDURE StrAppend(s: STRING); |
| VAR i, n: INTEGER; |
| BEGIN |
| n := LEN(s); |
| i := 0; |
| WHILE (i < n) & (s[i] # 0X) DO |
| msg[pos] := s[i]; |
| INC(pos); |
| INC(i) |
| END |
| END StrAppend; |
| BEGIN |
| pos := 0; |
| n := line MOD 16; |
| line := line DIV 16; |
| CASE n OF |
| |1: StrAppend("assertion failure") |
| |2: StrAppend("variable of a procedure type has NIL as value") |
| |3: StrAppend("typeguard error") |
| |4: StrAppend("inadmissible dynamic type") |
| |5: StrAppend("index check error") |
| |6: StrAppend("NIL pointer dereference") |
| |7: StrAppend("invalid value in case statement") |
| |8: StrAppend("division by zero") |
| ELSE |
| END; |
| StrAppend(0DX); |
| StrAppend(0AX); |
| StrAppend("module "); |
| StrAppend(modname); |
| StrAppend(0DX); |
| StrAppend(0AX); |
| StrAppend("line "); |
| Int(line, int); |
| StrAppend(int); |
| IF m = 2 THEN |
| StrAppend(0DX); |
| StrAppend(0AX); |
| StrAppend("code "); |
| Int(code, int); |
| StrAppend(int) |
| END; |
| API.DebugMsg(sys.ADR(msg), SelfName) |
| END _assrt; |
| PROCEDURE [stdcall] _close*; |
| BEGIN |
| IF CloseProc # NIL THEN |
| CloseProc |
| END |
| END _close; |
| PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER); |
| BEGIN |
| API.zeromem(gsize, gadr); |
| API.init(esp); |
| SelfName := self; |
| rtab := rec; |
| CloseProc := NIL; |
| END _init; |
| PROCEDURE SetClose*(proc: PROC); |
| BEGIN |
| CloseProc := proc |
| END SetClose; |
| END RTL. |