mirror of
https://github.com/AntKrotov/oberon-07-compiler.git
synced 2026-10-05 09:45:47 +00:00
обновление библиотеки
This commit is contained in:
AntKrotov committed
1 parent
970fd11caa
commit
d3db0ace96
7 files changed
+518
-24
No files matched your search
@@ -38,16 +38,6 @@ VAR
|
||||
clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER;
|
||||
|
||||
|
||||
PROCEDURE dlopen* (filename: ARRAY OF CHAR): INTEGER;
|
||||
RETURN API.dlopen(SYSTEM.ADR(filename[0]), 1)
|
||||
END dlopen;
|
||||
|
||||
|
||||
PROCEDURE dlsym* (handle: INTEGER; symbol: ARRAY OF CHAR): INTEGER;
|
||||
RETURN API.dlsym(handle, SYSTEM.ADR(symbol[0]))
|
||||
END dlsym;
|
||||
|
||||
|
||||
PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, len, ptr: INTEGER;
|
||||
|
||||
@@ -0,0 +1,65 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE Libdl;
|
||||
|
||||
IMPORT SYSTEM, API;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
LAZY* = 1;
|
||||
NOW* = 2;
|
||||
BINDING_MASK* = 3;
|
||||
NOLOAD* = 4;
|
||||
LOCAL* = 0;
|
||||
GLOBAL* = 256;
|
||||
NODELETE* = 4096;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
_close: PROCEDURE [linux] (handle: INTEGER): INTEGER;
|
||||
_error: PROCEDURE [linux] (): INTEGER;
|
||||
|
||||
|
||||
PROCEDURE open* (file: ARRAY OF CHAR; mode: INTEGER): INTEGER;
|
||||
RETURN API.dlopen(SYSTEM.ADR(file[0]), mode)
|
||||
END open;
|
||||
|
||||
|
||||
PROCEDURE sym* (handle: INTEGER; name: ARRAY OF CHAR): INTEGER;
|
||||
RETURN API.dlsym(handle, SYSTEM.ADR(name[0]))
|
||||
END sym;
|
||||
|
||||
|
||||
PROCEDURE close* (handle: INTEGER): INTEGER;
|
||||
RETURN _close(handle)
|
||||
END close;
|
||||
|
||||
|
||||
PROCEDURE error* (): INTEGER;
|
||||
RETURN _error()
|
||||
END error;
|
||||
|
||||
|
||||
PROCEDURE init;
|
||||
VAR
|
||||
lib: INTEGER;
|
||||
|
||||
BEGIN
|
||||
lib := open("libdl.so.2", LAZY);
|
||||
SYSTEM.PUT(SYSTEM.ADR(_close), sym(lib, "dlclose"));
|
||||
ASSERT(_close # NIL);
|
||||
SYSTEM.PUT(SYSTEM.ADR(_error), sym(lib, "dlerror"));
|
||||
ASSERT(_error # NIL)
|
||||
END init;
|
||||
|
||||
|
||||
BEGIN
|
||||
init
|
||||
END Libdl.
|
||||
@@ -0,0 +1,384 @@
|
||||
(*
|
||||
Copyright 2013, 2014, 2018, 2019 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 Math;
|
||||
|
||||
IMPORT SYSTEM;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
pi* = 3.141592653589793;
|
||||
e* = 2.718281828459045;
|
||||
|
||||
|
||||
PROCEDURE IsNan* (x: REAL): BOOLEAN;
|
||||
VAR
|
||||
h, l: SET;
|
||||
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x), l);
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + 4, h)
|
||||
RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
|
||||
END IsNan;
|
||||
|
||||
|
||||
PROCEDURE IsInf* (x: REAL): BOOLEAN;
|
||||
RETURN ABS(x) = SYSTEM.INF()
|
||||
END IsInf;
|
||||
|
||||
|
||||
PROCEDURE Max (a, b: REAL): REAL;
|
||||
VAR
|
||||
res: REAL;
|
||||
|
||||
BEGIN
|
||||
IF a > b THEN
|
||||
res := a
|
||||
ELSE
|
||||
res := b
|
||||
END
|
||||
RETURN res
|
||||
END Max;
|
||||
|
||||
|
||||
PROCEDURE Min (a, b: REAL): REAL;
|
||||
VAR
|
||||
res: REAL;
|
||||
|
||||
BEGIN
|
||||
IF a < b THEN
|
||||
res := a
|
||||
ELSE
|
||||
res := b
|
||||
END
|
||||
RETURN res
|
||||
END Min;
|
||||
|
||||
|
||||
PROCEDURE SameValue (a, b: REAL): BOOLEAN;
|
||||
VAR
|
||||
eps: REAL;
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
eps := Max(Min(ABS(a), ABS(b)) * 1.0E-12, 1.0E-12);
|
||||
IF a > b THEN
|
||||
res := (a - b) <= eps
|
||||
ELSE
|
||||
res := (b - a) <= eps
|
||||
END
|
||||
RETURN res
|
||||
END SameValue;
|
||||
|
||||
|
||||
PROCEDURE IsZero (x: REAL): BOOLEAN;
|
||||
RETURN ABS(x) <= 1.0E-12
|
||||
END IsZero;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] sqrt* (x: REAL): REAL;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
|
||||
0D9H, 0FAH, (* fsqrt *)
|
||||
0C9H, (* leave *)
|
||||
0C2H, 008H, 000H (* ret 08h *)
|
||||
)
|
||||
RETURN 0.0
|
||||
END sqrt;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] sin* (x: REAL): REAL;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
|
||||
0D9H, 0FEH, (* fsin *)
|
||||
0C9H, (* leave *)
|
||||
0C2H, 008H, 000H (* ret 08h *)
|
||||
)
|
||||
RETURN 0.0
|
||||
END sin;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] cos* (x: REAL): REAL;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
|
||||
0D9H, 0FFH, (* fcos *)
|
||||
0C9H, (* leave *)
|
||||
0C2H, 008H, 000H (* ret 08h *)
|
||||
)
|
||||
RETURN 0.0
|
||||
END cos;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] tan* (x: REAL): REAL;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
|
||||
0D9H, 0FBH, (* fsincos *)
|
||||
0DEH, 0F9H, (* fdivp st1, st *)
|
||||
0C9H, (* leave *)
|
||||
0C2H, 008H, 000H (* ret 08h *)
|
||||
)
|
||||
RETURN 0.0
|
||||
END tan;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] arctan2* (y, x: REAL): REAL;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
|
||||
0DDH, 045H, 010H, (* fld qword [ebp + 10h] *)
|
||||
0D9H, 0F3H, (* fpatan *)
|
||||
0C9H, (* leave *)
|
||||
0C2H, 010H, 000H (* ret 10h *)
|
||||
)
|
||||
RETURN 0.0
|
||||
END arctan2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] ln* (x: REAL): REAL;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
0D9H, 0EDH, (* fldln2 *)
|
||||
0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
|
||||
0D9H, 0F1H, (* fyl2x *)
|
||||
0C9H, (* leave *)
|
||||
0C2H, 008H, 000H (* ret 08h *)
|
||||
)
|
||||
RETURN 0.0
|
||||
END ln;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] log* (base, x: REAL): REAL;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
0D9H, 0E8H, (* fld1 *)
|
||||
0DDH, 045H, 010H, (* fld qword [ebp + 10h] *)
|
||||
0D9H, 0F1H, (* fyl2x *)
|
||||
0D9H, 0E8H, (* fld1 *)
|
||||
0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
|
||||
0D9H, 0F1H, (* fyl2x *)
|
||||
0DEH, 0F9H, (* fdivp st1, st *)
|
||||
0C9H, (* leave *)
|
||||
0C2H, 010H, 000H (* ret 10h *)
|
||||
)
|
||||
RETURN 0.0
|
||||
END log;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] exp* (x: REAL): REAL;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
|
||||
0D9H, 0EAH, (* fldl2e *)
|
||||
0DEH, 0C9H, 0D9H, 0C0H,
|
||||
0D9H, 0FCH, 0DCH, 0E9H,
|
||||
0D9H, 0C9H, 0D9H, 0F0H,
|
||||
0D9H, 0E8H, 0DEH, 0C1H,
|
||||
0D9H, 0FDH, 0DDH, 0D9H,
|
||||
0C9H, (* leave *)
|
||||
0C2H, 008H, 000H (* ret 08h *)
|
||||
)
|
||||
RETURN 0.0
|
||||
END exp;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] round* (x: REAL): REAL;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
|
||||
0D9H, 07DH, 0F4H, 0D9H,
|
||||
07DH, 0F6H, 066H, 081H,
|
||||
04DH, 0F6H, 000H, 003H,
|
||||
0D9H, 06DH, 0F6H, 0D9H,
|
||||
0FCH, 0D9H, 06DH, 0F4H,
|
||||
0C9H, (* leave *)
|
||||
0C2H, 008H, 000H (* ret 08h *)
|
||||
)
|
||||
RETURN 0.0
|
||||
END round;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] frac* (x: REAL): REAL;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
050H,
|
||||
0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
|
||||
0D9H, 0C0H, 0D9H, 03CH,
|
||||
024H, 0D9H, 07CH, 024H,
|
||||
002H, 066H, 081H, 04CH,
|
||||
024H, 002H, 000H, 00FH,
|
||||
0D9H, 06CH, 024H, 002H,
|
||||
0D9H, 0FCH, 0D9H, 02CH,
|
||||
024H, 0DEH, 0E9H,
|
||||
0C9H, (* leave *)
|
||||
0C2H, 008H, 000H (* ret 08h *)
|
||||
)
|
||||
RETURN 0.0
|
||||
END frac;
|
||||
|
||||
|
||||
PROCEDURE arcsin* (x: REAL): REAL;
|
||||
RETURN arctan2(x, sqrt(1.0 - x * x))
|
||||
END arcsin;
|
||||
|
||||
|
||||
PROCEDURE arccos* (x: REAL): REAL;
|
||||
RETURN arctan2(sqrt(1.0 - x * x), x)
|
||||
END arccos;
|
||||
|
||||
|
||||
PROCEDURE arctan* (x: REAL): REAL;
|
||||
RETURN arctan2(x, 1.0)
|
||||
END arctan;
|
||||
|
||||
|
||||
PROCEDURE sinh* (x: REAL): REAL;
|
||||
BEGIN
|
||||
x := exp(x)
|
||||
RETURN (x - 1.0 / x) * 0.5
|
||||
END sinh;
|
||||
|
||||
|
||||
PROCEDURE cosh* (x: REAL): REAL;
|
||||
BEGIN
|
||||
x := exp(x)
|
||||
RETURN (x + 1.0 / x) * 0.5
|
||||
END cosh;
|
||||
|
||||
|
||||
PROCEDURE tanh* (x: REAL): REAL;
|
||||
BEGIN
|
||||
IF x > 15.0 THEN
|
||||
x := 1.0
|
||||
ELSIF x < -15.0 THEN
|
||||
x := -1.0
|
||||
ELSE
|
||||
x := exp(2.0 * x);
|
||||
x := (x - 1.0) / (x + 1.0)
|
||||
END
|
||||
|
||||
RETURN x
|
||||
END tanh;
|
||||
|
||||
|
||||
PROCEDURE arsinh* (x: REAL): REAL;
|
||||
RETURN ln(x + sqrt(x * x + 1.0))
|
||||
END arsinh;
|
||||
|
||||
|
||||
PROCEDURE arcosh* (x: REAL): REAL;
|
||||
RETURN ln(x + sqrt(x * x - 1.0))
|
||||
END arcosh;
|
||||
|
||||
|
||||
PROCEDURE artanh* (x: REAL): REAL;
|
||||
VAR
|
||||
res: REAL;
|
||||
|
||||
BEGIN
|
||||
IF SameValue(x, 1.0) THEN
|
||||
res := SYSTEM.INF()
|
||||
ELSIF SameValue(x, -1.0) THEN
|
||||
res := -SYSTEM.INF()
|
||||
ELSE
|
||||
res := 0.5 * ln((1.0 + x) / (1.0 - x))
|
||||
END
|
||||
RETURN res
|
||||
END artanh;
|
||||
|
||||
|
||||
PROCEDURE floor* (x: REAL): REAL;
|
||||
VAR
|
||||
f: REAL;
|
||||
|
||||
BEGIN
|
||||
f := frac(x);
|
||||
x := x - f;
|
||||
IF f < 0.0 THEN
|
||||
x := x - 1.0
|
||||
END
|
||||
RETURN x
|
||||
END floor;
|
||||
|
||||
|
||||
PROCEDURE ceil* (x: REAL): REAL;
|
||||
VAR
|
||||
f: REAL;
|
||||
|
||||
BEGIN
|
||||
f := frac(x);
|
||||
x := x - f;
|
||||
IF f > 0.0 THEN
|
||||
x := x + 1.0
|
||||
END
|
||||
RETURN x
|
||||
END ceil;
|
||||
|
||||
|
||||
PROCEDURE power* (base, exponent: REAL): REAL;
|
||||
VAR
|
||||
res: REAL;
|
||||
|
||||
BEGIN
|
||||
IF exponent = 0.0 THEN
|
||||
res := 1.0
|
||||
ELSIF (base = 0.0) & (exponent > 0.0) THEN
|
||||
res := 0.0
|
||||
ELSE
|
||||
res := exp(exponent * ln(base))
|
||||
END
|
||||
RETURN res
|
||||
END power;
|
||||
|
||||
|
||||
PROCEDURE sgn* (x: REAL): INTEGER;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
IF x > 0.0 THEN
|
||||
res := 1
|
||||
ELSIF x < 0.0 THEN
|
||||
res := -1
|
||||
ELSE
|
||||
res := 0
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END sgn;
|
||||
|
||||
|
||||
PROCEDURE fact* (n: INTEGER): REAL;
|
||||
VAR
|
||||
res: REAL;
|
||||
|
||||
BEGIN
|
||||
res := 1.0;
|
||||
WHILE n > 1 DO
|
||||
res := res * FLT(n);
|
||||
DEC(n)
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END fact;
|
||||
|
||||
|
||||
END Math.
|
||||
@@ -38,16 +38,6 @@ VAR
|
||||
clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER;
|
||||
|
||||
|
||||
PROCEDURE dlopen* (filename: ARRAY OF CHAR): INTEGER;
|
||||
RETURN API.dlopen(SYSTEM.ADR(filename[0]), 1)
|
||||
END dlopen;
|
||||
|
||||
|
||||
PROCEDURE dlsym* (handle: INTEGER; symbol: ARRAY OF CHAR): INTEGER;
|
||||
RETURN API.dlsym(handle, SYSTEM.ADR(symbol[0]))
|
||||
END dlsym;
|
||||
|
||||
|
||||
PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, len, ptr: INTEGER;
|
||||
|
||||
@@ -0,0 +1,65 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE Libdl;
|
||||
|
||||
IMPORT SYSTEM, API;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
LAZY* = 1;
|
||||
NOW* = 2;
|
||||
BINDING_MASK* = 3;
|
||||
NOLOAD* = 4;
|
||||
LOCAL* = 0;
|
||||
GLOBAL* = 256;
|
||||
NODELETE* = 4096;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
_close: PROCEDURE [linux] (handle: INTEGER): INTEGER;
|
||||
_error: PROCEDURE [linux] (): INTEGER;
|
||||
|
||||
|
||||
PROCEDURE open* (file: ARRAY OF CHAR; mode: INTEGER): INTEGER;
|
||||
RETURN API.dlopen(SYSTEM.ADR(file[0]), mode)
|
||||
END open;
|
||||
|
||||
|
||||
PROCEDURE sym* (handle: INTEGER; name: ARRAY OF CHAR): INTEGER;
|
||||
RETURN API.dlsym(handle, SYSTEM.ADR(name[0]))
|
||||
END sym;
|
||||
|
||||
|
||||
PROCEDURE close* (handle: INTEGER): INTEGER;
|
||||
RETURN _close(handle)
|
||||
END close;
|
||||
|
||||
|
||||
PROCEDURE error* (): INTEGER;
|
||||
RETURN _error()
|
||||
END error;
|
||||
|
||||
|
||||
PROCEDURE init;
|
||||
VAR
|
||||
lib: INTEGER;
|
||||
|
||||
BEGIN
|
||||
lib := open("libdl.so.2", LAZY);
|
||||
SYSTEM.PUT(SYSTEM.ADR(_close), sym(lib, "dlclose"));
|
||||
ASSERT(_close # NIL);
|
||||
SYSTEM.PUT(SYSTEM.ADR(_error), sym(lib, "dlerror"));
|
||||
ASSERT(_error # NIL)
|
||||
END init;
|
||||
|
||||
|
||||
BEGIN
|
||||
init
|
||||
END Libdl.
|
||||
@@ -1,6 +1,6 @@
|
||||
MODULE HW;
|
||||
|
||||
IMPORT SYSTEM, LINAPI;
|
||||
IMPORT SYSTEM, LINAPI, Libdl;
|
||||
|
||||
|
||||
VAR
|
||||
@@ -44,7 +44,7 @@ END main;
|
||||
|
||||
|
||||
BEGIN
|
||||
SYSTEM.PUT(SYSTEM.ADR(puts), LINAPI.dlsym(LINAPI.libc, "puts"));
|
||||
SYSTEM.PUT(SYSTEM.ADR(puts), Libdl.sym(LINAPI.libc, "puts"));
|
||||
ASSERT(puts # NIL);
|
||||
main
|
||||
END HW.
|
||||
@@ -1,6 +1,6 @@
|
||||
MODULE HW;
|
||||
|
||||
IMPORT SYSTEM, LINAPI;
|
||||
IMPORT SYSTEM, LINAPI, Libdl;
|
||||
|
||||
|
||||
VAR
|
||||
@@ -44,7 +44,7 @@ END main;
|
||||
|
||||
|
||||
BEGIN
|
||||
SYSTEM.PUT(SYSTEM.ADR(puts), LINAPI.dlsym(LINAPI.libc, "puts"));
|
||||
SYSTEM.PUT(SYSTEM.ADR(puts), Libdl.sym(LINAPI.libc, "puts"));
|
||||
ASSERT(puts # NIL);
|
||||
main
|
||||
END HW.
|
||||
Reference in new issue
Block a user