mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-10-10 00:27:23 +00:00
Compare commits
6 commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
c18945bc70 | ||
|
|
531bfe168b | ||
|
|
e69f33a0cd | ||
|
|
d6d99b4fbe | ||
|
|
9701249ad2 | ||
|
|
fcf59d5d93 |
41 changed files with 2813 additions and 185 deletions
|
|
@ -153,6 +153,9 @@ Execute as usual on Linux (`./hello`) or Windows (`hello`).
|
|||
|
||||
For more details on compilation, see [**Compiling**](/doc/Compiling.md).
|
||||
|
||||
An optional Unix prototype, [**vloksh and shared modules**](/doc/SharedModules.md),
|
||||
loads VOC modules on demand and provides a command shell with `.sym`-based completion.
|
||||
|
||||
### Viewing the interfaces of included modules.
|
||||
|
||||
In order to see the definition of a module's interface, use the "showdef" program.
|
||||
|
|
|
|||
158
doc/SharedModules.md
Normal file
158
doc/SharedModules.md
Normal file
|
|
@ -0,0 +1,158 @@
|
|||
# Shared modules and vloksh (Unix prototype)
|
||||
|
||||
`vloksh` is a minimal VOC counterpart of polpo's loksh. It executes Oberon
|
||||
`Module.Command` procedures in its own address space, loading native ELF `.so`
|
||||
libraries on demand. The shell and loader are optional: the normal compiler
|
||||
build and the installed runtime are unchanged.
|
||||
|
||||
## Try it
|
||||
|
||||
Requires an installed VOC with its shared runtime and development headers,
|
||||
a C compiler, GNU Readline development files, Python 3 and binutils.
|
||||
The current shell uses the default Oberon-2 type model (`-O2`).
|
||||
|
||||
```sh
|
||||
make vloksh
|
||||
make vloksh-test
|
||||
make vloksh-demo
|
||||
build/vloksh/vloksh -Pbuild/vloksh/strutils-demo
|
||||
```
|
||||
|
||||
The demo reads sources from `../strutils` without modifying that repository.
|
||||
Override its location with `STRUTILS=/path/to/strutils`.
|
||||
Inside the shell:
|
||||
|
||||
```text
|
||||
> StrDemo
|
||||
StrDemo.Echo
|
||||
StrDemo.Run
|
||||
> StrDemo.Run
|
||||
shared
|
||||
modules
|
||||
really
|
||||
work
|
||||
calls: 1
|
||||
> StrDemo.Run
|
||||
shared
|
||||
modules
|
||||
really
|
||||
work
|
||||
calls: 2
|
||||
> StrDemo.Echo hello world
|
||||
hello world
|
||||
> quit
|
||||
```
|
||||
|
||||
Tab completes module names, then their commands. Readline supplies editing,
|
||||
session history and filename completion for arguments. Module and command
|
||||
discovery does **not** load a library or run a module initializer. It reads the
|
||||
existing `.sym` files, selecting exported, parameterless proper procedures,
|
||||
as showdef's `OPT.Import` reader would. Already initialized modules are also
|
||||
discoverable through VOC's command registry.
|
||||
|
||||
The shell also supports single-command and batch operation:
|
||||
|
||||
```sh
|
||||
build/vloksh/vloksh -Pbuild/vloksh/strutils-demo StrDemo.Run
|
||||
printf 'StrDemo.Run\nStrDemo.Run\n' | build/vloksh/vloksh -Pbuild/vloksh/strutils-demo
|
||||
```
|
||||
|
||||
`-Ppath` or `-P path` overrides `VOC_MODULE_PATH`. Paths are colon-separated;
|
||||
by default the loader searches the current directory and the directory of the
|
||||
actually loaded `libvoc-O2.so`. Symbols are searched in those directories,
|
||||
then `VOC_SYM_PATH`, or the installation's `2/sym` directory when it is unset.
|
||||
`VOCROOT` can override the installation root for symbol discovery.
|
||||
|
||||
Build overrides for another installation:
|
||||
|
||||
```sh
|
||||
make vloksh VOC=/opt/voc/bin/voc VOCROOT=/opt/voc VOCLIBDIR=/opt/voc/lib
|
||||
```
|
||||
|
||||
Build products stay in `build/vloksh`. Nothing is installed by these targets.
|
||||
|
||||
## Building and packaging modules
|
||||
|
||||
The experimental helper builds **one module per shared object**, in import
|
||||
order, in the current build directory:
|
||||
|
||||
```sh
|
||||
python3 /path/to/compiler/src/tools/vloksh/voc-shared.py /path/to/strTypes.Mod
|
||||
python3 /path/to/compiler/src/tools/vloksh/voc-shared.py /path/to/strUtils.Mod
|
||||
python3 /path/to/compiler/src/tools/vloksh/voc-shared.py /path/to/StrDemo.Mod
|
||||
```
|
||||
|
||||
For module `M` it produces `libvoc-M-O2.so`, plus the usual `M.sym`, `M.h` and
|
||||
generated C. It translates with VOC and compiles explicitly with `-fPIC`.
|
||||
Every external import becomes an ELF `DT_NEEDED` dependency; modules already
|
||||
provided by `libvoc-O2.so` are not duplicated. `$ORIGIN` run paths let libraries
|
||||
in the same directory find each other. Imports in another directory need a
|
||||
system linker search path or `LD_LIBRARY_PATH` at runtime; `-P` locates the
|
||||
requested module but cannot override the ELF linker's dependency search.
|
||||
|
||||
The helper supports `--root`, `--libdir`, `--voc`, `--cc`, `--model C`, `-I`
|
||||
(additional C includes) and `-L` (shared dependencies). `OBERON`/`MODULES`
|
||||
remain VOC's symbol search configuration. It honors `CC`, `CFLAGS`,
|
||||
`LDFLAGS`, `LDLIBS`, `VOCROOT` and `VOCLIBDIR`.
|
||||
|
||||
A Gentoo package can install:
|
||||
|
||||
| File | Location / purpose |
|
||||
| --- | --- |
|
||||
| `libvoc-strTypes-O2.so`, `libvoc-strUtils-O2.so` | `/usr/$(get_libdir)`; runtime libraries |
|
||||
| `strTypes.sym`, `strUtils.sym` | `/usr/share/voc/2/sym`; compilation and shell completion |
|
||||
| `strTypes.h`, `strUtils.h` | `/usr/share/voc/2/include`; C backend compilation |
|
||||
|
||||
Static archives can coexist for existing consumers; `.sym` and `.h` are still
|
||||
needed when compiling against a packaged module. Runtime execution itself
|
||||
does not need symbols, but completion of an unloaded module does. No command
|
||||
index or other completion metadata is required. The overlay ebuilds have not
|
||||
been changed by this experiment.
|
||||
|
||||
## Loader contract and limitations
|
||||
|
||||
- `SharedModules.ThisMod` opens `libvoc-M-O2.so` with
|
||||
`dlopen(RTLD_NOW | RTLD_GLOBAL)`, checks a small ABI descriptor and calls
|
||||
`M__init`. That initializer registers the module, its commands and GC roots
|
||||
in the existing shared VOC runtime. `ThisCommand` uses the existing registry.
|
||||
Existing `Modules.ThisMod` is unchanged; clients needing on-demand lookup
|
||||
use `SharedModules.ThisMod` in this prototype.
|
||||
- Handles and pointer-sized values use `SYSTEM.ADDRESS`, not `LONGINT`.
|
||||
- The helper embeds `M__voc_abi`, checking pointer/basic-type sizes and runtime
|
||||
descriptor sizes. This is a **shape check, not a complete ABI/versioning or
|
||||
imported-interface fingerprint check**. Use matching compiler/runtime,
|
||||
architecture, type model and dependency interfaces. Unrelated Ofront `.so`
|
||||
files are not compatible. Dependencies must be built with the same contract.
|
||||
- The shell and all loaded modules must use **one shared** `libvoc-O2.so`.
|
||||
Statically embedding separate runtime/heap copies in plugins is unsafe.
|
||||
- Libraries remain loaded until process exit. The loader pins a directly loaded
|
||||
module's registry entry so `Modules.Free` cannot remove its GC roots. Imported
|
||||
modules remain referenced by their clients. There is no unload/reload yet:
|
||||
VOC's static type descriptors, pointer enumerators and finalizers can outlive
|
||||
a command, making a casual `dlclose` unsafe.
|
||||
- Commands take no formal parameters or result; arguments are available as
|
||||
`Oberon.Par.text` starting at `Oberon.Par.pos`. General exported functions
|
||||
remain callable by importing modules, but are not shell commands.
|
||||
- HALT, assertions and faults terminate the prototype; there is no loksh-style
|
||||
trap recovery, process isolation, Unix pipeline syntax or job control yet.
|
||||
Load only trusted native modules: they have the shell's full permissions.
|
||||
- The existing registry limits module names to 19 and command names to 23
|
||||
characters. The helper rejects names that would be truncated.
|
||||
|
||||
## Layout and later V4 work
|
||||
|
||||
`src/library/v4/SharedModules.Mod` is the reusable, UI-independent loader;
|
||||
`CommandSymbols.Mod` is a read-only `.sym` command reader following
|
||||
`src/compiler/OPM.Mod` and `OPT.Mod` (format `F7 84`). Unsupported or malformed
|
||||
symbols return no partial completions. The small C support layer handles
|
||||
POSIX library/path operations. The shell and Readline bridge live separately
|
||||
in `src/tools/vloksh`.
|
||||
|
||||
A later graphical port fits under `src/library/v4/ui`, rather than mixing
|
||||
UI dependencies into the existing headless library. Its entry command could
|
||||
be launched by the same loader. However, VOC already supplies headless
|
||||
`Texts` and `Oberon` modules: a loaded UI cannot simply replace those modules
|
||||
with incompatible records/interfaces of the same names. The port must first
|
||||
unify the common interfaces or use distinct CLI/UI modules and import aliases,
|
||||
as polpo does. X11 bindings, fonts/text resources, event loop and trap handling
|
||||
also need adaptation. This prototype establishes loading, not that UI port.
|
||||
2
make.cmd
2
make.cmd
|
|
@ -391,7 +391,9 @@ cd %BUILDDIR%\%MODEL%
|
|||
%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmResources.Mod || exit /b
|
||||
%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmForwarders.Mod || exit /b
|
||||
%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmRelatedEvents.Mod || exit /b
|
||||
%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmStreamsHost.Mod || exit /b
|
||||
%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmStreams.Mod || exit /b
|
||||
%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmTerminals.Mod || exit /b
|
||||
%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmStrings.Mod || exit /b
|
||||
%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmSysTypes.Mod || exit /b
|
||||
%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmTexts.Mod || exit /b
|
||||
|
|
|
|||
11
makefile
11
makefile
|
|
@ -113,6 +113,17 @@ usage:
|
|||
tags:
|
||||
ctags -R --options=oberon.ctags --extras=+q
|
||||
|
||||
# Optional Unix command shell; does not rebuild or install the compiler.
|
||||
.PHONY: vloksh vloksh-test vloksh-demo
|
||||
vloksh:
|
||||
$(MAKE) -f src/tools/vloksh/Makefile all
|
||||
|
||||
vloksh-test:
|
||||
$(MAKE) -f src/tools/vloksh/Makefile test
|
||||
|
||||
vloksh-demo:
|
||||
$(MAKE) -f src/tools/vloksh/Makefile demo
|
||||
|
||||
# Generate config files Configuration.Make and Configuration.Mod
|
||||
FORCE:
|
||||
|
||||
|
|
|
|||
|
|
@ -754,13 +754,30 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
|
|||
END;
|
||||
END WriteInt;
|
||||
|
||||
(* r with 17 significant digits, which read back as the same double: 15 digits lost precision,
|
||||
and very small values (as LowLReal.small) came out as 0 *)
|
||||
PROCEDURE -AAincludeStdio '#include <stdio.h>';
|
||||
PROCEDURE -FormatReal(buf: SYSTEM.ADDRESS; r: LONGREAL) 'snprintf((char*)(ADDRESS)(buf), 40, "%.17g", r)';
|
||||
|
||||
PROCEDURE WriteExactReal(r: LONGREAL);
|
||||
VAR s: ARRAY 40 OF CHAR; i: INTEGER; real: BOOLEAN;
|
||||
BEGIN
|
||||
FormatReal(SYSTEM.ADR(s), r);
|
||||
i := 0; real := FALSE;
|
||||
WHILE s[i] # 0X DO IF (s[i] = ".") OR (s[i] = "e") THEN real := TRUE END; INC(i) END;
|
||||
IF ~real THEN s[i] := "."; s[i+1] := "0"; s[i+2] := 0X END; (* not an integer constant in C *)
|
||||
WriteStringVar(s)
|
||||
END WriteExactReal;
|
||||
|
||||
PROCEDURE WriteReal* (r: LONGREAL; suffx: CHAR);
|
||||
VAR W: Texts.Writer; T: Texts.Text; R: Texts.Reader; s: ARRAY 32 OF CHAR; ch: CHAR; i: INTEGER;
|
||||
BEGIN
|
||||
(*should be improved *)
|
||||
IF (r < SignedMaximum(LongintSize)) & (r > SignedMinimum(LongintSize)) & (r = ENTIER(r)) THEN
|
||||
IF suffx = "f" THEN WriteString("(REAL)") ELSE WriteString("(LONGREAL)") END ;
|
||||
WriteInt(ENTIER(r))
|
||||
ELSIF SYSTEM.VAL(SYSTEM.INT64, r) DIV 10000000000000H MOD 800H # 7FFH THEN (* not inf or nan *)
|
||||
IF suffx = "f" THEN WriteString("(REAL)") ELSE WriteString("(LONGREAL)") END ;
|
||||
WriteExactReal(r)
|
||||
ELSE
|
||||
Texts.OpenWriter(W);
|
||||
IF suffx = "f" THEN Texts.WriteLongReal(W, r, 16) ELSE Texts.WriteLongReal(W, r, 23) END ;
|
||||
|
|
@ -895,9 +912,17 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
|
|||
|
||||
|
||||
|
||||
(* the largest REAL and LONGREAL, from their bits: 1.7976931348623157D307 * 9.999999 was
|
||||
1.79769296342094D308, and older compilers refuse the exponent 308 *)
|
||||
PROCEDURE SetMaxReals;
|
||||
VAR i32: SYSTEM.INT32; i64: SYSTEM.INT64; r: REAL;
|
||||
BEGIN
|
||||
i32 := 7F7FFFFFH; r := SYSTEM.VAL(REAL, i32); MaxReal := r;
|
||||
i64 := 7FEFFFFFFFFFFFFFH; MaxLReal := SYSTEM.VAL(LONGREAL, i64)
|
||||
END SetMaxReals;
|
||||
|
||||
BEGIN
|
||||
MaxReal := 3.40282346D38; (* REAL is 4 bytes *)
|
||||
MaxLReal := 1.7976931348623157D307 * 9.999999; (* LONGREAL is 8 bytes, should be 1.7976931348623157D308 *)
|
||||
SetMaxReals;
|
||||
MinReal := -MaxReal;
|
||||
MinLReal := -MaxLReal;
|
||||
FindInstallDir;
|
||||
|
|
|
|||
|
|
@ -89,20 +89,15 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
|
|||
name[i] := 0X; sym := ident
|
||||
END Identifier;
|
||||
|
||||
(* the decimal constants of the scanner, correctly rounded by the C library *)
|
||||
PROCEDURE -Astdlib '#include <stdlib.h>';
|
||||
PROCEDURE -strtod(s: SYSTEM.ADDRESS): LONGREAL '(LONGREAL)strtod((const char*)(ADDRESS)(s), 0)';
|
||||
PROCEDURE -strtof(s: SYSTEM.ADDRESS): REAL '(REAL)strtof((const char*)(ADDRESS)(s), 0)';
|
||||
|
||||
PROCEDURE Number;
|
||||
CONST maxhexdigits = 16;
|
||||
VAR i, m, n, d, e: INTEGER; dig: ARRAY 24 OF CHAR; f: LONGREAL; expCh: CHAR; neg: BOOLEAN;
|
||||
|
||||
PROCEDURE Ten(e: INTEGER): LONGREAL;
|
||||
VAR x, p: LONGREAL;
|
||||
BEGIN x := 1; p := 10;
|
||||
WHILE e > 0 DO
|
||||
IF ODD(e) THEN x := x*p END;
|
||||
e := e DIV 2;
|
||||
IF e > 0 THEN p := p*p END (* prevent overflow *)
|
||||
END;
|
||||
RETURN x
|
||||
END Ten;
|
||||
VAR i, m, n, d, e, k, j: INTEGER; dig: ARRAY 40 OF CHAR; f: LONGREAL; expCh: CHAR; neg: BOOLEAN;
|
||||
num: ARRAY 64 OF CHAR; exp: ARRAY 8 OF CHAR;
|
||||
|
||||
PROCEDURE Ord(ch: CHAR; hex: BOOLEAN): INTEGER;
|
||||
BEGIN (* ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") *)
|
||||
|
|
@ -153,6 +148,8 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
|
|||
END
|
||||
ELSE (* fraction *)
|
||||
f := 0; e := 0; expCh := "E";
|
||||
num[0] := "0"; num[1] := "."; k := 2; j := 0; (* "0.digits" for strtod, with "e" exp below *)
|
||||
WHILE j < n DO num[k] := dig[j]; INC(k); INC(j) END;
|
||||
WHILE n > 0 DO (* 0 <= f < 1 *) DEC(n); f := (Ord(dig[n], FALSE) + f)/10 END;
|
||||
IF (ch = "E") OR (ch = "D") THEN expCh := ch; OPM.Get(ch); neg := FALSE;
|
||||
IF ch = "-" THEN neg := TRUE; OPM.Get(ch)
|
||||
|
|
@ -169,20 +166,18 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
|
|||
END
|
||||
END;
|
||||
DEC(e, i-d-m); (* decimal point shift *)
|
||||
num[k] := "e"; INC(k); IF e < 0 THEN num[k] := "-"; INC(k) END;
|
||||
j := ABS(e); n := 0; REPEAT exp[n] := CHR(ORD("0") + j MOD 10); j := j DIV 10; INC(n) UNTIL j = 0;
|
||||
WHILE n > 0 DO DEC(n); num[k] := exp[n]; INC(k) END;
|
||||
num[k] := 0X;
|
||||
(* the range is that of the result: infinite, or 0 from digits that are not, is too large
|
||||
(was: the decimal exponent within MaxRExp, MaxLExp, which refused 1.17549435E-38) *)
|
||||
IF expCh = "E" THEN numtyp := real;
|
||||
IF (1-OPM.MaxRExp < e) & (e <= OPM.MaxRExp) THEN
|
||||
IF e < 0 THEN realval := SHORT(f / Ten(-e))
|
||||
ELSE realval := SHORT(f * Ten(e))
|
||||
END
|
||||
ELSE err(203)
|
||||
END
|
||||
IF (e > -400) & (e < 400) THEN realval := strtof(SYSTEM.ADR(num)) ELSE realval := 0 END;
|
||||
IF (realval > MAX(REAL)) OR (realval = 0) & (m > 0) THEN err(203) END
|
||||
ELSE numtyp := longreal;
|
||||
IF (1-OPM.MaxLExp < e) & (e <= OPM.MaxLExp) THEN
|
||||
IF e < 0 THEN lrlval := f / Ten(-e)
|
||||
ELSE lrlval := f * Ten(e)
|
||||
END
|
||||
ELSE err(203)
|
||||
END
|
||||
IF (e > -400) & (e < 400) THEN lrlval := strtod(SYSTEM.ADR(num)) ELSE lrlval := 0 END;
|
||||
IF (lrlval > MAX(LONGREAL)) OR (lrlval = 0) & (m > 0) THEN err(203) END
|
||||
END
|
||||
END
|
||||
END Number;
|
||||
|
|
|
|||
|
|
@ -360,7 +360,7 @@ END ipower;
|
|||
PROCEDURE sincos* (x: LONGREAL; VAR Sin, Cos: LONGREAL);
|
||||
(* More efficient sin/cos implementation if both values are needed. *)
|
||||
BEGIN
|
||||
Sin:=sin(x); Cos:=sqrt(ONE-Sin*Sin)
|
||||
Sin:=sin(x); Cos:=cos(x) (* sqrt(ONE-Sin*Sin) lost the sign of cos and its precision near pi/2 *)
|
||||
END sincos;
|
||||
|
||||
PROCEDURE arctan2* (xn, xd: LONGREAL): LONGREAL;
|
||||
|
|
|
|||
|
|
@ -87,8 +87,7 @@ CONST
|
|||
expoMax*= 1023;
|
||||
expoMin*= 1-expoMax;
|
||||
large*= MAX(LONGREAL); (*1.7976931348623157D+308;*) (* MAX(LONGREAL) *)
|
||||
(*small*= 2.2250738585072014D-308;*)
|
||||
small*= 2.2250738585072014/9.9999999999999981D307(*/10^308)*);
|
||||
small*= 2.2250738585072014D-308; (* 2^(-1022); exact since the compiler converts and writes reals exactly *)
|
||||
IEC559*= TRUE;
|
||||
LIA1*= FALSE;
|
||||
rounds*= FALSE;
|
||||
|
|
|
|||
|
|
@ -84,8 +84,7 @@ CONST
|
|||
expoMax*= 127;
|
||||
expoMin*= 1-expoMax;
|
||||
large*= MAX(REAL);(*3.40282347E+38;*) (* MAX(REAL) *)
|
||||
(*small*= 1.17549435E-38; (* 2^(-126) *)*)
|
||||
small* = 1/8.50705917E37; (* don't know better way; -- noch *)
|
||||
small*= 1.17549435E-38; (* 2^(-126) *)
|
||||
IEC559*= TRUE;
|
||||
LIA1*= FALSE;
|
||||
rounds*= FALSE;
|
||||
|
|
@ -171,12 +170,12 @@ END fraction;
|
|||
|
||||
PROCEDURE IsInfinity * (real: REAL) : BOOLEAN;
|
||||
BEGIN
|
||||
RETURN (Reals.Expo(real) = 255) & (S.VAL(SET, real) * {0..22} = {})
|
||||
RETURN (Reals.Expo(real) = 255) & (real = real) (* not a NaN *)
|
||||
END IsInfinity;
|
||||
|
||||
PROCEDURE IsNaN * (real: REAL) : BOOLEAN;
|
||||
BEGIN
|
||||
RETURN (Reals.Expo(real) = 255) & (S.VAL(SET, real) * {0..22} # {})
|
||||
RETURN real # real (* only a NaN differs from itself *)
|
||||
END IsNaN;
|
||||
|
||||
PROCEDURE sign*(x: REAL): REAL;
|
||||
|
|
@ -195,15 +194,17 @@ PROCEDURE scale*(x: REAL; n: INTEGER): REAL;
|
|||
The value of the call scale(x,n) shall be the value x*radix^n if such
|
||||
a value exists; otherwise an execption shall occur and may be raised.
|
||||
*)
|
||||
VAR exp: LONGINT; lexp: SET;
|
||||
VAR exp: LONGINT;
|
||||
BEGIN
|
||||
IF x=ZERO THEN RETURN ZERO END;
|
||||
exp:= exponent(x)+n; (* new exponent *)
|
||||
IF exp>expoMax THEN RETURN large*sign(x) (* exception raised here *)
|
||||
ELSIF exp<expoMin THEN RETURN small*sign(x) (* exception here as well *)
|
||||
END;
|
||||
lexp:=S.VAL(SET,S.LSH(exp+expOffset,expBit)); (* shifted exponent bits *)
|
||||
RETURN S.VAL(REAL,(S.VAL(SET,x)*nMask)+lexp) (* insert new exponent *)
|
||||
(* the new exponent with Reals, as fraction: the bits of x as a SET were wrong where SET has
|
||||
64 bits (scale, sqrt and arccos of RealMath gave about 1E9) *)
|
||||
Reals.SetExpo(x, SHORT(exp+expOffset));
|
||||
RETURN x
|
||||
END scale;
|
||||
|
||||
PROCEDURE ulp*(x: REAL): REAL;
|
||||
|
|
@ -245,8 +246,8 @@ PROCEDURE intpart*(x: REAL): REAL;
|
|||
BEGIN
|
||||
loBit:=(hiBit+1)-exponent(x);
|
||||
IF loBit<=0 THEN RETURN x (* no fractional part *)
|
||||
ELSIF loBit<=hiBit+1 THEN
|
||||
RETURN S.VAL(REAL,S.VAL(SET,x)*{loBit..31}) (* integer part is extracted *)
|
||||
ELSIF loBit<=hiBit+1 THEN (* ABS(x) < 2^23: ENTIER is exact *)
|
||||
IF x<ZERO THEN RETURN -ENTIER(-x) ELSE RETURN ENTIER(x) END
|
||||
ELSE RETURN ZERO (* no whole part *)
|
||||
END
|
||||
END intpart;
|
||||
|
|
@ -266,12 +267,12 @@ PROCEDURE trunc*(x: REAL; n: INTEGER): REAL;
|
|||
significant `n' places of `x'. An exception shall occur and may be
|
||||
raised if `n' is less than or equal to zero.
|
||||
*)
|
||||
VAR loBit: INTEGER; mask: SET;
|
||||
VAR loBit, k: INTEGER;
|
||||
BEGIN loBit:=places-n;
|
||||
IF n<=0 THEN RETURN ZERO (* exception should be raised *)
|
||||
ELSIF loBit<=0 THEN RETURN x (* nothing was truncated *)
|
||||
ELSE mask:={loBit..31}; (* truncation bit mask *)
|
||||
RETURN S.VAL(REAL,S.VAL(SET,x)*mask)
|
||||
ELSIF (loBit<=0) OR (x=ZERO) THEN RETURN x (* nothing was truncated *)
|
||||
ELSE k:=n-1-exponent(x); (* x scaled by 2^k has n places before the point *)
|
||||
RETURN scale(intpart(scale(x, k)), -k)
|
||||
END
|
||||
END trunc;
|
||||
|
||||
|
|
@ -282,19 +283,14 @@ PROCEDURE round*(x: REAL; n: INTEGER): REAL;
|
|||
raised if such a value does not exist, or if `n' is less than or equal
|
||||
to zero.
|
||||
*)
|
||||
VAR loBit: INTEGER; num, mask: SET; r: REAL;
|
||||
VAR loBit, k: INTEGER; t, i: REAL;
|
||||
BEGIN loBit:=places-n;
|
||||
IF n<=0 THEN RETURN ZERO (* exception should be raised *)
|
||||
ELSIF loBit<=0 THEN RETURN x (* nothing was rounded *)
|
||||
ELSE mask:={loBit..31}; num:=S.VAL(SET,x); (* truncation bit mask and number as SET *)
|
||||
x:=S.VAL(REAL,num*mask); (* truncated result *)
|
||||
IF loBit-1 IN num THEN (* check if result should be rounded *)
|
||||
r:=scale(ONE,exponent(x)-n+1); (* rounding fraction *)
|
||||
IF 31 IN num THEN RETURN x-r (* negative rounding toward -infinity *)
|
||||
ELSE RETURN x+r (* positive rounding toward +infinity *)
|
||||
END
|
||||
ELSE RETURN x (* return truncated result *)
|
||||
END
|
||||
ELSIF (loBit<=0) OR (x=ZERO) THEN RETURN x (* nothing was rounded *)
|
||||
ELSE k:=n-1-exponent(x); (* x scaled by 2^k has n places before the point *)
|
||||
t:=scale(ABS(x), k); i:=intpart(t);
|
||||
IF t-i>=0.5 THEN i:=i+ONE END; (* the first dropped bit set: away from zero *)
|
||||
RETURN scale(i, -k)*sign(x)
|
||||
END
|
||||
END round;
|
||||
|
||||
|
|
|
|||
|
|
@ -43,6 +43,8 @@ CONST
|
|||
eps=2.9802322E-8; (* 2**(-MantBits-1) *)
|
||||
piInv=0.31830988618379067154; (* 1/pi *)
|
||||
piByTwo=1.57079632679489661923132;
|
||||
piByTwoL = 1.57079632679489661923132D0; (* for the reduction of tan in LONGREAL: with the REAL piByTwo, tan(pi/2) was infinite *)
|
||||
piL = 3.1415926535897932384626433832795028841972D0; (* for the reduction of SinCos in LONGREAL *)
|
||||
piByFour=0.78539816339744830962;
|
||||
lnv=0.6931610107421875; (* should be exact *)
|
||||
vbytwo=0.13830277879601902638E-4; (* used in sinh/cosh *)
|
||||
|
|
@ -84,7 +86,7 @@ BEGIN
|
|||
IF x#y THEN xn:=xn-HALF END;
|
||||
|
||||
(* fractional part of reduced number *)
|
||||
f:=SHORT(ABS(LONG(x)) - LONG(xn)*pi);
|
||||
f:=SHORT(ABS(LONG(x)) - LONG(xn)*piL);
|
||||
|
||||
(* Pre: |f| <= pi/2 *)
|
||||
IF ABS(f)<Limit THEN RETURN sign*f END;
|
||||
|
|
@ -219,7 +221,7 @@ BEGIN
|
|||
|
||||
(* determine n and the fraction f *)
|
||||
n:=round(x*twoByPi); xn:=n;
|
||||
f:=SHORT(LONG(x)-LONG(xn)*piByTwo);
|
||||
f:=SHORT(LONG(x)-LONG(xn)*piByTwoL);
|
||||
|
||||
(* check for underflow *)
|
||||
IF ABS(f)<Limit THEN xnum:=f; xden:=ONE
|
||||
|
|
@ -269,7 +271,7 @@ VAR
|
|||
res: REAL; i: LONGINT;
|
||||
BEGIN
|
||||
asincos(x, 0, i, res);
|
||||
IF l.err#0 THEN RETURN res END;
|
||||
IF ABS(x) > ONE THEN RETURN res END; (* this call failed; err stays set from any earlier error *)
|
||||
|
||||
(* adjust result for the correct quadrant *)
|
||||
IF i=1 THEN res:=piByFour+(piByFour+res) END;
|
||||
|
|
@ -283,7 +285,7 @@ VAR
|
|||
res: REAL; i: LONGINT;
|
||||
BEGIN
|
||||
asincos(x, 1, i, res);
|
||||
IF l.err#0 THEN RETURN res END;
|
||||
IF ABS(x) > ONE THEN RETURN res END; (* this call failed; err stays set from any earlier error *)
|
||||
|
||||
(* adjust result for the correct quadrant *)
|
||||
IF x<0 THEN
|
||||
|
|
@ -448,7 +450,7 @@ END ipower;
|
|||
PROCEDURE sincos* (x: REAL; VAR Sin, Cos: REAL);
|
||||
(* More efficient sin/cos implementation if both values are needed. *)
|
||||
BEGIN
|
||||
Sin:=sin(x); Cos:=sqrt(ONE-Sin*Sin)
|
||||
Sin:=sin(x); Cos:=cos(x) (* sqrt(ONE-Sin*Sin) lost the sign of cos and its precision near pi/2 *)
|
||||
END sincos;
|
||||
|
||||
PROCEDURE arctan2* (xn, xd: REAL): REAL;
|
||||
|
|
|
|||
|
|
@ -93,7 +93,8 @@
|
|||
MODULE ulmStreams;
|
||||
|
||||
IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Process := ulmProcess, RelatedEvents := ulmRelatedEvents, Resources := ulmResources,
|
||||
Services := ulmServices, SYS := ulmSYSTEM, SYSTEM, Types := ulmTypes;
|
||||
Services := ulmServices, SYS := ulmSYSTEM, SYSTEM, Host := ulmStreamsHost,
|
||||
Types := ulmTypes;
|
||||
|
||||
CONST
|
||||
(* 3rd parameter of Seek *)
|
||||
|
|
@ -275,11 +276,8 @@ MODULE ulmStreams;
|
|||
|
||||
VAR
|
||||
null*: Stream; (* accepts any output; does not return input *)
|
||||
(* these streams are set by other modules;
|
||||
after initialization of Streams they equal `null';
|
||||
so, connections with the standard UNIX streams must be
|
||||
done by other modules
|
||||
*)
|
||||
(* The initial streams are connected to the host standard handles.
|
||||
More specialized modules may replace them. *)
|
||||
stdin*, stdout*, stderr*: Stream;
|
||||
errormsg*: ARRAY errorcodes OF Events.Message;
|
||||
error*: Events.EventType;
|
||||
|
|
@ -294,6 +292,7 @@ MODULE ulmStreams;
|
|||
*)
|
||||
freelist: Buffer; (* list of free buffers *)
|
||||
nullif: Interface; (* interface of null-devices *)
|
||||
stdinif, stdoutif, stderrif: Interface;
|
||||
|
||||
(* === private procedures ========================================= *)
|
||||
|
||||
|
|
@ -2093,6 +2092,36 @@ MODULE ulmStreams;
|
|||
Init(s, nullif, {read, write}, nobuf);
|
||||
END OpenNulldev;
|
||||
|
||||
PROCEDURE StdInRead(s: Stream; ptr: Address; cnt: Count): Count;
|
||||
BEGIN
|
||||
RETURN Host.ReadStdIn(ptr, cnt)
|
||||
END StdInRead;
|
||||
|
||||
PROCEDURE StdOutWrite(s: Stream; ptr: Address; cnt: Count): Count;
|
||||
BEGIN
|
||||
RETURN Host.WriteStdOut(ptr, cnt)
|
||||
END StdOutWrite;
|
||||
|
||||
PROCEDURE StdErrWrite(s: Stream; ptr: Address; cnt: Count): Count;
|
||||
BEGIN
|
||||
RETURN Host.WriteStdErr(ptr, cnt)
|
||||
END StdErrWrite;
|
||||
|
||||
PROCEDURE OpenStandardStreams;
|
||||
BEGIN
|
||||
NEW(stdinif); stdinif.addrread := StdInRead;
|
||||
NEW(stdin); Services.Init(stdin, type);
|
||||
Init(stdin, stdinif, {read, addrio}, nobuf);
|
||||
|
||||
NEW(stdoutif); stdoutif.addrwrite := StdOutWrite;
|
||||
NEW(stdout); Services.Init(stdout, type);
|
||||
Init(stdout, stdoutif, {write, addrio}, nobuf);
|
||||
|
||||
NEW(stderrif); stderrif.addrwrite := StdErrWrite;
|
||||
NEW(stderr); Services.Init(stderr, type);
|
||||
Init(stderr, stderrif, {write, addrio}, nobuf)
|
||||
END OpenStandardStreams;
|
||||
|
||||
PROCEDURE ExitHandler(event: Events.Event);
|
||||
(* flush all streams on exit;
|
||||
we do not close them to allow output by other exit event handlers
|
||||
|
|
@ -2143,7 +2172,8 @@ BEGIN
|
|||
|
||||
opened := NIL;
|
||||
InitNullIf(nullif);
|
||||
OpenNulldev(null); stdin := null; stdout := null; stderr := null;
|
||||
OpenNulldev(null);
|
||||
OpenStandardStreams;
|
||||
|
||||
Events.Handler(Process.termination, ExitHandler);
|
||||
Events.Handler(Process.startOfGarbageCollection, FreeHandler);
|
||||
|
|
|
|||
35
src/library/ulm/ulmStreamsHost.Mod
Normal file
35
src/library/ulm/ulmStreamsHost.Mod
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
(* Host bindings for the standard streams used by ulmStreams. *)
|
||||
MODULE ulmStreamsHost;
|
||||
|
||||
IMPORT SYSTEM, Platform;
|
||||
|
||||
TYPE
|
||||
Address* = SYSTEM.ADDRESS;
|
||||
Count* = SYSTEM.INT32;
|
||||
|
||||
PROCEDURE ReadStdIn* (address: Address; count: Count): Count;
|
||||
VAR actual: LONGINT;
|
||||
BEGIN
|
||||
IF Platform.Read(Platform.StdIn, address, count, actual) # 0 THEN
|
||||
RETURN -1
|
||||
END;
|
||||
RETURN actual
|
||||
END ReadStdIn;
|
||||
|
||||
PROCEDURE WriteStdOut* (address: Address; count: Count): Count;
|
||||
BEGIN
|
||||
IF Platform.Write(Platform.StdOut, address, count) # 0 THEN
|
||||
RETURN -1
|
||||
END;
|
||||
RETURN count
|
||||
END WriteStdOut;
|
||||
|
||||
PROCEDURE WriteStdErr* (address: Address; count: Count): Count;
|
||||
BEGIN
|
||||
IF Platform.Write(Platform.StdErr, address, count) # 0 THEN
|
||||
RETURN -1
|
||||
END;
|
||||
RETURN count
|
||||
END WriteStdErr;
|
||||
|
||||
END ulmStreamsHost.
|
||||
|
|
@ -82,6 +82,21 @@ MODULE ulmSysIO;
|
|||
Protection* = Types.Int32;
|
||||
Whence* = Types.Int32;
|
||||
|
||||
PROCEDURE StdIn*() : File;
|
||||
BEGIN
|
||||
RETURN Platform.StdIn
|
||||
END StdIn;
|
||||
|
||||
PROCEDURE StdOut*() : File;
|
||||
BEGIN
|
||||
RETURN Platform.StdOut
|
||||
END StdOut;
|
||||
|
||||
PROCEDURE StdErr*() : File;
|
||||
BEGIN
|
||||
RETURN Platform.StdErr
|
||||
END StdErr;
|
||||
|
||||
PROCEDURE OpenCreat*(VAR fd: File;
|
||||
filename: ARRAY OF CHAR; options: Types.Set;
|
||||
protection: Protection;
|
||||
|
|
@ -179,8 +194,8 @@ MODULE ulmSysIO;
|
|||
BEGIN
|
||||
interrupted := FALSE;
|
||||
LOOP
|
||||
error := Platform.Write(fd, buf, cnt);
|
||||
IF error = 0 THEN RETURN cnt (* todo: Upfate Platform.Write to return actual length written. *)
|
||||
error := Platform.WriteCount(fd, buf, cnt, byteswritten);
|
||||
IF error = 0 THEN RETURN byteswritten
|
||||
ELSE
|
||||
IF Platform.Interrupted(error) THEN
|
||||
interrupted := TRUE;
|
||||
|
|
@ -211,6 +226,29 @@ MODULE ulmSysIO;
|
|||
END;
|
||||
END Seek;
|
||||
|
||||
PROCEDURE Tell*(fd: File; VAR offset: Count;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR error: Platform.ErrorCode;
|
||||
BEGIN
|
||||
error := Platform.Tell(fd, offset);
|
||||
IF error = 0 THEN RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, error, Sys.lseek, "");
|
||||
RETURN FALSE
|
||||
END
|
||||
END Tell;
|
||||
|
||||
PROCEDURE Isatty*(fd: File) : BOOLEAN;
|
||||
BEGIN
|
||||
RETURN Platform.IsConsole(fd)
|
||||
END Isatty;
|
||||
|
||||
PROCEDURE Seekable*(fd: File) : BOOLEAN;
|
||||
VAR offset: Count;
|
||||
BEGIN
|
||||
RETURN Platform.Tell(fd, offset) = 0
|
||||
END Seekable;
|
||||
|
||||
(*
|
||||
|
||||
PROCEDURE Tell*(fd: File; VAR offset: Count;
|
||||
|
|
|
|||
309
src/library/ulm/ulmTerminals.Mod
Normal file
309
src/library/ulm/ulmTerminals.Mod
Normal file
|
|
@ -0,0 +1,309 @@
|
|||
(* Basic terminal abstraction from Ulm's Oberon Library. *)
|
||||
MODULE ulmTerminals;
|
||||
|
||||
IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities,
|
||||
RelatedEvents := ulmRelatedEvents, Services := ulmServices,
|
||||
Streams := ulmStreams;
|
||||
|
||||
CONST
|
||||
autoleftmargin* = 0;
|
||||
autorightmargin* = 1;
|
||||
overstrikes* = 2;
|
||||
safelastcolumn* = 3;
|
||||
|
||||
cannotSetEcho* = 0;
|
||||
cannotSetTermMode* = 1;
|
||||
cannotSetCursor* = 2;
|
||||
cannotMoveCursor* = 3;
|
||||
cannotSetAppearance* = 4;
|
||||
cannotScroll* = 5;
|
||||
cannotSetScrollRegion* = 6;
|
||||
cannotClearScreen* = 7;
|
||||
invalidDirection* = 8;
|
||||
invalidRegion* = 9;
|
||||
invalidPosition* = 10;
|
||||
notSupported* = 11;
|
||||
errorcodes* = 12;
|
||||
|
||||
on* = 0;
|
||||
off* = 1;
|
||||
raw* = 0;
|
||||
cooked* = 1;
|
||||
forward* = 0;
|
||||
reverse* = 1;
|
||||
visible* = 0;
|
||||
invisible* = 1;
|
||||
|
||||
setEcho* = 0;
|
||||
setTermMode* = 1;
|
||||
setCursor* = 2;
|
||||
moveCursor* = 3;
|
||||
setAppearance* = 4;
|
||||
scroll* = 5;
|
||||
setScrollRegion* = 6;
|
||||
clearScreen* = 7;
|
||||
|
||||
TYPE
|
||||
CapabilitySet* = SET;
|
||||
EchoMode* = SHORTINT;
|
||||
TermMode* = SHORTINT;
|
||||
Direction* = SHORTINT;
|
||||
Shape* = SHORTINT;
|
||||
Stream* = POINTER TO StreamRec;
|
||||
|
||||
WindowChangeEvent* = POINTER TO WindowChangeEventRec;
|
||||
WindowChangeEventRec* = RECORD (Events.EventRec)
|
||||
stream*: Streams.Stream;
|
||||
newlines*, newcolumns*: INTEGER
|
||||
END;
|
||||
|
||||
InterruptEvent* = POINTER TO InterruptEventRec;
|
||||
InterruptEventRec* = RECORD (Events.EventRec)
|
||||
stream*: Streams.Stream
|
||||
END;
|
||||
|
||||
QuitEvent* = POINTER TO QuitEventRec;
|
||||
QuitEventRec* = RECORD (Events.EventRec)
|
||||
stream*: Streams.Stream
|
||||
END;
|
||||
|
||||
HangupEvent* = POINTER TO HangupEventRec;
|
||||
HangupEventRec* = RECORD (Events.EventRec)
|
||||
stream*: Streams.Stream
|
||||
END;
|
||||
|
||||
ErrorEvent* = POINTER TO ErrorEventRec;
|
||||
ErrorEventRec* = RECORD (Events.EventRec)
|
||||
errorcode*: SHORTINT
|
||||
END;
|
||||
|
||||
SetTermModeProc* = PROCEDURE(s: Streams.Stream; mode: TermMode);
|
||||
SetEchoProc* = PROCEDURE(s: Streams.Stream; mode: EchoMode);
|
||||
SetCursorProc* = PROCEDURE(s: Streams.Stream; line, column: INTEGER);
|
||||
MoveCursorProc* = PROCEDURE(s: Streams.Stream; fromline, fromcolumn,
|
||||
toline, tocolumn: INTEGER);
|
||||
SetAppearanceProc* = PROCEDURE(s: Streams.Stream; shape: Shape);
|
||||
ScrollProc* = PROCEDURE(s: Streams.Stream; dir: Direction);
|
||||
SetScrollRegionProc* = PROCEDURE(s: Streams.Stream; top, bottom: INTEGER);
|
||||
ClearProc* = PROCEDURE(s: Streams.Stream);
|
||||
|
||||
Interface* = POINTER TO InterfaceRec;
|
||||
InterfaceRec* = RECORD (Objects.ObjectRec)
|
||||
setEcho*: SetEchoProc;
|
||||
setTermMode*: SetTermModeProc;
|
||||
setCursor*: SetCursorProc;
|
||||
moveCursor*: MoveCursorProc;
|
||||
setAppearance*: SetAppearanceProc;
|
||||
scroll*: ScrollProc;
|
||||
setScrollRegion*: SetScrollRegionProc;
|
||||
clearScreen*: ClearProc
|
||||
END;
|
||||
|
||||
Status* = RECORD (Objects.ObjectRec)
|
||||
lines*, columns*: INTEGER;
|
||||
scrtop*, scrbottom*: INTEGER;
|
||||
echo*: EchoMode;
|
||||
mode*: TermMode;
|
||||
characteristics*: SET;
|
||||
scrollDirections*: SET;
|
||||
cursorShape*: Shape
|
||||
END;
|
||||
|
||||
StreamRec* = RECORD (Streams.StreamRec)
|
||||
status: Status;
|
||||
caps: CapabilitySet;
|
||||
interface: Interface
|
||||
END;
|
||||
|
||||
VAR
|
||||
console*: Streams.Stream;
|
||||
windowchanged*, interrupt*, quit*, hangup*: Events.EventType;
|
||||
error*: Events.EventType;
|
||||
errormsg*: ARRAY errorcodes OF Events.Message;
|
||||
terminaltype: Services.Type;
|
||||
|
||||
PROCEDURE Error(object: RelatedEvents.Object; errorcode: SHORTINT);
|
||||
VAR event: ErrorEvent;
|
||||
BEGIN
|
||||
NEW(event);
|
||||
event.type := error;
|
||||
event.message := errormsg[errorcode];
|
||||
event.errorcode := errorcode;
|
||||
RelatedEvents.Raise(object, event)
|
||||
END Error;
|
||||
|
||||
PROCEDURE Init*(s: Stream; status: Status; caps: CapabilitySet;
|
||||
interface: Interface);
|
||||
BEGIN
|
||||
ASSERT(interface # NIL);
|
||||
s.status := status;
|
||||
s.caps := caps;
|
||||
s.interface := interface
|
||||
END Init;
|
||||
|
||||
PROCEDURE SetScreenSize(event: Events.Event);
|
||||
BEGIN
|
||||
WITH event: WindowChangeEvent DO
|
||||
event.stream(Stream).status.lines := event.newlines;
|
||||
event.stream(Stream).status.columns := event.newcolumns
|
||||
END
|
||||
END SetScreenSize;
|
||||
|
||||
PROCEDURE ClearScreen*(s: Streams.Stream);
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
IF clearScreen IN s.caps THEN s.interface.clearScreen(s)
|
||||
ELSE Error(s, cannotClearScreen)
|
||||
END
|
||||
END
|
||||
END ClearScreen;
|
||||
|
||||
PROCEDURE Echo*(s: Streams.Stream; mode: EchoMode);
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
IF s.status.echo # mode THEN
|
||||
IF setEcho IN s.caps THEN
|
||||
s.interface.setEcho(s, mode);
|
||||
s.status.echo := mode
|
||||
ELSE
|
||||
Error(s, cannotSetEcho)
|
||||
END
|
||||
END
|
||||
END
|
||||
END Echo;
|
||||
|
||||
PROCEDURE SetTermMode*(s: Streams.Stream; mode: TermMode);
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
IF s.status.mode # mode THEN
|
||||
IF setTermMode IN s.caps THEN
|
||||
s.interface.setTermMode(s, mode);
|
||||
s.status.mode := mode
|
||||
ELSE
|
||||
Error(s, cannotSetTermMode)
|
||||
END
|
||||
END
|
||||
END
|
||||
END SetTermMode;
|
||||
|
||||
PROCEDURE SetCursor*(s: Streams.Stream; line, column: INTEGER);
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
IF (line >= 0) & (line < s.status.lines) &
|
||||
(column >= 0) & (column < s.status.columns) THEN
|
||||
IF setCursor IN s.caps THEN s.interface.setCursor(s, line, column)
|
||||
ELSE Error(s, cannotSetCursor)
|
||||
END
|
||||
ELSE
|
||||
Error(s, invalidPosition)
|
||||
END
|
||||
END
|
||||
END SetCursor;
|
||||
|
||||
PROCEDURE MoveCursor*(s: Streams.Stream; fromline, fromcolumn,
|
||||
toline, tocolumn: INTEGER);
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
IF (fromline >= 0) & (fromline < s.status.lines) &
|
||||
(toline >= 0) & (toline < s.status.lines) &
|
||||
(fromcolumn >= 0) & (fromcolumn <= s.status.columns) &
|
||||
(tocolumn >= 0) & (tocolumn < s.status.columns) THEN
|
||||
IF moveCursor IN s.caps THEN
|
||||
s.interface.moveCursor(s, fromline, fromcolumn, toline, tocolumn)
|
||||
ELSIF setCursor IN s.caps THEN
|
||||
s.interface.setCursor(s, toline, tocolumn)
|
||||
ELSE
|
||||
Error(s, cannotMoveCursor)
|
||||
END
|
||||
ELSE
|
||||
Error(s, invalidPosition)
|
||||
END
|
||||
END
|
||||
END MoveCursor;
|
||||
|
||||
PROCEDURE CursorAppearance*(s: Streams.Stream; shape: Shape);
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
IF shape # s.status.cursorShape THEN
|
||||
IF setAppearance IN s.caps THEN
|
||||
s.interface.setAppearance(s, shape);
|
||||
s.status.cursorShape := shape
|
||||
ELSE
|
||||
Error(s, cannotSetAppearance)
|
||||
END
|
||||
END
|
||||
END
|
||||
END CursorAppearance;
|
||||
|
||||
PROCEDURE Scroll*(s: Streams.Stream; dir: Direction);
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
IF dir IN s.status.scrollDirections THEN
|
||||
IF scroll IN s.caps THEN s.interface.scroll(s, dir)
|
||||
ELSE Error(s, cannotScroll)
|
||||
END
|
||||
ELSE
|
||||
Error(s, invalidDirection)
|
||||
END
|
||||
END
|
||||
END Scroll;
|
||||
|
||||
PROCEDURE SetScrollRegion*(s: Streams.Stream; top, bottom: INTEGER);
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
IF (top >= 0) & (top < s.status.lines) &
|
||||
(bottom >= 0) & (bottom < s.status.lines) & (top < bottom) THEN
|
||||
IF setScrollRegion IN s.caps THEN
|
||||
s.interface.setScrollRegion(s, top, bottom);
|
||||
s.status.scrtop := top;
|
||||
s.status.scrbottom := bottom;
|
||||
IF setCursor IN s.caps THEN SetCursor(s, bottom, 0) END
|
||||
ELSE
|
||||
Error(s, cannotSetScrollRegion)
|
||||
END
|
||||
ELSE
|
||||
Error(s, invalidRegion)
|
||||
END
|
||||
END
|
||||
END SetScrollRegion;
|
||||
|
||||
PROCEDURE Capabilities*(s: Streams.Stream): CapabilitySet;
|
||||
BEGIN
|
||||
WITH s: Stream DO RETURN s.caps END
|
||||
END Capabilities;
|
||||
|
||||
PROCEDURE GetStatus*(s: Streams.Stream; VAR status: Status);
|
||||
BEGIN
|
||||
WITH s: Stream DO status := s.status END
|
||||
END GetStatus;
|
||||
|
||||
BEGIN
|
||||
Services.CreateType(terminaltype, "Terminals.Stream", "Streams.Stream");
|
||||
|
||||
Events.Define(error);
|
||||
Events.SetPriority(error, Priorities.liberrors);
|
||||
errormsg[cannotSetEcho] := "cannot change echo mode";
|
||||
errormsg[cannotSetTermMode] := "cannot change terminal mode";
|
||||
errormsg[cannotSetCursor] := "cannot set cursor";
|
||||
errormsg[cannotMoveCursor] := "cannot move cursor";
|
||||
errormsg[cannotSetAppearance] := "cannot change appearance of cursor";
|
||||
errormsg[cannotScroll] := "terminal cannot scroll";
|
||||
errormsg[cannotSetScrollRegion] := "scroll regions not supported by terminal";
|
||||
errormsg[cannotClearScreen] := "cannot clear screen";
|
||||
errormsg[invalidDirection] := "direction not valid";
|
||||
errormsg[invalidPosition] := "cursor coordinates not valid";
|
||||
errormsg[invalidRegion] := "parameters for scroll region not valid";
|
||||
errormsg[notSupported] :=
|
||||
"module Terminals not supported by underlying stream implementation";
|
||||
|
||||
Events.Define(windowchanged);
|
||||
Events.Define(interrupt);
|
||||
Events.Define(quit);
|
||||
Events.Define(hangup);
|
||||
Events.SetPriority(windowchanged, Priorities.interrupts);
|
||||
Events.SetPriority(interrupt, Priorities.interrupts);
|
||||
Events.SetPriority(quit, Priorities.interrupts);
|
||||
Events.SetPriority(hangup, Priorities.interrupts);
|
||||
Events.Handler(windowchanged, SetScreenSize);
|
||||
console := NIL
|
||||
END ulmTerminals.
|
||||
235
src/library/ulm/ulmUnixFiles.Mod
Normal file
235
src/library/ulm/ulmUnixFiles.Mod
Normal file
|
|
@ -0,0 +1,235 @@
|
|||
(* Platform-backed port of Ulm's UnixFiles stream module. *)
|
||||
MODULE ulmUnixFiles;
|
||||
|
||||
IMPORT Events := ulmEvents, Priorities := ulmPriorities,
|
||||
RelatedEvents := ulmRelatedEvents, Services := ulmServices,
|
||||
Streams := ulmStreams, Sys := ulmSys, SysErrors := ulmSysErrors,
|
||||
SysIO := ulmSysIO, SysStat := ulmSysStat, SysTypes := ulmSysTypes,
|
||||
Platform, SYSTEM;
|
||||
|
||||
CONST
|
||||
illegalMode* = 0;
|
||||
invalidFd* = 1;
|
||||
errorcodes* = 2;
|
||||
|
||||
read* = 0;
|
||||
write* = 1;
|
||||
rdwr* = 2;
|
||||
create* = 4;
|
||||
condcreate* = 8;
|
||||
|
||||
TYPE
|
||||
ErrorCode* = SHORTINT;
|
||||
ErrorEvent* = POINTER TO ErrorEventRec;
|
||||
ErrorEventRec* = RECORD (Events.EventRec)
|
||||
errorcode*: ErrorCode
|
||||
END;
|
||||
|
||||
Mode* = SHORTINT;
|
||||
Stream* = POINTER TO StreamRec;
|
||||
StreamRec* = RECORD (Streams.StreamRec)
|
||||
file*: SysTypes.File;
|
||||
interrupted*: BOOLEAN;
|
||||
retry*: BOOLEAN
|
||||
END;
|
||||
|
||||
VAR
|
||||
error*: Events.EventType;
|
||||
errormsg*: ARRAY errorcodes OF Events.Message;
|
||||
interface: Streams.Interface;
|
||||
type: Services.Type;
|
||||
|
||||
PROCEDURE Error(errors: RelatedEvents.Object; errorcode: ErrorCode);
|
||||
VAR event: ErrorEvent;
|
||||
BEGIN
|
||||
NEW(event);
|
||||
event.type := error;
|
||||
event.message := errormsg[errorcode];
|
||||
event.errorcode := errorcode;
|
||||
RelatedEvents.Raise(errors, event)
|
||||
END Error;
|
||||
|
||||
PROCEDURE ReadBuf(s: Streams.Stream; address: SysTypes.Address;
|
||||
count: SysTypes.Count): SysTypes.Count;
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
RETURN SysIO.Read(s.file, address, count, s, s.retry, s.interrupted)
|
||||
END
|
||||
END ReadBuf;
|
||||
|
||||
PROCEDURE WriteBuf(s: Streams.Stream; address: SysTypes.Address;
|
||||
count: SysTypes.Count): SysTypes.Count;
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
RETURN SysIO.Write(s.file, address, count, s, s.retry, s.interrupted)
|
||||
END
|
||||
END WriteBuf;
|
||||
|
||||
PROCEDURE ReadByte(s: Streams.Stream; VAR byte: Streams.Byte): BOOLEAN;
|
||||
VAR count: SysTypes.Count;
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
count := SysIO.Read(s.file, SYSTEM.ADR(byte), 1, s,
|
||||
s.retry, s.interrupted);
|
||||
RETURN count = 1
|
||||
END
|
||||
END ReadByte;
|
||||
|
||||
PROCEDURE WriteByte(s: Streams.Stream; byte: Streams.Byte): BOOLEAN;
|
||||
VAR count: SysTypes.Count;
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
count := SysIO.Write(s.file, SYSTEM.ADR(byte), 1, s,
|
||||
s.retry, s.interrupted);
|
||||
RETURN count = 1
|
||||
END
|
||||
END WriteByte;
|
||||
|
||||
PROCEDURE Seek(s: Streams.Stream; offset: SysTypes.Count;
|
||||
whence: Streams.Whence): BOOLEAN;
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
RETURN SysIO.Seek(s.file, offset, whence, s)
|
||||
END
|
||||
END Seek;
|
||||
|
||||
PROCEDURE Tell(s: Streams.Stream; VAR offset: SysTypes.Count): BOOLEAN;
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
RETURN SysIO.Tell(s.file, offset, s)
|
||||
END
|
||||
END Tell;
|
||||
|
||||
PROCEDURE Close(s: Streams.Stream): BOOLEAN;
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
RETURN SysIO.Close(s.file, s, FALSE, s.interrupted)
|
||||
END
|
||||
END Close;
|
||||
|
||||
PROCEDURE OpenFd*(VAR s: Streams.Stream; fd: SysTypes.File;
|
||||
mode: Mode; bufmode: Streams.BufMode;
|
||||
errors: RelatedEvents.Object): BOOLEAN;
|
||||
VAR caps: Streams.CapabilitySet; newfile: Stream; stat: SysStat.StatRec;
|
||||
BEGIN
|
||||
IF ~SysStat.Fstat(fd, stat, errors) THEN
|
||||
Error(errors, invalidFd);
|
||||
RETURN FALSE
|
||||
END;
|
||||
|
||||
caps := {Streams.addrio, Streams.close};
|
||||
CASE mode OF
|
||||
| read: INCL(caps, Streams.read)
|
||||
| write: INCL(caps, Streams.write)
|
||||
| rdwr: caps := caps + {Streams.read, Streams.write}
|
||||
ELSE
|
||||
Error(errors, illegalMode);
|
||||
RETURN FALSE
|
||||
END;
|
||||
|
||||
IF SysIO.Seekable(fd) THEN
|
||||
caps := caps + {Streams.seek, Streams.tell, Streams.holes}
|
||||
END;
|
||||
|
||||
NEW(newfile);
|
||||
Services.Init(newfile, type);
|
||||
Streams.Init(newfile, interface, caps, bufmode);
|
||||
newfile.file := fd;
|
||||
newfile.interrupted := FALSE;
|
||||
newfile.retry := TRUE;
|
||||
RelatedEvents.QueueEvents(newfile);
|
||||
s := newfile;
|
||||
RETURN TRUE
|
||||
END OpenFd;
|
||||
|
||||
PROCEDURE Open*(VAR s: Streams.Stream; filename: ARRAY OF CHAR;
|
||||
mode: Mode; bufmode: Streams.BufMode;
|
||||
errors: RelatedEvents.Object): BOOLEAN;
|
||||
CONST accessMask = 4;
|
||||
VAR accessMode, openMode: Mode; access, creation: INTEGER;
|
||||
fd: SysTypes.File; interrupted: BOOLEAN; hostError: Platform.ErrorCode;
|
||||
BEGIN
|
||||
accessMode := mode MOD accessMask;
|
||||
openMode := mode - accessMode;
|
||||
|
||||
CASE accessMode OF
|
||||
| read: access := Platform.ReadOnly
|
||||
| write: access := Platform.WriteOnly
|
||||
| rdwr: access := Platform.ReadWrite
|
||||
ELSE
|
||||
Error(errors, illegalMode);
|
||||
RETURN FALSE
|
||||
END;
|
||||
|
||||
CASE openMode OF
|
||||
| 0: creation := Platform.OpenExisting
|
||||
| create: creation := Platform.CreateAlways
|
||||
| condcreate: creation := Platform.OpenAlways
|
||||
ELSE
|
||||
Error(errors, illegalMode);
|
||||
RETURN FALSE
|
||||
END;
|
||||
|
||||
filename[LEN(filename)-1] := 0X;
|
||||
REPEAT
|
||||
hostError := Platform.OpenFile(filename, access, creation, fd)
|
||||
UNTIL (hostError = 0) OR ~Platform.Interrupted(hostError);
|
||||
IF hostError # 0 THEN
|
||||
SysErrors.Raise(errors, hostError, Sys.open, filename);
|
||||
RETURN FALSE
|
||||
END;
|
||||
|
||||
IF OpenFd(s, fd, accessMode, bufmode, errors) THEN
|
||||
RETURN TRUE
|
||||
END;
|
||||
IF ~SysIO.Close(fd, errors, FALSE, interrupted) THEN END;
|
||||
RETURN FALSE
|
||||
END Open;
|
||||
|
||||
PROCEDURE InitInterface;
|
||||
BEGIN
|
||||
NEW(interface);
|
||||
interface.addrread := ReadBuf;
|
||||
interface.addrwrite := WriteBuf;
|
||||
interface.read := ReadByte;
|
||||
interface.write := WriteByte;
|
||||
interface.seek := Seek;
|
||||
interface.tell := Tell;
|
||||
interface.close := Close
|
||||
END InitInterface;
|
||||
|
||||
PROCEDURE InitStandardStreams;
|
||||
PROCEDURE Connect(VAR stream: Streams.Stream; fd: SysTypes.File; mode: Mode);
|
||||
VAR bufmode: Streams.BufMode;
|
||||
BEGIN
|
||||
IF fd = SysIO.StdErr() THEN
|
||||
bufmode := Streams.nobuf
|
||||
ELSIF SysIO.Isatty(fd) THEN
|
||||
bufmode := Streams.linebuf
|
||||
ELSIF fd = SysIO.StdOut() THEN
|
||||
(* ULM process termination is not wired into VOC program shutdown. *)
|
||||
bufmode := Streams.nobuf
|
||||
ELSE
|
||||
bufmode := Streams.onebuf
|
||||
END;
|
||||
IF ~OpenFd(stream, fd, mode, bufmode, NIL) THEN END
|
||||
END Connect;
|
||||
BEGIN
|
||||
Connect(Streams.stdin, SysIO.StdIn(), rdwr);
|
||||
Connect(Streams.stdout, SysIO.StdOut(), rdwr);
|
||||
Connect(Streams.stderr, SysIO.StdErr(), write);
|
||||
IF (Streams.GetBufMode(Streams.stdin) = Streams.linebuf) &
|
||||
(Streams.GetBufMode(Streams.stdout) = Streams.linebuf) THEN
|
||||
Streams.Tie(Streams.stdin, Streams.stdout)
|
||||
END
|
||||
END InitStandardStreams;
|
||||
|
||||
BEGIN
|
||||
errormsg[illegalMode] := "illegal opening mode";
|
||||
errormsg[invalidFd] := "invalid file descriptor";
|
||||
Events.Define(error);
|
||||
Events.SetPriority(error, Priorities.liberrors);
|
||||
InitInterface;
|
||||
Services.CreateType(type, "UnixFiles.Stream", "Streams.Stream");
|
||||
InitStandardStreams
|
||||
END ulmUnixFiles.
|
||||
327
src/library/ulm/ulmUnixTerminals.Mod
Normal file
327
src/library/ulm/ulmUnixTerminals.Mod
Normal file
|
|
@ -0,0 +1,327 @@
|
|||
(* Synchronous Unix terminal streams backed by Platform termios operations. *)
|
||||
MODULE ulmUnixTerminals;
|
||||
|
||||
IMPORT Heap, SYSTEM, Forwarders := ulmForwarders,
|
||||
RelatedEvents := ulmRelatedEvents, Services := ulmServices,
|
||||
Streams := ulmStreams, Sys := ulmSys, SysErrors := ulmSysErrors,
|
||||
Terminals := ulmTerminals, UnixFiles := ulmUnixFiles, Platform;
|
||||
|
||||
TYPE
|
||||
Stream = POINTER TO StreamRec;
|
||||
StreamRec = RECORD (Terminals.StreamRec)
|
||||
instream, outstream: Streams.Stream;
|
||||
inputState, outputState: Platform.TerminalState;
|
||||
inputHandle, outputHandle: Platform.FileHandle;
|
||||
owned: Streams.Stream
|
||||
END;
|
||||
|
||||
VAR
|
||||
streamType: Services.Type;
|
||||
streamInterface: Streams.Interface;
|
||||
terminalInterface: Terminals.Interface;
|
||||
|
||||
PROCEDURE RaiseHostError(s: Streams.Stream; error: Platform.ErrorCode);
|
||||
BEGIN
|
||||
IF error # 0 THEN SysErrors.Raise(s, error, Sys.ioctl, "") END
|
||||
END RaiseHostError;
|
||||
|
||||
PROCEDURE ReadByte(s: Streams.Stream; VAR byte: Streams.Byte): BOOLEAN;
|
||||
BEGIN
|
||||
WITH s: Stream DO RETURN Streams.ReadByte(s.instream, byte) END
|
||||
END ReadByte;
|
||||
|
||||
PROCEDURE WriteByte(s: Streams.Stream; byte: Streams.Byte): BOOLEAN;
|
||||
BEGIN
|
||||
WITH s: Stream DO RETURN Streams.WriteByte(s.outstream, byte) END
|
||||
END WriteByte;
|
||||
|
||||
PROCEDURE Flush(s: Streams.Stream): BOOLEAN;
|
||||
BEGIN
|
||||
WITH s: Stream DO RETURN Streams.Flush(s.outstream) END
|
||||
END Flush;
|
||||
|
||||
PROCEDURE RestoreState(handle: Platform.FileHandle;
|
||||
VAR state: Platform.TerminalState): Platform.ErrorCode;
|
||||
VAR error: Platform.ErrorCode;
|
||||
BEGIN
|
||||
IF state = 0 THEN RETURN 0 END;
|
||||
REPEAT
|
||||
error := Platform.RestoreTerminalState(handle, state)
|
||||
UNTIL (error = 0) OR ~Platform.Interrupted(error);
|
||||
IF error = 0 THEN Platform.ReleaseTerminalState(state) END;
|
||||
RETURN error
|
||||
END RestoreState;
|
||||
|
||||
PROCEDURE Restore(s: Stream; report: BOOLEAN): BOOLEAN;
|
||||
VAR ok: BOOLEAN; error: Platform.ErrorCode;
|
||||
BEGIN
|
||||
ok := TRUE;
|
||||
error := RestoreState(s.outputHandle, s.outputState);
|
||||
IF error # 0 THEN
|
||||
IF report THEN RaiseHostError(s, error) END;
|
||||
ok := FALSE
|
||||
END;
|
||||
error := RestoreState(s.inputHandle, s.inputState);
|
||||
IF error # 0 THEN
|
||||
IF report THEN RaiseHostError(s, error) END;
|
||||
ok := FALSE
|
||||
END;
|
||||
RETURN ok
|
||||
END Restore;
|
||||
|
||||
PROCEDURE Close(s: Streams.Stream): BOOLEAN;
|
||||
VAR ok: BOOLEAN;
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
ok := Restore(s, TRUE);
|
||||
IF ok & (s.owned # NIL) THEN
|
||||
ok := Streams.Close(s.owned);
|
||||
IF ok THEN s.owned := NIL END
|
||||
END;
|
||||
RETURN ok
|
||||
END
|
||||
END Close;
|
||||
|
||||
PROCEDURE Finalize(object: SYSTEM.PTR);
|
||||
VAR s: Stream;
|
||||
BEGIN
|
||||
s := SYSTEM.VAL(Stream, object);
|
||||
IF ~Restore(s, FALSE) THEN
|
||||
Platform.ReleaseTerminalState(s.outputState);
|
||||
Platform.ReleaseTerminalState(s.inputState)
|
||||
END;
|
||||
IF s.owned # NIL THEN
|
||||
IF Streams.Close(s.owned) THEN END;
|
||||
s.owned := NIL
|
||||
END
|
||||
END Finalize;
|
||||
|
||||
PROCEDURE SetEcho(s: Streams.Stream; mode: Terminals.EchoMode);
|
||||
VAR error: Platform.ErrorCode;
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
IF s.inputState # 0 THEN
|
||||
REPEAT
|
||||
error := Platform.SetTerminalEcho(s.inputHandle, mode = Terminals.on)
|
||||
UNTIL (error = 0) OR ~Platform.Interrupted(error);
|
||||
RaiseHostError(s, error)
|
||||
END
|
||||
END
|
||||
END SetEcho;
|
||||
|
||||
PROCEDURE SetTermMode(s: Streams.Stream; mode: Terminals.TermMode);
|
||||
VAR error: Platform.ErrorCode; raw: BOOLEAN;
|
||||
BEGIN
|
||||
WITH s: Stream DO
|
||||
raw := mode = Terminals.raw;
|
||||
IF s.inputState # 0 THEN
|
||||
REPEAT
|
||||
error := Platform.SetTerminalInputMode(s.inputHandle, raw)
|
||||
UNTIL (error = 0) OR ~Platform.Interrupted(error);
|
||||
RaiseHostError(s, error)
|
||||
END;
|
||||
IF s.outputState # 0 THEN
|
||||
IF ~Streams.Flush(s.outstream) THEN END;
|
||||
REPEAT
|
||||
error := Platform.SetTerminalOutputMode(s.outputHandle, raw)
|
||||
UNTIL (error = 0) OR ~Platform.Interrupted(error);
|
||||
RaiseHostError(s, error)
|
||||
END
|
||||
END
|
||||
END SetTermMode;
|
||||
|
||||
PROCEDURE Open*(VAR s: Streams.Stream; instream, outstream: Streams.Stream;
|
||||
tiname: ARRAY OF CHAR;
|
||||
errors: RelatedEvents.Object): BOOLEAN;
|
||||
VAR newterm: Stream; status: Terminals.Status;
|
||||
caps: Terminals.CapabilitySet; streamCaps: Streams.CapabilitySet;
|
||||
hostError: Platform.ErrorCode;
|
||||
BEGIN
|
||||
IF (instream = NIL) OR (outstream = NIL) THEN RETURN FALSE END;
|
||||
streamCaps := Streams.Capabilities(instream);
|
||||
IF ~(Streams.read IN streamCaps) THEN RETURN FALSE END;
|
||||
streamCaps := Streams.Capabilities(outstream);
|
||||
IF ~(Streams.write IN streamCaps) THEN RETURN FALSE END;
|
||||
|
||||
NEW(newterm);
|
||||
newterm.instream := instream;
|
||||
newterm.outstream := outstream;
|
||||
newterm.inputState := 0;
|
||||
newterm.outputState := 0;
|
||||
newterm.owned := NIL;
|
||||
caps := {};
|
||||
|
||||
IF instream IS UnixFiles.Stream THEN
|
||||
newterm.inputHandle := instream(UnixFiles.Stream).file;
|
||||
IF Platform.IsConsole(newterm.inputHandle) THEN
|
||||
hostError := Platform.CaptureTerminalState(newterm.inputHandle,
|
||||
newterm.inputState);
|
||||
IF hostError # 0 THEN
|
||||
SysErrors.Raise(errors, hostError, Sys.ioctl, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
INCL(caps, Terminals.setEcho);
|
||||
INCL(caps, Terminals.setTermMode)
|
||||
END
|
||||
END;
|
||||
|
||||
IF outstream IS UnixFiles.Stream THEN
|
||||
newterm.outputHandle := outstream(UnixFiles.Stream).file;
|
||||
IF Platform.IsConsole(newterm.outputHandle) THEN
|
||||
hostError := Platform.CaptureTerminalState(newterm.outputHandle,
|
||||
newterm.outputState);
|
||||
IF hostError # 0 THEN
|
||||
IF newterm.inputState # 0 THEN
|
||||
Platform.ReleaseTerminalState(newterm.inputState)
|
||||
END;
|
||||
SysErrors.Raise(errors, hostError, Sys.ioctl, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
INCL(caps, Terminals.setTermMode)
|
||||
END
|
||||
END;
|
||||
|
||||
IF caps = {} THEN RETURN FALSE END;
|
||||
|
||||
IF newterm.inputState # 0 THEN
|
||||
hostError := Platform.SetTerminalEcho(newterm.inputHandle, TRUE);
|
||||
IF hostError = 0 THEN
|
||||
hostError := Platform.SetTerminalInputMode(newterm.inputHandle, FALSE)
|
||||
END
|
||||
ELSE
|
||||
hostError := 0
|
||||
END;
|
||||
IF (hostError = 0) & (newterm.outputState # 0) THEN
|
||||
IF Streams.Flush(outstream) THEN
|
||||
hostError := Platform.SetTerminalOutputMode(newterm.outputHandle, FALSE)
|
||||
ELSE
|
||||
IF ~Restore(newterm, FALSE) THEN END;
|
||||
RETURN FALSE
|
||||
END
|
||||
END;
|
||||
IF hostError # 0 THEN
|
||||
IF ~Restore(newterm, FALSE) THEN END;
|
||||
SysErrors.Raise(errors, hostError, Sys.ioctl, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
|
||||
status.lines := 24;
|
||||
status.columns := 80;
|
||||
IF newterm.outputState # 0 THEN
|
||||
hostError := Platform.GetTerminalSize(newterm.outputHandle,
|
||||
status.lines, status.columns)
|
||||
ELSE
|
||||
hostError := Platform.GetTerminalSize(newterm.inputHandle,
|
||||
status.lines, status.columns)
|
||||
END;
|
||||
IF (hostError # 0) OR (status.lines <= 0) OR (status.columns <= 0) THEN
|
||||
status.lines := 24;
|
||||
status.columns := 80
|
||||
END;
|
||||
status.scrtop := 0;
|
||||
status.scrbottom := status.lines - 1;
|
||||
status.echo := Terminals.on;
|
||||
status.mode := Terminals.cooked;
|
||||
status.characteristics := {};
|
||||
status.scrollDirections := {};
|
||||
status.cursorShape := Terminals.visible;
|
||||
|
||||
Services.Init(newterm, streamType);
|
||||
Streams.Init(newterm, streamInterface,
|
||||
{Streams.read, Streams.write, Streams.flush, Streams.close},
|
||||
Streams.nobuf);
|
||||
Terminals.Init(newterm, status, caps, terminalInterface);
|
||||
RelatedEvents.QueueEvents(newterm);
|
||||
RelatedEvents.Forward(instream, newterm);
|
||||
Forwarders.Forward(newterm, outstream);
|
||||
Heap.RegisterFinalizer(newterm, Finalize);
|
||||
s := newterm;
|
||||
RETURN TRUE
|
||||
END Open;
|
||||
|
||||
PROCEDURE OpenByName*(VAR s: Streams.Stream; devicename, tiname: ARRAY OF CHAR;
|
||||
errors: RelatedEvents.Object): BOOLEAN;
|
||||
VAR name: ARRAY 1024 OF CHAR; file: Streams.Stream;
|
||||
BEGIN
|
||||
IF devicename[0] = 0X THEN COPY("/dev/tty", name)
|
||||
ELSE COPY(devicename, name)
|
||||
END;
|
||||
IF ~UnixFiles.Open(file, name, UnixFiles.rdwr, Streams.nobuf, errors) THEN
|
||||
RETURN FALSE
|
||||
END;
|
||||
IF Open(s, file, file, tiname, errors) THEN
|
||||
s(Stream).owned := file;
|
||||
RETURN TRUE
|
||||
END;
|
||||
IF ~Streams.Close(file) THEN END;
|
||||
RETURN FALSE
|
||||
END OpenByName;
|
||||
|
||||
PROCEDURE InitInterfaces;
|
||||
BEGIN
|
||||
NEW(streamInterface);
|
||||
streamInterface.read := ReadByte;
|
||||
streamInterface.write := WriteByte;
|
||||
streamInterface.flush := Flush;
|
||||
streamInterface.close := Close;
|
||||
|
||||
NEW(terminalInterface);
|
||||
terminalInterface.setEcho := SetEcho;
|
||||
terminalInterface.setTermMode := SetTermMode
|
||||
END InitInterfaces;
|
||||
|
||||
PROCEDURE OpenConsole;
|
||||
VAR console, oldout, file: Streams.Stream;
|
||||
name, tiname: ARRAY 16 OF CHAR; handle: Platform.FileHandle;
|
||||
hostError: Platform.ErrorCode; opened: BOOLEAN;
|
||||
BEGIN
|
||||
oldout := Streams.stdout;
|
||||
opened := FALSE;
|
||||
IF (Streams.stdin IS UnixFiles.Stream) &
|
||||
(Streams.stdout IS UnixFiles.Stream) THEN
|
||||
IF Platform.IsConsole(Streams.stdin(UnixFiles.Stream).file) &
|
||||
Platform.IsConsole(Streams.stdout(UnixFiles.Stream).file) &
|
||||
Platform.SameTerminal(Streams.stdin(UnixFiles.Stream).file,
|
||||
Streams.stdout(UnixFiles.Stream).file) THEN
|
||||
opened := Open(console, Streams.stdin, Streams.stdout, "",
|
||||
RelatedEvents.null)
|
||||
END
|
||||
END;
|
||||
|
||||
IF ~opened THEN
|
||||
COPY("/dev/tty", name);
|
||||
REPEAT
|
||||
hostError := Platform.OpenFile(name, Platform.ReadWrite,
|
||||
Platform.OpenExisting, handle)
|
||||
UNTIL (hostError = 0) OR ~Platform.Interrupted(hostError);
|
||||
IF hostError = 0 THEN
|
||||
IF UnixFiles.OpenFd(file, handle, UnixFiles.rdwr, Streams.nobuf,
|
||||
RelatedEvents.null) THEN
|
||||
IF Open(console, file, file, "", RelatedEvents.null) THEN
|
||||
console(Stream).owned := file;
|
||||
opened := TRUE
|
||||
ELSE
|
||||
IF ~Streams.Close(file) THEN END
|
||||
END
|
||||
ELSE
|
||||
IF Platform.Close(handle) # 0 THEN END
|
||||
END
|
||||
END
|
||||
END;
|
||||
|
||||
IF opened THEN
|
||||
Terminals.console := console;
|
||||
IF oldout IS UnixFiles.Stream THEN
|
||||
IF Platform.SameTerminal(oldout(UnixFiles.Stream).file,
|
||||
console(Stream).outputHandle) THEN
|
||||
Streams.stdout := console
|
||||
END
|
||||
END
|
||||
END
|
||||
END OpenConsole;
|
||||
|
||||
BEGIN
|
||||
Services.CreateType(streamType, "UnixTerminals.Stream", "Terminals.Stream");
|
||||
InitInterfaces;
|
||||
OpenConsole
|
||||
END ulmUnixTerminals.
|
||||
175
src/library/v4/CommandSymbols.Mod
Normal file
175
src/library/v4/CommandSymbols.Mod
Normal file
|
|
@ -0,0 +1,175 @@
|
|||
MODULE CommandSymbols;
|
||||
|
||||
(* Read-only command discovery from VOC .sym files (OPM/OPT format F7 84).
|
||||
Like showdef, select exported XProc objects with no result/parameters.
|
||||
Unlike OPT.Import, this reader builds no compiler symbol table and never
|
||||
rewrites imported symbols. Keep the tags in sync with compiler/OPT.Mod. *)
|
||||
|
||||
IMPORT SYSTEM, Files;
|
||||
|
||||
TYPE
|
||||
Visitor* = PROCEDURE(name: ARRAY OF CHAR);
|
||||
Reader = RECORD
|
||||
rider: Files.Rider;
|
||||
length: LONGINT;
|
||||
valid: BOOLEAN;
|
||||
depth, refs: INTEGER
|
||||
END;
|
||||
Name = ARRAY 256 OF CHAR;
|
||||
Entry = POINTER TO EntryDesc;
|
||||
EntryDesc = RECORD next: Entry; name: Name END;
|
||||
|
||||
PROCEDURE Byte(VAR r: Reader): CHAR;
|
||||
VAR ch: CHAR;
|
||||
BEGIN
|
||||
IF ~r.valid OR (Files.Pos(r.rider) >= r.length) THEN
|
||||
r.valid := FALSE; RETURN 0X
|
||||
END;
|
||||
Files.Read(r.rider, ch);
|
||||
IF r.rider.eof THEN r.valid := FALSE END;
|
||||
RETURN ch
|
||||
END Byte;
|
||||
|
||||
PROCEDURE Number(VAR r: Reader): SYSTEM.INT64;
|
||||
VAR n, wide: SYSTEM.INT64; shift, b: INTEGER;
|
||||
BEGIN
|
||||
n := 0; shift := 0;
|
||||
LOOP
|
||||
b := ORD(Byte(r));
|
||||
IF ~r.valid THEN RETURN 0 END;
|
||||
IF b < 128 THEN
|
||||
IF (shift = 63) & (b # 0) & (b # 127) THEN r.valid := FALSE; RETURN 0 END;
|
||||
wide := b MOD 64 - b DIV 64 * 64;
|
||||
RETURN n + ASH(wide, shift)
|
||||
END;
|
||||
IF shift >= 63 THEN r.valid := FALSE; RETURN 0 END;
|
||||
wide := b - 128; n := n + ASH(wide, shift);
|
||||
INC(shift, 7)
|
||||
END
|
||||
END Number;
|
||||
|
||||
PROCEDURE ReadName(VAR r: Reader; VAR name: Name);
|
||||
VAR i: INTEGER; ch: CHAR;
|
||||
BEGIN
|
||||
i := 0;
|
||||
REPEAT
|
||||
ch := Byte(r);
|
||||
IF i >= LEN(name) - 1 THEN r.valid := FALSE; name[0] := 0X; RETURN END;
|
||||
name[i] := ch; INC(i)
|
||||
UNTIL ~r.valid OR (ch = 0X)
|
||||
END ReadName;
|
||||
|
||||
PROCEDURE Skip(VAR r: Reader; count: SYSTEM.INT64);
|
||||
BEGIN
|
||||
IF (count < 0) OR (count > r.length - Files.Pos(r.rider)) THEN r.valid := FALSE
|
||||
ELSE Files.Set(r.rider, Files.Base(r.rider), Files.Pos(r.rider) + SHORT(count))
|
||||
END
|
||||
END Skip;
|
||||
|
||||
PROCEDURE ^Structure(VAR r: Reader): BOOLEAN;
|
||||
|
||||
PROCEDURE Signature(VAR r: Reader): BOOLEAN;
|
||||
VAR noResult, noParams, ignored: BOOLEAN; tag, n: SYSTEM.INT64; name: Name;
|
||||
BEGIN
|
||||
noResult := Structure(r); tag := Number(r); noParams := tag = 18;
|
||||
WHILE r.valid & (tag # 18) DO
|
||||
IF (tag # 23) & (tag # 24) & (tag # 42) THEN r.valid := FALSE; RETURN FALSE END;
|
||||
ignored := Structure(r); n := Number(r); ReadName(r, name); tag := Number(r)
|
||||
END;
|
||||
RETURN r.valid & noResult & noParams
|
||||
END Signature;
|
||||
|
||||
PROCEDURE Structure(VAR r: Reader): BOOLEAN;
|
||||
VAR tag, n: SYSTEM.INT64; ignored: BOOLEAN; name: Name;
|
||||
BEGIN
|
||||
tag := Number(r);
|
||||
IF tag # 34 THEN
|
||||
IF (tag >= 0) OR (-tag >= r.refs) THEN r.valid := FALSE END;
|
||||
IF (tag = -4) OR (tag = -7) THEN n := Number(r) END;
|
||||
RETURN r.valid & (tag = -10) (* OPT.NoTyp *)
|
||||
END;
|
||||
INC(r.depth); INC(r.refs);
|
||||
IF (r.depth > 128) OR (r.refs > 16384) THEN r.valid := FALSE; RETURN FALSE END;
|
||||
tag := Number(r); (* module index or Smname *)
|
||||
IF tag = 16 THEN ReadName(r, name)
|
||||
ELSIF tag > 0 THEN r.valid := FALSE
|
||||
END;
|
||||
ReadName(r, name); tag := Number(r);
|
||||
IF tag = 35 THEN n := Number(r); tag := Number(r) END; (* Ssys *)
|
||||
CASE SHORT(tag) OF
|
||||
| 36, 38: ignored := Structure(r) (* pointer, dynamic array *)
|
||||
| 37: ignored := Structure(r); n := Number(r) (* fixed array *)
|
||||
| 40: ignored := Signature(r) (* procedure type *)
|
||||
| 39: (* record: base, size, alignment, method count, fields/methods *)
|
||||
ignored := Structure(r);
|
||||
n := Number(r); n := Number(r); n := Number(r); tag := Number(r);
|
||||
WHILE r.valid & (tag # 18) DO
|
||||
CASE SHORT(tag) OF
|
||||
| 25, 26: ignored := Structure(r); ReadName(r, name); n := Number(r)
|
||||
| 27, 28, 30: n := Number(r)
|
||||
| 29: ignored := Signature(r); ReadName(r, name); n := Number(r)
|
||||
ELSE r.valid := FALSE
|
||||
END;
|
||||
tag := Number(r)
|
||||
END
|
||||
ELSE r.valid := FALSE
|
||||
END;
|
||||
DEC(r.depth);
|
||||
RETURN FALSE
|
||||
END Structure;
|
||||
|
||||
PROCEDURE Enumerate*(filename, module: ARRAY OF CHAR; visit: Visitor): BOOLEAN;
|
||||
VAR f: Files.File; r: Reader; name: Name; tag, n: SYSTEM.INT64;
|
||||
command, ignored: BOOLEAN; first, last, entry: Entry; ch: CHAR;
|
||||
BEGIN
|
||||
f := Files.Old(filename);
|
||||
IF f = NIL THEN RETURN FALSE END;
|
||||
Files.Set(r.rider, f, 0); r.length := Files.Length(f);
|
||||
r.valid := TRUE; r.depth := 0; r.refs := 14; first := NIL; last := NIL;
|
||||
ch := Byte(r); IF ch # 0F7X THEN r.valid := FALSE END;
|
||||
ch := Byte(r); IF ch # 084X THEN r.valid := FALSE END;
|
||||
tag := Number(r); IF tag # 16 THEN r.valid := FALSE END;
|
||||
ReadName(r, name); IF name # module THEN r.valid := FALSE END;
|
||||
(* Link names precede the exported objects. *)
|
||||
REPEAT ReadName(r, name) UNTIL ~r.valid OR (name = "");
|
||||
WHILE r.valid & (Files.Pos(r.rider) < r.length) DO
|
||||
tag := Number(r); command := FALSE;
|
||||
WHILE r.valid & (tag = 41) DO (* exported documentation *)
|
||||
n := Number(r); Skip(r, n); tag := Number(r)
|
||||
END;
|
||||
IF (tag >= 1) & (tag <= 9) THEN
|
||||
CASE SHORT(tag) OF
|
||||
| 1, 2, 3: ch := Byte(r)
|
||||
| 4, 7: n := Number(r); n := Number(r)
|
||||
| 5: Skip(r, 4)
|
||||
| 6: Skip(r, 8)
|
||||
| 8: ReadName(r, name)
|
||||
| 9: (* NIL *)
|
||||
ELSE r.valid := FALSE
|
||||
END;
|
||||
ReadName(r, name)
|
||||
ELSIF tag = 19 THEN ignored := Structure(r)
|
||||
ELSIF (tag = 20) OR (tag = 21) OR (tag = 22) THEN
|
||||
ignored := Structure(r); ReadName(r, name)
|
||||
ELSIF (tag >= 31) & (tag <= 33) THEN
|
||||
command := Signature(r) & (tag = 31);
|
||||
IF tag = 33 THEN n := Number(r); Skip(r, n) END;
|
||||
ReadName(r, name);
|
||||
IF command & r.valid THEN
|
||||
NEW(entry); entry.name := name;
|
||||
IF last = NIL THEN first := entry ELSE last.next := entry END;
|
||||
last := entry
|
||||
END
|
||||
ELSE r.valid := FALSE
|
||||
END
|
||||
END;
|
||||
Files.Close(f);
|
||||
(* No partial results from an unsupported or corrupt symbol file. *)
|
||||
IF r.valid THEN
|
||||
entry := first;
|
||||
WHILE entry # NIL DO visit(entry.name); entry := entry.next END
|
||||
END;
|
||||
RETURN r.valid
|
||||
END Enumerate;
|
||||
|
||||
END CommandSymbols.
|
||||
107
src/library/v4/SharedModules.Mod
Normal file
107
src/library/v4/SharedModules.Mod
Normal file
|
|
@ -0,0 +1,107 @@
|
|||
MODULE SharedModules;
|
||||
|
||||
(* Optional Unix shared-object loader. Uses VOC's existing module registry.
|
||||
Libraries remain mapped for the lifetime of the process: the heap can
|
||||
retain their enumPtrs procedures, type descriptors and finalizers. *)
|
||||
|
||||
IMPORT SYSTEM, Heap, Modules, CommandSymbols;
|
||||
|
||||
TYPE
|
||||
Module* = Modules.Module;
|
||||
Command* = Modules.Command;
|
||||
Visitor* = CommandSymbols.Visitor;
|
||||
ModuleBody = PROCEDURE(): SYSTEM.PTR;
|
||||
|
||||
VAR
|
||||
path*: ARRAY 4096 OF CHAR;
|
||||
res*: INTEGER;
|
||||
resMsg*: ARRAY 1024 OF CHAR;
|
||||
model: ARRAY 3 OF CHAR;
|
||||
|
||||
PROCEDURE -AInclude '#include "SharedModulesSupport.h"';
|
||||
|
||||
PROCEDURE -DefaultPath(VAR search: ARRAY OF CHAR)
|
||||
'VOCShared_default_path((char*)search, search__len)';
|
||||
|
||||
PROCEDURE -Open(name, search, model: ARRAY OF CHAR;
|
||||
shortSize, intSize, longSize, setSize: SYSTEM.INT32;
|
||||
VAR error: ARRAY OF CHAR): SYSTEM.ADDRESS
|
||||
'VOCShared_open((char*)name, (char*)search, (char*)model, shortSize, intSize, longSize, setSize, (char*)error, error__len)';
|
||||
|
||||
PROCEDURE -Body(handle: SYSTEM.ADDRESS; name: ARRAY OF CHAR): ModuleBody
|
||||
'(SharedModules_ModuleBody)VOCShared_body(handle, (char*)name)';
|
||||
|
||||
PROCEDURE -DiskModules(search, model: ARRAY OF CHAR; visit: Visitor)
|
||||
'VOCShared_modules((char*)search, (char*)model, visit)';
|
||||
|
||||
PROCEDURE -SymbolFile(name, search, model: ARRAY OF CHAR;
|
||||
VAR filename: ARRAY OF CHAR): BOOLEAN
|
||||
'VOCShared_symbol((char*)name, (char*)search, (char*)model, (char*)filename, filename__len)';
|
||||
|
||||
PROCEDURE First*(): Module;
|
||||
BEGIN RETURN SYSTEM.VAL(Module, Heap.modules)
|
||||
END First;
|
||||
|
||||
PROCEDURE ThisMod*(name: ARRAY OF CHAR): Module;
|
||||
VAR m: Module; handle: SYSTEM.ADDRESS; body: ModuleBody;
|
||||
BEGIN
|
||||
m := Modules.ThisMod(name);
|
||||
IF m = NIL THEN
|
||||
handle := Open(name, path, model, SIZE(SHORTINT), SIZE(INTEGER),
|
||||
SIZE(LONGINT), SIZE(SET), resMsg);
|
||||
IF handle = 0 THEN res := 1; RETURN NIL END;
|
||||
body := Body(handle, name);
|
||||
m := SYSTEM.VAL(Module, body());
|
||||
IF (m = NIL) OR (m.name # name) THEN
|
||||
(* Do not unmap code after calling an initializer, even on failure. *)
|
||||
res := 1; resMsg := "initializer did not register the requested module";
|
||||
RETURN NIL
|
||||
END;
|
||||
Heap.INCREF(m) (* Pin its registry/GC roots; Modules.Free must not remove them. *)
|
||||
END;
|
||||
res := 0; resMsg := "";
|
||||
RETURN m
|
||||
END ThisMod;
|
||||
|
||||
PROCEDURE ThisCommand*(m: Module; name: ARRAY OF CHAR): Command;
|
||||
VAR cmd: Command;
|
||||
BEGIN
|
||||
IF m = NIL THEN res := 1; resMsg := "module not loaded"; RETURN NIL END;
|
||||
cmd := Modules.ThisCommand(m, name);
|
||||
res := Modules.res; COPY(Modules.resMsg, resMsg);
|
||||
RETURN cmd
|
||||
END ThisCommand;
|
||||
|
||||
PROCEDURE EnumerateModules*(visit: Visitor);
|
||||
VAR m: Module;
|
||||
BEGIN
|
||||
m := First();
|
||||
WHILE m # NIL DO visit(m.name); m := m.next END;
|
||||
DiskModules(path, model, visit)
|
||||
END EnumerateModules;
|
||||
|
||||
PROCEDURE EnumerateCommands*(name: ARRAY OF CHAR; visit: Visitor): BOOLEAN;
|
||||
VAR m: Module; c: Modules.Cmd; filename: ARRAY 8192 OF CHAR; valid: BOOLEAN;
|
||||
BEGIN
|
||||
m := Modules.ThisMod(name);
|
||||
IF m # NIL THEN
|
||||
c := m.cmds;
|
||||
WHILE c # NIL DO visit(c.name); c := c.next END;
|
||||
res := 0; resMsg := ""; RETURN TRUE
|
||||
ELSE
|
||||
(* Read symbols, without dlopen or module initialization. *)
|
||||
IF SymbolFile(name, path, model, filename) THEN
|
||||
valid := CommandSymbols.Enumerate(filename, name, visit);
|
||||
IF valid THEN res := 0; resMsg := ""; RETURN TRUE END;
|
||||
resMsg := "invalid or unsupported symbol file"
|
||||
ELSE
|
||||
resMsg := "symbol file not found (set VOC_SYM_PATH if symbols are elsewhere)"
|
||||
END
|
||||
END;
|
||||
res := 1; RETURN FALSE
|
||||
END EnumerateCommands;
|
||||
|
||||
BEGIN
|
||||
IF SIZE(INTEGER) = 2 THEN model := "O2" ELSE model := "OC" END;
|
||||
DefaultPath(path)
|
||||
END SharedModules.
|
||||
211
src/library/v4/SharedModulesSupport.c
Normal file
211
src/library/v4/SharedModulesSupport.c
Normal file
|
|
@ -0,0 +1,211 @@
|
|||
#define _GNU_SOURCE
|
||||
#include <dlfcn.h>
|
||||
#include <dirent.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <unistd.h>
|
||||
#include "SharedModulesSupport.h"
|
||||
|
||||
/* The handles returned by open are deliberately never closed after __init.
|
||||
In particular, dlclose is NOT an implementation of Heap.FreeModule. */
|
||||
|
||||
static int identifier(const char *s, size_t maximum)
|
||||
{
|
||||
size_t n = 0;
|
||||
if (!((*s >= 'A' && *s <= 'Z') || (*s >= 'a' && *s <= 'z'))) return 0;
|
||||
for (; *s; s++, n++) {
|
||||
if (!((*s >= 'A' && *s <= 'Z') || (*s >= 'a' && *s <= 'z') ||
|
||||
(*s >= '0' && *s <= '9') || *s == '_')) return 0;
|
||||
}
|
||||
return n <= maximum;
|
||||
}
|
||||
|
||||
/* Empty path components mean the current directory, as in loksh. */
|
||||
static int directory(const char **path, char *dir, size_t capacity)
|
||||
{
|
||||
const char *end;
|
||||
size_t n;
|
||||
if (!*path) return 0;
|
||||
end = strchr(*path, ':');
|
||||
n = end ? (size_t)(end - *path) : strlen(*path);
|
||||
if (n >= capacity) { *path = end ? end + 1 : NULL; return -1; }
|
||||
memcpy(dir, *path, n);
|
||||
dir[n] = 0;
|
||||
if (!n) strcpy(dir, ".");
|
||||
*path = end ? end + 1 : NULL;
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int filename(char *out, size_t capacity, const char *dir,
|
||||
const char *name, const char *model, const char *extension)
|
||||
{
|
||||
int n = snprintf(out, capacity, "%s/libvoc-%s-%s.%s", dir, name, model, extension);
|
||||
return n >= 0 && (size_t)n < capacity;
|
||||
}
|
||||
|
||||
void VOCShared_default_path(char *path, ADDRESS capacity)
|
||||
{
|
||||
Dl_info info;
|
||||
char dir[4096], *slash;
|
||||
const char *env = getenv("VOC_MODULE_PATH");
|
||||
if (env) { snprintf(path, (size_t)capacity, "%s", env); return; }
|
||||
snprintf(path, (size_t)capacity, ".");
|
||||
/* Locate the actual shared runtime, not the executable or a compiled-in
|
||||
/usr/lib versus /usr/lib64 guess. */
|
||||
if (dladdr((void *)Heap_REGMOD, &info) && info.dli_fname) {
|
||||
snprintf(dir, sizeof dir, "%s", info.dli_fname);
|
||||
slash = strrchr(dir, '/');
|
||||
if (slash) {
|
||||
*slash = 0;
|
||||
snprintf(path, (size_t)capacity, ".:%s", dir);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
ADDRESS VOCShared_open(const char *name, const char *path, const char *model,
|
||||
INT32 short_size, INT32 int_size, INT32 long_size, INT32 set_size,
|
||||
char *error, ADDRESS capacity)
|
||||
{
|
||||
char dir[4096], file[8192], symbol[128];
|
||||
const char *cursor = path;
|
||||
void *handle = NULL;
|
||||
const INT32 *abi;
|
||||
const INT32 expected[] = {1, sizeof(ADDRESS), short_size, int_size,
|
||||
long_size, set_size, sizeof(Heap_ModuleDesc), sizeof(Heap_CmdDesc)};
|
||||
size_t i;
|
||||
int status, found = 0;
|
||||
|
||||
if (!identifier(name, sizeof(Heap_ModuleName) - 1)) {
|
||||
snprintf(error, (size_t)capacity, "invalid module name (maximum 19 characters)");
|
||||
return 0;
|
||||
}
|
||||
while ((status = directory(&cursor, dir, sizeof dir))) {
|
||||
if (status < 0 || !filename(file, sizeof file, dir, name, model, "so")) continue;
|
||||
if (access(file, F_OK) == 0) {
|
||||
found = 1;
|
||||
handle = dlopen(file, RTLD_NOW | RTLD_GLOBAL);
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (!found) {
|
||||
snprintf(file, sizeof file, "libvoc-%s-%s.so", name, model);
|
||||
handle = dlopen(file, RTLD_NOW | RTLD_GLOBAL);
|
||||
}
|
||||
if (!handle) {
|
||||
const char *message = dlerror();
|
||||
snprintf(error, (size_t)capacity, "%s", message ? message : "library not found");
|
||||
return 0;
|
||||
}
|
||||
|
||||
snprintf(symbol, sizeof symbol, "%s__voc_abi", name);
|
||||
abi = dlsym(handle, symbol);
|
||||
if (!abi) {
|
||||
snprintf(error, (size_t)capacity, "%s: missing VOC shared-module ABI descriptor", file);
|
||||
dlclose(handle);
|
||||
return 0;
|
||||
}
|
||||
for (i = 0; i < sizeof expected / sizeof expected[0]; i++) {
|
||||
if (abi[i] != expected[i]) {
|
||||
snprintf(error, (size_t)capacity, "%s: incompatible VOC shared-module ABI", file);
|
||||
dlclose(handle);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
snprintf(symbol, sizeof symbol, "%s__init", name);
|
||||
if (!dlsym(handle, symbol)) {
|
||||
snprintf(error, (size_t)capacity, "%s: missing %s", file, symbol);
|
||||
dlclose(handle);
|
||||
return 0;
|
||||
}
|
||||
error[0] = 0;
|
||||
return (ADDRESS)handle;
|
||||
}
|
||||
|
||||
void *VOCShared_body(ADDRESS handle, const char *name)
|
||||
{
|
||||
char symbol[128];
|
||||
snprintf(symbol, sizeof symbol, "%s__init", name);
|
||||
return dlsym((void *)handle, symbol);
|
||||
}
|
||||
|
||||
static void symbol_path(char *path, size_t capacity, const char *model)
|
||||
{
|
||||
Dl_info info;
|
||||
char prefix[4096], *slash;
|
||||
const char *env = getenv("VOC_SYM_PATH");
|
||||
const char *root = getenv("VOCROOT");
|
||||
const char *subdir = !strcmp(model, "O2") ? "2" : "C";
|
||||
if (env) { snprintf(path, capacity, "%s", env); return; }
|
||||
if (root) { snprintf(path, capacity, "%s/%s/sym", root, subdir); return; }
|
||||
path[0] = 0;
|
||||
if (dladdr((void *)Heap_REGMOD, &info) && info.dli_fname) {
|
||||
snprintf(prefix, sizeof prefix, "%s", info.dli_fname);
|
||||
slash = strrchr(prefix, '/');
|
||||
if (!slash) return;
|
||||
*slash = 0;
|
||||
slash = strrchr(prefix, '/');
|
||||
if (!slash) return;
|
||||
*slash = 0;
|
||||
snprintf(path, capacity, "%s/%s/sym:%s/share/voc/%s/sym", prefix, subdir, prefix, subdir);
|
||||
}
|
||||
}
|
||||
|
||||
static void enumerate_directory(const char *dir, const char *model,
|
||||
VOCShared_Visitor visit, int symbols)
|
||||
{
|
||||
char suffix[32], name[sizeof(Heap_ModuleName)];
|
||||
DIR *stream;
|
||||
struct dirent *entry;
|
||||
size_t n, prefix_size = symbols ? 0 : 7, suffix_size;
|
||||
if (!(stream = opendir(dir))) return;
|
||||
if (symbols) snprintf(suffix, sizeof suffix, ".sym");
|
||||
else snprintf(suffix, sizeof suffix, "-%s.so", model);
|
||||
suffix_size = strlen(suffix);
|
||||
while ((entry = readdir(stream))) {
|
||||
n = strlen(entry->d_name);
|
||||
if (n <= prefix_size + suffix_size ||
|
||||
(!symbols && strncmp(entry->d_name, "libvoc-", prefix_size)) ||
|
||||
strcmp(entry->d_name + n - suffix_size, suffix)) continue;
|
||||
n -= prefix_size + suffix_size;
|
||||
if (n >= sizeof name) continue;
|
||||
memcpy(name, entry->d_name + prefix_size, n);
|
||||
name[n] = 0;
|
||||
if (identifier(name, sizeof name - 1)) visit((CHAR *)name, sizeof name);
|
||||
}
|
||||
closedir(stream);
|
||||
}
|
||||
|
||||
void VOCShared_modules(const char *path, const char *model, VOCShared_Visitor visit)
|
||||
{
|
||||
char dir[4096], symbols[8192];
|
||||
const char *cursor = path;
|
||||
int status;
|
||||
while ((status = directory(&cursor, dir, sizeof dir))) {
|
||||
if (status < 0) continue;
|
||||
enumerate_directory(dir, model, visit, 0);
|
||||
enumerate_directory(dir, model, visit, 1);
|
||||
}
|
||||
symbol_path(symbols, sizeof symbols, model);
|
||||
cursor = symbols;
|
||||
while ((status = directory(&cursor, dir, sizeof dir)))
|
||||
if (status > 0) enumerate_directory(dir, model, visit, 1);
|
||||
}
|
||||
|
||||
int VOCShared_symbol(const char *name, const char *path, const char *model,
|
||||
char *file, ADDRESS capacity)
|
||||
{
|
||||
char dir[4096], symbols[8192];
|
||||
const char *cursor = path;
|
||||
int pass, status, n;
|
||||
if (!identifier(name, sizeof(Heap_ModuleName) - 1)) return 0;
|
||||
symbol_path(symbols, sizeof symbols, model);
|
||||
for (pass = 0; pass < 2; pass++, cursor = symbols) {
|
||||
while ((status = directory(&cursor, dir, sizeof dir))) {
|
||||
if (status < 0) continue;
|
||||
n = snprintf(file, (size_t)capacity, "%s/%s.sym", dir, name);
|
||||
if (n >= 0 && n < capacity && !access(file, R_OK)) return 1;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
17
src/library/v4/SharedModulesSupport.h
Normal file
17
src/library/v4/SharedModulesSupport.h
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
#ifndef VOC_SHARED_MODULES_SUPPORT_H
|
||||
#define VOC_SHARED_MODULES_SUPPORT_H
|
||||
|
||||
#include "Heap.h"
|
||||
|
||||
typedef void (*VOCShared_Visitor)(CHAR *name, ADDRESS length);
|
||||
|
||||
void VOCShared_default_path(char *path, ADDRESS capacity);
|
||||
ADDRESS VOCShared_open(const char *name, const char *path, const char *model,
|
||||
INT32 short_size, INT32 int_size, INT32 long_size, INT32 set_size,
|
||||
char *error, ADDRESS capacity);
|
||||
void *VOCShared_body(ADDRESS handle, const char *name);
|
||||
void VOCShared_modules(const char *path, const char *model, VOCShared_Visitor visit);
|
||||
int VOCShared_symbol(const char *name, const char *path, const char *model,
|
||||
char *filename, ADDRESS capacity);
|
||||
|
||||
#endif
|
||||
|
|
@ -106,6 +106,8 @@ CONST
|
|||
eps = 2.9802322E-8; (* 2 * *( - MantBits - 1) *)
|
||||
piInv = 0.31830988618379067154; (* 1/pi *)
|
||||
piByTwo = 1.57079632679489661923132;
|
||||
piByTwoL = 1.57079632679489661923132D0; (* for the reduction of tan in LONGREAL: with the REAL piByTwo, tan(pi/2) was infinite *)
|
||||
piL = 3.1415926535897932384626433832795028841972D0; (* for the reduction of SinCos in LONGREAL *)
|
||||
piByFour = 0.78539816339744830962;
|
||||
lnv = 0.6931610107421875; (* should be exact *)
|
||||
vbytwo = 0.13830277879601902638E-4; (* used in sinh/cosh *)
|
||||
|
|
@ -244,7 +246,7 @@ BEGIN
|
|||
IF x # y THEN xn := xn - HALF END;
|
||||
|
||||
(* fractional part of reduced number *)
|
||||
f := SHORT(ABS(LONG(x)) - LONG(xn) * pi);
|
||||
f := SHORT(ABS(LONG(x)) - LONG(xn) * piL);
|
||||
|
||||
(* Pre: |f| <= pi/2 *)
|
||||
IF ABS(f) < Limit THEN RETURN sign * f END;
|
||||
|
|
@ -384,7 +386,7 @@ BEGIN
|
|||
|
||||
(* determine n and the fraction f *)
|
||||
n := round(x * twoByPi); xn := n;
|
||||
f := SHORT(LONG(x) - LONG(xn) * piByTwo);
|
||||
f := SHORT(LONG(x) - LONG(xn) * piByTwoL);
|
||||
|
||||
(* check for underflow *)
|
||||
IF ABS(f) < Limit THEN xnum := f; xden := ONE
|
||||
|
|
@ -434,7 +436,7 @@ VAR
|
|||
res: REAL; i: LONGINT;
|
||||
BEGIN
|
||||
asincos(x, 0, i, res);
|
||||
IF err # 0 THEN RETURN res END;
|
||||
IF ABS(x) > ONE THEN RETURN res END; (* this call failed; err stays set from any earlier error *)
|
||||
|
||||
(* adjust result for the correct quadrant *)
|
||||
IF i = 1 THEN res := piByFour + (piByFour + res) END;
|
||||
|
|
@ -448,7 +450,7 @@ VAR
|
|||
res: REAL; i: LONGINT;
|
||||
BEGIN
|
||||
asincos(x, 1, i, res);
|
||||
IF err # 0 THEN RETURN res END;
|
||||
IF ABS(x) > ONE THEN RETURN res END; (* this call failed; err stays set from any earlier error *)
|
||||
|
||||
(* adjust result for the correct quadrant *)
|
||||
IF x < 0 THEN
|
||||
|
|
@ -619,7 +621,7 @@ END ipower;
|
|||
PROCEDURE sincos* (x: REAL; VAR Sin, Cos: REAL);
|
||||
(* More efficient sin/cos implementation if both values are needed. *)
|
||||
BEGIN
|
||||
Sin := sin(x); Cos := sqrt(ONE-Sin * Sin)
|
||||
Sin := sin(x); Cos := cos(x) (* sqrt(ONE-Sin*Sin) lost the sign of cos and its precision near pi/2 *)
|
||||
END sincos;
|
||||
|
||||
PROCEDURE arctan2* (xn, xd: REAL): REAL;
|
||||
|
|
|
|||
|
|
@ -520,7 +520,7 @@ END ipower;
|
|||
PROCEDURE sincos* (x: LONGREAL; VAR Sin, Cos: LONGREAL);
|
||||
(* More efficient sin/cos implementation if both values are needed. *)
|
||||
BEGIN
|
||||
Sin := sin(x); Cos := sqrt(ONE-Sin*Sin)
|
||||
Sin := sin(x); Cos := cos(x) (* sqrt(ONE-Sin*Sin) lost the sign of cos and its precision near pi/2 *)
|
||||
END sincos;
|
||||
|
||||
PROCEDURE arctan2* (xn, xd: LONGREAL): LONGREAL;
|
||||
|
|
|
|||
|
|
@ -183,11 +183,6 @@ BEGIN
|
|||
IF e >= 0 THEN x := x / Ten(e) ELSE x := Ten(-e) * x END ;
|
||||
IF x >= 10.0D0 THEN x := 0.1D0 * x; INC(e) END;
|
||||
|
||||
(* Generate the exponent digits *)
|
||||
en := e < 0; IF en THEN e := - e END;
|
||||
WHILE el > 0 DO digit(e, s, i); e := e DIV 10; DEC(el) END;
|
||||
DEC(i); IF en THEN s[i] := "-" ELSE s[i] := "+" END;
|
||||
|
||||
(* Scale x to enough significant digits to reliably test for trailing
|
||||
zeroes or to the amount of space available, if greater. *)
|
||||
x0 := Ten(d-1);
|
||||
|
|
@ -196,7 +191,13 @@ BEGIN
|
|||
introduces a least significant bit difference
|
||||
between 32 bit and 64 bit builds. *)
|
||||
IF x >= 10.0D0 * x0 THEN x := 0.1D0 * x; INC(e) END;
|
||||
m := Entier64(x)
|
||||
m := Entier64(x);
|
||||
|
||||
(* Generate the exponent digits, after the rounding above, which can carry into it
|
||||
(0.99999999999999989 was written as 1.0D-001) *)
|
||||
en := e < 0; IF en THEN e := - e END;
|
||||
WHILE el > 0 DO digit(e, s, i); e := e DIV 10; DEC(el) END;
|
||||
DEC(i); IF en THEN s[i] := "-" ELSE s[i] := "+" END
|
||||
END;
|
||||
|
||||
DEC(i); IF long THEN s[i] := "D" ELSE s[i] := "E" END;
|
||||
|
|
|
|||
|
|
@ -6,11 +6,19 @@ CONST
|
|||
StdOut- = 1;
|
||||
StdErr- = 2;
|
||||
|
||||
ReadOnly* = 0;
|
||||
WriteOnly* = 1;
|
||||
ReadWrite* = 2;
|
||||
OpenExisting* = 0;
|
||||
CreateAlways* = 1;
|
||||
OpenAlways* = 2;
|
||||
|
||||
TYPE
|
||||
SignalHandler = PROCEDURE(signal: SYSTEM.INT32);
|
||||
|
||||
ErrorCode* = INTEGER;
|
||||
FileHandle* = LONGINT;
|
||||
TerminalState* = SYSTEM.ADDRESS;
|
||||
|
||||
FileIdentity* = RECORD
|
||||
volume: LONGINT; (* dev on Unix filesystems, volume serial number on NTFS *)
|
||||
|
|
@ -42,6 +50,8 @@ PROCEDURE -Aincludesysstat '#include <sys/stat.h>';
|
|||
PROCEDURE -Aincludefcntl '#include <fcntl.h>';
|
||||
PROCEDURE -Aincludeerrno '#include <errno.h>';
|
||||
PROCEDURE -Aincludeutime '#include <utime.h>';
|
||||
PROCEDURE -Aincludetermios '#include <termios.h>';
|
||||
PROCEDURE -Aincludesysioctl '#include <sys/ioctl.h>';
|
||||
PROCEDURE -Astdlib '#include <stdlib.h>';
|
||||
PROCEDURE -Astdio '#include <stdio.h>';
|
||||
PROCEDURE -Aerrno '#include <errno.h>';
|
||||
|
|
@ -229,6 +239,8 @@ PROCEDURE Error*(): ErrorCode; BEGIN RETURN err() END Error;
|
|||
PROCEDURE -openrw (n: ARRAY OF CHAR): INTEGER "open((char*)n, O_RDWR)";
|
||||
PROCEDURE -openro (n: ARRAY OF CHAR): INTEGER "open((char*)n, O_RDONLY)";
|
||||
PROCEDURE -opennew(n: ARRAY OF CHAR): INTEGER "open((char*)n, O_CREAT | O_TRUNC | O_RDWR, 0664)";
|
||||
PROCEDURE -openfile(n: ARRAY OF CHAR; access, creation: INTEGER): LONGINT
|
||||
"open((char*)n, (access == 0 ? O_RDONLY : access == 1 ? O_WRONLY : O_RDWR) | (creation == 1 ? O_CREAT | O_TRUNC : creation == 2 ? O_CREAT : 0), 0666)";
|
||||
|
||||
(* File APIs *)
|
||||
|
||||
|
|
@ -253,6 +265,14 @@ BEGIN
|
|||
IF (fd < 0) THEN RETURN err() ELSE h := fd; RETURN 0 END;
|
||||
END New;
|
||||
|
||||
PROCEDURE OpenFile*(VAR n: ARRAY OF CHAR; access, creation: INTEGER;
|
||||
VAR h: FileHandle): ErrorCode;
|
||||
VAR fd: LONGINT;
|
||||
BEGIN
|
||||
fd := openfile(n, access, creation);
|
||||
IF fd < 0 THEN RETURN err() ELSE h := fd; RETURN 0 END
|
||||
END OpenFile;
|
||||
|
||||
|
||||
|
||||
PROCEDURE -closefile(fd: LONGINT): INTEGER "close(fd)";
|
||||
|
|
@ -295,6 +315,86 @@ PROCEDURE -isatty(fd: LONGINT): INTEGER "isatty(fd)";
|
|||
PROCEDURE IsConsole*(h: FileHandle): BOOLEAN;
|
||||
BEGIN RETURN isatty(h) # 0 END IsConsole;
|
||||
|
||||
PROCEDURE -captureTerminalState(h: FileHandle;
|
||||
VAR state: TerminalState): INTEGER
|
||||
"({ struct termios *p = malloc(sizeof(*p)); int rc = 0; if (p == 0) { errno = ENOMEM; rc = -1; } else if (tcgetattr(h, p) < 0) { free(p); rc = -1; } else *state = (ADDRESS)p; rc; })";
|
||||
|
||||
PROCEDURE CaptureTerminalState*(h: FileHandle;
|
||||
VAR state: TerminalState): ErrorCode;
|
||||
BEGIN
|
||||
state := 0;
|
||||
IF captureTerminalState(h, state) < 0 THEN RETURN err() ELSE RETURN 0 END
|
||||
END CaptureTerminalState;
|
||||
|
||||
PROCEDURE -restoreTerminalState(h: FileHandle; state: TerminalState): INTEGER
|
||||
"tcsetattr(h, TCSANOW, (struct termios*)(ADDRESS)state)";
|
||||
|
||||
PROCEDURE RestoreTerminalState*(h: FileHandle;
|
||||
state: TerminalState): ErrorCode;
|
||||
BEGIN
|
||||
IF restoreTerminalState(h, state) < 0 THEN RETURN err() ELSE RETURN 0 END
|
||||
END RestoreTerminalState;
|
||||
|
||||
PROCEDURE -releaseTerminalState(state: TerminalState)
|
||||
"free((void*)(ADDRESS)state)";
|
||||
|
||||
PROCEDURE ReleaseTerminalState*(VAR state: TerminalState);
|
||||
BEGIN
|
||||
IF state # 0 THEN releaseTerminalState(state); state := 0 END
|
||||
END ReleaseTerminalState;
|
||||
|
||||
PROCEDURE -setTerminalEcho(h: FileHandle; enabled: INTEGER): INTEGER
|
||||
"({ struct termios t; int rc = tcgetattr(h, &t); if (rc == 0) { if (enabled) t.c_lflag |= ECHO; else t.c_lflag &= ~ECHO; rc = tcsetattr(h, TCSANOW, &t); } rc; })";
|
||||
|
||||
PROCEDURE SetTerminalEcho*(h: FileHandle; enabled: BOOLEAN): ErrorCode;
|
||||
VAR value: INTEGER;
|
||||
BEGIN
|
||||
IF enabled THEN value := 1 ELSE value := 0 END;
|
||||
IF setTerminalEcho(h, value) < 0 THEN RETURN err() ELSE RETURN 0 END
|
||||
END SetTerminalEcho;
|
||||
|
||||
PROCEDURE -setTerminalInputRaw(h: FileHandle): INTEGER
|
||||
"({ struct termios t; int rc = tcgetattr(h, &t); if (rc == 0) { t.c_iflag &= ~ICRNL; t.c_lflag &= ~ICANON; t.c_cc[VMIN] = 1; t.c_cc[VTIME] = 0; rc = tcsetattr(h, TCSANOW, &t); } rc; })";
|
||||
|
||||
PROCEDURE -setTerminalInputCooked(h: FileHandle): INTEGER
|
||||
"({ struct termios t; int rc = tcgetattr(h, &t); if (rc == 0) { t.c_iflag |= ICRNL; t.c_lflag |= ICANON; t.c_cc[VEOF] = 4; t.c_cc[VEOL] = '\n'; rc = tcsetattr(h, TCSANOW, &t); } rc; })";
|
||||
|
||||
PROCEDURE SetTerminalInputMode*(h: FileHandle; raw: BOOLEAN): ErrorCode;
|
||||
VAR result: INTEGER;
|
||||
BEGIN
|
||||
IF raw THEN result := setTerminalInputRaw(h)
|
||||
ELSE result := setTerminalInputCooked(h)
|
||||
END;
|
||||
IF result < 0 THEN RETURN err() ELSE RETURN 0 END
|
||||
END SetTerminalInputMode;
|
||||
|
||||
PROCEDURE -setTerminalOutputMode(h: FileHandle; raw: INTEGER): INTEGER
|
||||
"({ struct termios t; int rc = tcgetattr(h, &t); if (rc == 0) { if (raw) t.c_oflag &= ~(OPOST | OCRNL | ONLCR); else t.c_oflag |= OPOST | OCRNL | ONLCR; rc = tcsetattr(h, TCSANOW, &t); } rc; })";
|
||||
|
||||
PROCEDURE SetTerminalOutputMode*(h: FileHandle; raw: BOOLEAN): ErrorCode;
|
||||
VAR value: INTEGER;
|
||||
BEGIN
|
||||
IF raw THEN value := 1 ELSE value := 0 END;
|
||||
IF setTerminalOutputMode(h, value) < 0 THEN RETURN err() ELSE RETURN 0 END
|
||||
END SetTerminalOutputMode;
|
||||
|
||||
PROCEDURE -getTerminalSize(h: FileHandle; VAR lines, columns: INTEGER): INTEGER
|
||||
"({ struct winsize ws; int rc = ioctl(h, TIOCGWINSZ, &ws); if (rc == 0) { *lines = ws.ws_row; *columns = ws.ws_col; } rc; })";
|
||||
|
||||
PROCEDURE GetTerminalSize*(h: FileHandle;
|
||||
VAR lines, columns: INTEGER): ErrorCode;
|
||||
BEGIN
|
||||
IF getTerminalSize(h, lines, columns) < 0 THEN RETURN err() ELSE RETURN 0 END
|
||||
END GetTerminalSize;
|
||||
|
||||
PROCEDURE -sameTerminal(first, second: FileHandle): INTEGER
|
||||
"({ struct stat a, b; int same = 0; if (fstat(first, &a) == 0 && fstat(second, &b) == 0) same = S_ISCHR(a.st_mode) && S_ISCHR(b.st_mode) && a.st_rdev == b.st_rdev; same; })";
|
||||
|
||||
PROCEDURE SameTerminal*(first, second: FileHandle): BOOLEAN;
|
||||
BEGIN
|
||||
RETURN sameTerminal(first, second) # 0
|
||||
END SameTerminal;
|
||||
|
||||
|
||||
|
||||
PROCEDURE -fstat(fd: LONGINT): INTEGER "fstat(fd, &s)";
|
||||
|
|
@ -375,11 +475,22 @@ END ReadBuf;
|
|||
PROCEDURE -writefile(fd: LONGINT; p: SYSTEM.ADDRESS; l: LONGINT): SYSTEM.ADDRESS
|
||||
"write(fd, (void*)(ADDRESS)(p), l)";
|
||||
|
||||
PROCEDURE Write*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT): ErrorCode;
|
||||
PROCEDURE -writecount(value: SYSTEM.ADDRESS): LONGINT "(LONGINT)value";
|
||||
|
||||
PROCEDURE WriteCount*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT;
|
||||
VAR n: LONGINT): ErrorCode;
|
||||
VAR written: SYSTEM.ADDRESS;
|
||||
BEGIN
|
||||
written := writefile(h, p, l);
|
||||
IF written < 0 THEN RETURN err() ELSE RETURN 0 END
|
||||
IF written < 0 THEN n := 0; RETURN err() END;
|
||||
n := writecount(written);
|
||||
RETURN 0
|
||||
END WriteCount;
|
||||
|
||||
PROCEDURE Write*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT): ErrorCode;
|
||||
VAR written: LONGINT;
|
||||
BEGIN
|
||||
RETURN WriteCount(h, p, l, written)
|
||||
END Write;
|
||||
|
||||
|
||||
|
|
@ -393,7 +504,7 @@ END Sync;
|
|||
|
||||
|
||||
|
||||
PROCEDURE -lseek(fd: LONGINT; o: LONGINT; w: INTEGER): INTEGER "lseek(fd, o, w)";
|
||||
PROCEDURE -lseek(fd: LONGINT; o: LONGINT; w: INTEGER): LONGINT "lseek(fd, o, w)";
|
||||
PROCEDURE -seekset(): INTEGER "SEEK_SET";
|
||||
PROCEDURE -seekcur(): INTEGER "SEEK_CUR";
|
||||
PROCEDURE -seekend(): INTEGER "SEEK_END";
|
||||
|
|
@ -403,6 +514,12 @@ BEGIN
|
|||
IF lseek(h, offset, whence) < 0 THEN RETURN err() ELSE RETURN 0 END
|
||||
END Seek;
|
||||
|
||||
PROCEDURE Tell*(h: FileHandle; VAR offset: LONGINT): ErrorCode;
|
||||
BEGIN
|
||||
offset := lseek(h, 0, seekcur());
|
||||
IF offset < 0 THEN offset := 0; RETURN err() ELSE RETURN 0 END
|
||||
END Tell;
|
||||
|
||||
|
||||
|
||||
PROCEDURE -ftruncate(fd: LONGINT; l: LONGINT): INTEGER "ftruncate(fd, l)";
|
||||
|
|
|
|||
|
|
@ -412,10 +412,18 @@ END ReadBuf;
|
|||
PROCEDURE -writefile(fd: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT; VAR n: SYSTEM.INT32): INTEGER
|
||||
"(INTEGER)WriteFile((HANDLE)fd, (void*)(p), (DWORD)l, (DWORD*)n, 0)";
|
||||
|
||||
PROCEDURE Write*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT): ErrorCode;
|
||||
VAR n: SYSTEM.INT32;
|
||||
PROCEDURE WriteCount*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT;
|
||||
VAR n: LONGINT): ErrorCode;
|
||||
VAR result: INTEGER; written: SYSTEM.INT32;
|
||||
BEGIN
|
||||
IF writefile(h, p, l, n) = 0 THEN RETURN err() ELSE RETURN 0 END
|
||||
result := writefile(h, p, l, written);
|
||||
IF result = 0 THEN n := 0; RETURN err() ELSE n := written; RETURN 0 END
|
||||
END WriteCount;
|
||||
|
||||
PROCEDURE Write*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT): ErrorCode;
|
||||
VAR n: LONGINT;
|
||||
BEGIN
|
||||
RETURN WriteCount(h, p, l, n)
|
||||
END Write;
|
||||
|
||||
|
||||
|
|
@ -444,12 +452,18 @@ BEGIN
|
|||
IF rc = 0 THEN RETURN err() ELSE RETURN 0 END
|
||||
END Seek;
|
||||
|
||||
|
||||
|
||||
PROCEDURE -setEndOfFile(h: FileHandle): INTEGER "(INTEGER)SetEndOfFile((HANDLE)h)";
|
||||
PROCEDURE -getFilePos(h: FileHandle; VAR r: LONGINT; VAR rc: INTEGER)
|
||||
"LARGE_INTEGER liz = {0}; *rc = (INTEGER)SetFilePointerEx((HANDLE)h, liz, &li, FILE_CURRENT); *r = (LONGINT)li.QuadPart";
|
||||
|
||||
PROCEDURE Tell*(h: FileHandle; VAR offset: LONGINT): ErrorCode;
|
||||
VAR rc: INTEGER;
|
||||
BEGIN
|
||||
largeInteger;
|
||||
getFilePos(h, offset, rc);
|
||||
IF rc = 0 THEN offset := 0; RETURN err() ELSE RETURN 0 END
|
||||
END Tell;
|
||||
|
||||
PROCEDURE Truncate*(h: FileHandle; limit: LONGINT): ErrorCode;
|
||||
VAR rc: INTEGER; oldpos: LONGINT;
|
||||
BEGIN
|
||||
|
|
@ -516,7 +530,7 @@ END EnableVT100;
|
|||
|
||||
PROCEDURE IsConsole*(h: FileHandle): BOOLEAN;
|
||||
VAR mode: SYSTEM.INT32;
|
||||
BEGIN RETURN GetConsoleMode(StdOut, mode)
|
||||
BEGIN RETURN GetConsoleMode(h, mode)
|
||||
END IsConsole;
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -47,7 +47,7 @@ Math.round(-3.0000E+00): -3. MathL.round(-3.0000000000000D+000): -3
|
|||
Math.round(-4.0000E+00): -4. MathL.round(-4.0000000000000D+000): -4
|
||||
|
||||
Math.sqrt(9.00000E-01): 9.48683E-01. MathL.sqrt(9.00000000000000D-001): 9.48683298050514D-001
|
||||
Math.sqrt(1.00000E+00): 1.00000E-01. MathL.sqrt(1.00000000000000D+000): 1.00000000000000D+000
|
||||
Math.sqrt(1.00000E+00): 1.00000E+00. MathL.sqrt(1.00000000000000D+000): 1.00000000000000D+000
|
||||
Math.sqrt(1.40000E+00): 1.18322E+00. MathL.sqrt(1.40000000000000D+000): 1.18321595661992D+000
|
||||
Math.sqrt(1.50000E+00): 1.22474E+00. MathL.sqrt(1.50000000000000D+000): 1.22474487139159D+000
|
||||
Math.sqrt(1.60000E+00): 1.26491E+00. MathL.sqrt(1.60000000000000D+000): 1.26491106406735D+000
|
||||
|
|
@ -58,7 +58,7 @@ Math.sqrt(2.50000E+00): 1.58114E+00. MathL.sqrt(2.50000000000000D+000): 1.58113
|
|||
Math.sqrt(3.00000E+00): 1.73205E+00. MathL.sqrt(3.00000000000000D+000): 1.73205080756888D+000
|
||||
Math.sqrt(4.00000E+00): 2.00000E+00. MathL.sqrt(4.00000000000000D+000): 2.00000000000000D+000
|
||||
Math.sqrt(-9.0000E-01): 9.48683E-01. MathL.sqrt(-9.0000000000000D-001): 9.48683298050514D-001
|
||||
Math.sqrt(-1.0000E+00): 1.00000E-01. MathL.sqrt(-1.0000000000000D+000): 1.00000000000000D+000
|
||||
Math.sqrt(-1.0000E+00): 1.00000E+00. MathL.sqrt(-1.0000000000000D+000): 1.00000000000000D+000
|
||||
Math.sqrt(-1.4000E+00): 1.18322E+00. MathL.sqrt(-1.4000000000000D+000): 1.18321595661992D+000
|
||||
Math.sqrt(-1.5000E+00): 1.22474E+00. MathL.sqrt(-1.5000000000000D+000): 1.22474487139159D+000
|
||||
Math.sqrt(-1.6000E+00): 1.26491E+00. MathL.sqrt(-1.6000000000000D+000): 1.26491106406735D+000
|
||||
|
|
@ -80,113 +80,113 @@ Math.ln(2.40000E+00): 8.75469E-01. MathL.ln(2.40000000000000D+000): 8.754687373
|
|||
Math.ln(2.50000E+00): 9.16291E-01. MathL.ln(2.50000000000000D+000): 9.16290731874155D-001
|
||||
Math.ln(3.00000E+00): 1.09861E+00. MathL.ln(3.00000000000000D+000): 1.09861228866811D+000
|
||||
Math.ln(4.00000E+00): 1.38629E+00. MathL.ln(4.00000000000000D+000): 1.38629436111989D+000
|
||||
Math.ln(-9.0000E-01): -3.40282E+38. MathL.ln(-9.0000000000000D-001): -1.79769296342094D+308
|
||||
Math.ln(-1.0000E+00): -3.40282E+38. MathL.ln(-1.0000000000000D+000): -1.79769296342094D+308
|
||||
Math.ln(-1.4000E+00): -3.40282E+38. MathL.ln(-1.4000000000000D+000): -1.79769296342094D+308
|
||||
Math.ln(-1.5000E+00): -3.40282E+38. MathL.ln(-1.5000000000000D+000): -1.79769296342094D+308
|
||||
Math.ln(-1.6000E+00): -3.40282E+38. MathL.ln(-1.6000000000000D+000): -1.79769296342094D+308
|
||||
Math.ln(-1.9000E+00): -3.40282E+38. MathL.ln(-1.9000000000000D+000): -1.79769296342094D+308
|
||||
Math.ln(-2.0000E+00): -3.40282E+38. MathL.ln(-2.0000000000000D+000): -1.79769296342094D+308
|
||||
Math.ln(-2.4000E+00): -3.40282E+38. MathL.ln(-2.4000000000000D+000): -1.79769296342094D+308
|
||||
Math.ln(-2.5000E+00): -3.40282E+38. MathL.ln(-2.5000000000000D+000): -1.79769296342094D+308
|
||||
Math.ln(-3.0000E+00): -3.40282E+38. MathL.ln(-3.0000000000000D+000): -1.79769296342094D+308
|
||||
Math.ln(-4.0000E+00): -3.40282E+38. MathL.ln(-4.0000000000000D+000): -1.79769296342094D+308
|
||||
Math.ln(-9.0000E-01): -3.40282E+38. MathL.ln(-9.0000000000000D-001): -1.79769313486232D+308
|
||||
Math.ln(-1.0000E+00): -3.40282E+38. MathL.ln(-1.0000000000000D+000): -1.79769313486232D+308
|
||||
Math.ln(-1.4000E+00): -3.40282E+38. MathL.ln(-1.4000000000000D+000): -1.79769313486232D+308
|
||||
Math.ln(-1.5000E+00): -3.40282E+38. MathL.ln(-1.5000000000000D+000): -1.79769313486232D+308
|
||||
Math.ln(-1.6000E+00): -3.40282E+38. MathL.ln(-1.6000000000000D+000): -1.79769313486232D+308
|
||||
Math.ln(-1.9000E+00): -3.40282E+38. MathL.ln(-1.9000000000000D+000): -1.79769313486232D+308
|
||||
Math.ln(-2.0000E+00): -3.40282E+38. MathL.ln(-2.0000000000000D+000): -1.79769313486232D+308
|
||||
Math.ln(-2.4000E+00): -3.40282E+38. MathL.ln(-2.4000000000000D+000): -1.79769313486232D+308
|
||||
Math.ln(-2.5000E+00): -3.40282E+38. MathL.ln(-2.5000000000000D+000): -1.79769313486232D+308
|
||||
Math.ln(-3.0000E+00): -3.40282E+38. MathL.ln(-3.0000000000000D+000): -1.79769313486232D+308
|
||||
Math.ln(-4.0000E+00): -3.40282E+38. MathL.ln(-4.0000000000000D+000): -1.79769313486232D+308
|
||||
|
||||
Math.sin(0.00000E+00): 0.00000E+00. MathL.sin(0.00000000000000D+000): 0.00000000000000D+000
|
||||
Math.sin(1.00000E-01): 9.98334E-02. MathL.sin(1.00000000000000D-001): 9.98334166468282D-002
|
||||
Math.sin(1.04720E+00): 8.66025E-01. MathL.sin(1.04719755119660D+000): 8.66025403784440D-001
|
||||
Math.sin(1.57080E+00): 1.00000E+00. MathL.sin(1.57079632679490D+000): 9.99999999999999D-001
|
||||
Math.sin(3.14159E+00): -3.10862E-15. MathL.sin(3.14159265358979D+000): 3.23108679839857D-015
|
||||
Math.sin(-1.0472E+00): -8.66025E-01. MathL.sin(-1.0471975511966D+000): -8.6602540378444D-001
|
||||
Math.sin(-1.5708E+00): -1.0000E+00. MathL.sin(-1.5707963267949D+000): -9.99999999999999D-001
|
||||
Math.sin(-3.14159E+00): 3.10862E-15. MathL.sin(-3.14159265358979D+000): -3.23108679839857D-015
|
||||
Math.sin(1.04720E+00): 8.66025E-01. MathL.sin(1.04719755119660D+000): 8.66025403784439D-001
|
||||
Math.sin(1.57080E+00): 1.00000E+00. MathL.sin(1.57079632679490D+000): 1.00000000000000D+000
|
||||
Math.sin(3.14159E+00): -8.74228E-08. MathL.sin(3.14159265358979D+000): 1.22464023514027D-016
|
||||
Math.sin(-1.0472E+00): -8.66025E-01. MathL.sin(-1.0471975511966D+000): -8.66025403784439D-001
|
||||
Math.sin(-1.5708E+00): -1.0000E+00. MathL.sin(-1.5707963267949D+000): -1.0000000000000D+000
|
||||
Math.sin(-3.14159E+00): 8.74228E-08. MathL.sin(-3.14159265358979D+000): -1.22464023514027D-016
|
||||
|
||||
Math.cos(0.00000E+00): 1.00000E+00. MathL.cos(0.00000000000000D+000): 9.99999999999999D-001
|
||||
Math.cos(1.00000E-01): 9.95004E-01. MathL.cos(1.00000000000000D-001): 9.95004165278025D-001
|
||||
Math.cos(1.04720E+00): 5.00000E-01. MathL.cos(1.04719755119660D+000): 4.99999999999998D-001
|
||||
Math.cos(1.57080E+00): -1.55431E-15. MathL.cos(1.57079632679490D+000): -3.49148251407644D-015
|
||||
Math.cos(3.14159E+00): -1.0000E+00. MathL.cos(3.14159265358979D+000): -9.99999999999999D-001
|
||||
Math.cos(-1.0472E+00): 5.00000E-01. MathL.cos(-1.0471975511966D+000): 4.99999999999998D-001
|
||||
Math.cos(-1.5708E+00): -1.55431E-15. MathL.cos(-1.5707963267949D+000): -3.49148251407644D-015
|
||||
Math.cos(-3.14159E+00): -1.0000E+00. MathL.cos(-3.14159265358979D+000): -9.99999999999999D-001
|
||||
Math.cos(0.00000E+00): 1.00000E+00. MathL.cos(0.00000000000000D+000): 1.00000000000000D+000
|
||||
Math.cos(1.00000E-01): 9.95004E-01. MathL.cos(1.00000000000000D-001): 9.95004165278026D-001
|
||||
Math.cos(1.04720E+00): 5.00000E-01. MathL.cos(1.04719755119660D+000): 5.00000000000000D-001
|
||||
Math.cos(1.57080E+00): -4.37114E-08. MathL.cos(1.57079632679490D+000): 6.12320117570134D-017
|
||||
Math.cos(3.14159E+00): -1.0000E+00. MathL.cos(3.14159265358979D+000): -1.0000000000000D+000
|
||||
Math.cos(-1.0472E+00): 5.00000E-01. MathL.cos(-1.0471975511966D+000): 5.00000000000000D-001
|
||||
Math.cos(-1.5708E+00): -4.37114E-08. MathL.cos(-1.5707963267949D+000): 6.12320117570134D-017
|
||||
Math.cos(-3.14159E+00): -1.0000E+00. MathL.cos(-3.14159265358979D+000): -1.0000000000000D+000
|
||||
|
||||
Math.tan(0.00000E+00): 0.00000E+00. MathL.tan(0.00000000000000D+000): 0.00000000000000D+000
|
||||
Math.tan(1.00000E-01): 1.00335E-01. MathL.tan(1.00000000000000D-001): 1.00334672085451D-001
|
||||
Math.tan(1.04720E+00): 1.73205E+00. MathL.tan(1.04719755119660D+000): 1.73205080756888D+000
|
||||
Math.tan(1.57080E+00): 3.00240E+14. MathL.tan(1.57079632679490D+000): 2.02340838177263D+007
|
||||
Math.tan(3.14159E+00): -6.66134E-15. MathL.tan(3.14159265358979D+000): 3.23108679839857D-015
|
||||
Math.tan(1.57080E+00): -2.28773E+07. MathL.tan(1.57079632679490D+000): 1.63313268877772D+016
|
||||
Math.tan(3.14159E+00): 8.74228E-08. MathL.tan(3.14159265358979D+000): -1.22464023514027D-016
|
||||
Math.tan(-1.0472E+00): -1.73205E+00. MathL.tan(-1.0471975511966D+000): -1.73205080756888D+000
|
||||
Math.tan(-1.5708E+00): -3.0024E+14. MathL.tan(-1.5707963267949D+000): -2.02340838177263D+007
|
||||
Math.tan(-3.14159E+00): 6.66134E-15. MathL.tan(-3.14159265358979D+000): -3.23108679839857D-015
|
||||
Math.tan(-1.5708E+00): 2.28773E+07. MathL.tan(-1.5707963267949D+000): -1.63313268877772D+016
|
||||
Math.tan(-3.14159E+00): -8.74228E-08. MathL.tan(-3.14159265358979D+000): 1.22464023514027D-016
|
||||
|
||||
Math.arcsin(9.00000E-01): -4.51027E-01. MathL.arcsin(9.00000000000000D-001): 1.11976951499864D+000
|
||||
Math.arcsin(1.00000E+00): -0.0000E+00. MathL.arcsin(1.00000000000000D+000): 1.57079632679490D+000
|
||||
Math.arcsin(1.40000E+00): 3.40282E+38. MathL.arcsin(1.40000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(1.50000E+00): 3.40282E+38. MathL.arcsin(1.50000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(1.60000E+00): 3.40282E+38. MathL.arcsin(1.60000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(1.90000E+00): 3.40282E+38. MathL.arcsin(1.90000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(2.00000E+00): 3.40282E+38. MathL.arcsin(2.00000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(2.40000E+00): 3.40282E+38. MathL.arcsin(2.40000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(2.50000E+00): 3.40282E+38. MathL.arcsin(2.50000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(3.00000E+00): 3.40282E+38. MathL.arcsin(3.00000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(4.00000E+00): 3.40282E+38. MathL.arcsin(4.00000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(-9.0000E-01): -4.51027E-01. MathL.arcsin(-9.0000000000000D-001): -1.11976951499864D+000
|
||||
Math.arcsin(-1.0000E+00): -0.0000E+00. MathL.arcsin(-1.0000000000000D+000): -1.5707963267949D+000
|
||||
Math.arcsin(-1.4000E+00): 3.40282E+38. MathL.arcsin(-1.4000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(-1.5000E+00): 3.40282E+38. MathL.arcsin(-1.5000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(-1.6000E+00): 3.40282E+38. MathL.arcsin(-1.6000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(-1.9000E+00): 3.40282E+38. MathL.arcsin(-1.9000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(-2.0000E+00): 3.40282E+38. MathL.arcsin(-2.0000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(-2.4000E+00): 3.40282E+38. MathL.arcsin(-2.4000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(-2.5000E+00): 3.40282E+38. MathL.arcsin(-2.5000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(-3.0000E+00): 3.40282E+38. MathL.arcsin(-3.0000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(-4.0000E+00): 3.40282E+38. MathL.arcsin(-4.0000000000000D+000): 1.79769296342094D+308
|
||||
Math.arcsin(9.00000E-01): 1.11977E+00. MathL.arcsin(9.00000000000000D-001): 1.11976951499863D+000
|
||||
Math.arcsin(1.00000E+00): 1.57080E+00. MathL.arcsin(1.00000000000000D+000): 1.57079632679490D+000
|
||||
Math.arcsin(1.40000E+00): 3.40282E+38. MathL.arcsin(1.40000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(1.50000E+00): 3.40282E+38. MathL.arcsin(1.50000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(1.60000E+00): 3.40282E+38. MathL.arcsin(1.60000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(1.90000E+00): 3.40282E+38. MathL.arcsin(1.90000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(2.00000E+00): 3.40282E+38. MathL.arcsin(2.00000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(2.40000E+00): 3.40282E+38. MathL.arcsin(2.40000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(2.50000E+00): 3.40282E+38. MathL.arcsin(2.50000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(3.00000E+00): 3.40282E+38. MathL.arcsin(3.00000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(4.00000E+00): 3.40282E+38. MathL.arcsin(4.00000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(-9.0000E-01): -1.11977E+00. MathL.arcsin(-9.0000000000000D-001): -1.11976951499863D+000
|
||||
Math.arcsin(-1.0000E+00): -1.5708E+00. MathL.arcsin(-1.0000000000000D+000): -1.5707963267949D+000
|
||||
Math.arcsin(-1.4000E+00): 3.40282E+38. MathL.arcsin(-1.4000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(-1.5000E+00): 3.40282E+38. MathL.arcsin(-1.5000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(-1.6000E+00): 3.40282E+38. MathL.arcsin(-1.6000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(-1.9000E+00): 3.40282E+38. MathL.arcsin(-1.9000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(-2.0000E+00): 3.40282E+38. MathL.arcsin(-2.0000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(-2.4000E+00): 3.40282E+38. MathL.arcsin(-2.4000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(-2.5000E+00): 3.40282E+38. MathL.arcsin(-2.5000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(-3.0000E+00): 3.40282E+38. MathL.arcsin(-3.0000000000000D+000): 1.79769313486232D+308
|
||||
Math.arcsin(-4.0000E+00): 3.40282E+38. MathL.arcsin(-4.0000000000000D+000): 1.79769313486232D+308
|
||||
|
||||
Math.arccos(9.00000E-01): -4.51027E-01. MathL.arccos(9.00000000000000D-001): 4.51026811796263D-001
|
||||
Math.arccos(1.00000E+00): -0.0000E+00. MathL.arccos(1.00000000000000D+000): 0.00000000000000D+000
|
||||
Math.arccos(1.40000E+00): 3.40282E+38. MathL.arccos(1.40000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(1.50000E+00): 3.40282E+38. MathL.arccos(1.50000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(1.60000E+00): 3.40282E+38. MathL.arccos(1.60000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(1.90000E+00): 3.40282E+38. MathL.arccos(1.90000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(2.00000E+00): 3.40282E+38. MathL.arccos(2.00000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(2.40000E+00): 3.40282E+38. MathL.arccos(2.40000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(2.50000E+00): 3.40282E+38. MathL.arccos(2.50000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(3.00000E+00): 3.40282E+38. MathL.arccos(3.00000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(4.00000E+00): 3.40282E+38. MathL.arccos(4.00000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(-9.0000E-01): -4.51027E-01. MathL.arccos(-9.0000000000000D-001): 2.69056584179353D+000
|
||||
Math.arccos(-1.0000E+00): -0.0000E+00. MathL.arccos(-1.0000000000000D+000): 3.14159265358979D+000
|
||||
Math.arccos(-1.4000E+00): 3.40282E+38. MathL.arccos(-1.4000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(-1.5000E+00): 3.40282E+38. MathL.arccos(-1.5000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(-1.6000E+00): 3.40282E+38. MathL.arccos(-1.6000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(-1.9000E+00): 3.40282E+38. MathL.arccos(-1.9000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(-2.0000E+00): 3.40282E+38. MathL.arccos(-2.0000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(-2.4000E+00): 3.40282E+38. MathL.arccos(-2.4000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(-2.5000E+00): 3.40282E+38. MathL.arccos(-2.5000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(-3.0000E+00): 3.40282E+38. MathL.arccos(-3.0000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(-4.0000E+00): 3.40282E+38. MathL.arccos(-4.0000000000000D+000): 1.79769296342094D+308
|
||||
Math.arccos(9.00000E-01): 4.51027E-01. MathL.arccos(9.00000000000000D-001): 4.51026811796262D-001
|
||||
Math.arccos(1.00000E+00): 0.00000E+00. MathL.arccos(1.00000000000000D+000): 0.00000000000000D+000
|
||||
Math.arccos(1.40000E+00): 3.40282E+38. MathL.arccos(1.40000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(1.50000E+00): 3.40282E+38. MathL.arccos(1.50000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(1.60000E+00): 3.40282E+38. MathL.arccos(1.60000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(1.90000E+00): 3.40282E+38. MathL.arccos(1.90000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(2.00000E+00): 3.40282E+38. MathL.arccos(2.00000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(2.40000E+00): 3.40282E+38. MathL.arccos(2.40000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(2.50000E+00): 3.40282E+38. MathL.arccos(2.50000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(3.00000E+00): 3.40282E+38. MathL.arccos(3.00000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(4.00000E+00): 3.40282E+38. MathL.arccos(4.00000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(-9.0000E-01): 2.69057E+00. MathL.arccos(-9.0000000000000D-001): 2.69056584179353D+000
|
||||
Math.arccos(-1.0000E+00): 3.14159E+00. MathL.arccos(-1.0000000000000D+000): 3.14159265358979D+000
|
||||
Math.arccos(-1.4000E+00): 3.40282E+38. MathL.arccos(-1.4000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(-1.5000E+00): 3.40282E+38. MathL.arccos(-1.5000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(-1.6000E+00): 3.40282E+38. MathL.arccos(-1.6000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(-1.9000E+00): 3.40282E+38. MathL.arccos(-1.9000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(-2.0000E+00): 3.40282E+38. MathL.arccos(-2.0000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(-2.4000E+00): 3.40282E+38. MathL.arccos(-2.4000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(-2.5000E+00): 3.40282E+38. MathL.arccos(-2.5000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(-3.0000E+00): 3.40282E+38. MathL.arccos(-3.0000000000000D+000): 1.79769313486232D+308
|
||||
Math.arccos(-4.0000E+00): 3.40282E+38. MathL.arccos(-4.0000000000000D+000): 1.79769313486232D+308
|
||||
|
||||
Math.arctan(9.00000E-01): 7.32815E-01. MathL.arctan(9.00000000000000D-001): 7.32815101786508D-001
|
||||
Math.arctan(1.00000E+00): 7.85398E-01. MathL.arctan(1.00000000000000D+000): 7.85398163397449D-001
|
||||
Math.arctan(1.40000E+00): 9.50547E-01. MathL.arctan(1.40000000000000D+000): 9.50546840812077D-001
|
||||
Math.arctan(1.50000E+00): 9.82794E-01. MathL.arctan(1.50000000000000D+000): 9.82793723247331D-001
|
||||
Math.arctan(1.60000E+00): 1.01220E+00. MathL.arctan(1.60000000000000D+000): 1.01219701145134D+000
|
||||
Math.arctan(1.90000E+00): 1.08632E+00. MathL.arctan(1.90000000000000D+000): 1.08631839775788D+000
|
||||
Math.arctan(9.00000E-01): 7.32815E-01. MathL.arctan(9.00000000000000D-001): 7.32815101786507D-001
|
||||
Math.arctan(1.00000E+00): 7.85398E-01. MathL.arctan(1.00000000000000D+000): 7.85398163397448D-001
|
||||
Math.arctan(1.40000E+00): 9.50547E-01. MathL.arctan(1.40000000000000D+000): 9.50546840812075D-001
|
||||
Math.arctan(1.50000E+00): 9.82794E-01. MathL.arctan(1.50000000000000D+000): 9.82793723247329D-001
|
||||
Math.arctan(1.60000E+00): 1.01220E+00. MathL.arctan(1.60000000000000D+000): 1.01219701145133D+000
|
||||
Math.arctan(1.90000E+00): 1.08632E+00. MathL.arctan(1.90000000000000D+000): 1.08631839775787D+000
|
||||
Math.arctan(2.00000E+00): 1.10715E+00. MathL.arctan(2.00000000000000D+000): 1.10714871779409D+000
|
||||
Math.arctan(2.40000E+00): 1.17601E+00. MathL.arctan(2.40000000000000D+000): 1.17600520709514D+000
|
||||
Math.arctan(2.50000E+00): 1.19029E+00. MathL.arctan(2.50000000000000D+000): 1.19028994968253D+000
|
||||
Math.arctan(3.00000E+00): 1.24905E+00. MathL.arctan(3.00000000000000D+000): 1.24904577239826D+000
|
||||
Math.arctan(4.00000E+00): 1.32582E+00. MathL.arctan(4.00000000000000D+000): 1.32581766366804D+000
|
||||
Math.arctan(-9.0000E-01): -7.32815E-01. MathL.arctan(-9.0000000000000D-001): -7.32815101786508D-001
|
||||
Math.arctan(-1.0000E+00): -7.85398E-01. MathL.arctan(-1.0000000000000D+000): -7.85398163397449D-001
|
||||
Math.arctan(-1.4000E+00): -9.50547E-01. MathL.arctan(-1.4000000000000D+000): -9.50546840812077D-001
|
||||
Math.arctan(-1.5000E+00): -9.82794E-01. MathL.arctan(-1.5000000000000D+000): -9.82793723247331D-001
|
||||
Math.arctan(-1.6000E+00): -1.0122E+00. MathL.arctan(-1.6000000000000D+000): -1.01219701145134D+000
|
||||
Math.arctan(-1.9000E+00): -1.08632E+00. MathL.arctan(-1.9000000000000D+000): -1.08631839775788D+000
|
||||
Math.arctan(3.00000E+00): 1.24905E+00. MathL.arctan(3.00000000000000D+000): 1.24904577239825D+000
|
||||
Math.arctan(4.00000E+00): 1.32582E+00. MathL.arctan(4.00000000000000D+000): 1.32581766366803D+000
|
||||
Math.arctan(-9.0000E-01): -7.32815E-01. MathL.arctan(-9.0000000000000D-001): -7.32815101786507D-001
|
||||
Math.arctan(-1.0000E+00): -7.85398E-01. MathL.arctan(-1.0000000000000D+000): -7.85398163397448D-001
|
||||
Math.arctan(-1.4000E+00): -9.50547E-01. MathL.arctan(-1.4000000000000D+000): -9.50546840812075D-001
|
||||
Math.arctan(-1.5000E+00): -9.82794E-01. MathL.arctan(-1.5000000000000D+000): -9.82793723247329D-001
|
||||
Math.arctan(-1.6000E+00): -1.0122E+00. MathL.arctan(-1.6000000000000D+000): -1.01219701145133D+000
|
||||
Math.arctan(-1.9000E+00): -1.08632E+00. MathL.arctan(-1.9000000000000D+000): -1.08631839775787D+000
|
||||
Math.arctan(-2.0000E+00): -1.10715E+00. MathL.arctan(-2.0000000000000D+000): -1.10714871779409D+000
|
||||
Math.arctan(-2.4000E+00): -1.17601E+00. MathL.arctan(-2.4000000000000D+000): -1.17600520709514D+000
|
||||
Math.arctan(-2.5000E+00): -1.19029E+00. MathL.arctan(-2.5000000000000D+000): -1.19028994968253D+000
|
||||
Math.arctan(-3.0000E+00): -1.24905E+00. MathL.arctan(-3.0000000000000D+000): -1.24904577239826D+000
|
||||
Math.arctan(-4.0000E+00): -1.32582E+00. MathL.arctan(-4.0000000000000D+000): -1.32581766366804D+000
|
||||
Math.arctan(-3.0000E+00): -1.24905E+00. MathL.arctan(-3.0000000000000D+000): -1.24904577239825D+000
|
||||
Math.arctan(-4.0000E+00): -1.32582E+00. MathL.arctan(-4.0000000000000D+000): -1.32581766366803D+000
|
||||
|
||||
Math.sinh(9.00000E-01): 1.02652E+00. MathL.sinh(9.00000000000000D-001): 1.02651672570818D+000
|
||||
Math.sinh(1.00000E+00): 1.17520E+00. MathL.sinh(1.00000000000000D+000): 1.17520119364380D+000
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ Real number hex representation.
|
|||
-1.1D0: BFF199999999999A
|
||||
1.1D3: 4091300000000000
|
||||
1.1D-3: 3F5205BC01A36E2F
|
||||
1.2345678987654321D3: 40934A45874103D8
|
||||
1.2345678987654321D3: 40934A45874103E1
|
||||
0.0: 0000000000000000
|
||||
0.000123D0: 3F201F31F46ED246
|
||||
1/0.0: 7FF0000000000000
|
||||
|
|
@ -68,7 +68,7 @@ Testing LONGREAL.
|
|||
-1.1D0: -1.1000000000000000D+000
|
||||
1.1D3: 1.1000000000000000D+003
|
||||
1.1D-3: 1.1000000000000000D-003
|
||||
1.2345678987654321D3: 1.2345678987654300D+003
|
||||
1.2345678987654321D3: 1.2345678987654320D+003
|
||||
0.0: 0.0000000000000000D+000
|
||||
0.000123D0: 1.2300000000000000D-004
|
||||
1/0.0: Infinity
|
||||
|
|
@ -134,7 +134,7 @@ Real number hex representation.
|
|||
-1.1D0: BFF199999999999A
|
||||
1.1D3: 4091300000000000
|
||||
1.1D-3: 3F5205BC01A36E2F
|
||||
1.2345678987654321D3: 40934A45874103D8
|
||||
1.2345678987654321D3: 40934A45874103E1
|
||||
0.0: 0000000000000000
|
||||
0.000123D0: 3F201F31F46ED246
|
||||
1/0.0: 7FF0000000000000
|
||||
|
|
@ -196,7 +196,7 @@ Testing LONGREAL.
|
|||
-1.1D0: -1.1000000000000000D+000
|
||||
1.1D3: 1.1000000000000000D+003
|
||||
1.1D-3: 1.1000000000000000D-003
|
||||
1.2345678987654321D3: 1.2345678987654300D+003
|
||||
1.2345678987654321D3: 1.2345678987654320D+003
|
||||
0.0: 0.0000000000000000D+000
|
||||
0.000123D0: 1.2300000000000000D-004
|
||||
1/0.0: Infinity
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
18 Dec 2016 16:55:53
|
||||
Tue Oct 6 20:11:12 +04 2026
|
||||
|
|
|
|||
27
src/test/ulm/readme.md
Normal file
27
src/test/ulm/readme.md
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
# ULM Unix smoke tests
|
||||
|
||||
Build the tests with an installed VOC compiler:
|
||||
|
||||
```sh
|
||||
voc -M testUnixFiles.Mod
|
||||
voc -M testUnixTerminals.Mod
|
||||
voc -M testUnixTerminalExit.Mod
|
||||
```
|
||||
|
||||
Run the file and explicit terminal-close tests normally from this directory:
|
||||
|
||||
```sh
|
||||
./testUnixFiles
|
||||
./testUnixTerminals
|
||||
```
|
||||
|
||||
The terminal tests require standard input and output to refer to the same
|
||||
terminal. To verify restoration during program shutdown:
|
||||
|
||||
```sh
|
||||
before=$(stty -g)
|
||||
./testUnixTerminalExit
|
||||
test "$before" = "$(stty -g)"
|
||||
```
|
||||
|
||||
`testUnixFiles` leaves `ulmUnixFiles.test` in the current directory.
|
||||
45
src/test/ulm/testUnixFiles.Mod
Normal file
45
src/test/ulm/testUnixFiles.Mod
Normal file
|
|
@ -0,0 +1,45 @@
|
|||
MODULE testUnixFiles;
|
||||
|
||||
IMPORT Streams := ulmStreams, UnixFiles := ulmUnixFiles, Write := ulmWrite,
|
||||
SYSTEM;
|
||||
|
||||
VAR
|
||||
stream: Streams.Stream;
|
||||
filename: ARRAY 64 OF CHAR;
|
||||
written, received: ARRAY 5 OF CHAR;
|
||||
byte: Streams.Byte;
|
||||
position: Streams.Count;
|
||||
|
||||
BEGIN
|
||||
ASSERT(Streams.stdin IS UnixFiles.Stream);
|
||||
ASSERT(Streams.stdout IS UnixFiles.Stream);
|
||||
ASSERT(Streams.stderr IS UnixFiles.Stream);
|
||||
|
||||
COPY("ulmUnixFiles.test", filename);
|
||||
COPY("test", written);
|
||||
ASSERT(UnixFiles.Open(stream, filename, UnixFiles.rdwr + UnixFiles.create,
|
||||
Streams.onebuf, NIL));
|
||||
ASSERT(Streams.WritePart(stream, written, 0, 4));
|
||||
Streams.GetPos(stream, position);
|
||||
ASSERT(position = 4);
|
||||
ASSERT(Streams.Close(stream));
|
||||
|
||||
COPY("ulmUnixFiles.test", filename);
|
||||
ASSERT(UnixFiles.Open(stream, filename,
|
||||
UnixFiles.read + UnixFiles.condcreate,
|
||||
Streams.onebuf, NIL));
|
||||
ASSERT(Streams.ReadPart(stream, received, 0, 4));
|
||||
ASSERT((received[0] = "t") & (received[1] = "e") &
|
||||
(received[2] = "s") & (received[3] = "t"));
|
||||
ASSERT(Streams.Close(stream));
|
||||
|
||||
COPY("ulmUnixFiles.test", filename);
|
||||
ASSERT(UnixFiles.Open(stream, filename, UnixFiles.read,
|
||||
Streams.nobuf, NIL));
|
||||
ASSERT(Streams.ReadByte(stream, byte));
|
||||
ASSERT(SYSTEM.VAL(CHAR, byte) = "t");
|
||||
ASSERT(Streams.Close(stream));
|
||||
|
||||
Write.String("ulmUnixFiles ok");
|
||||
Write.Ln
|
||||
END testUnixFiles.
|
||||
9
src/test/ulm/testUnixTerminalExit.Mod
Normal file
9
src/test/ulm/testUnixTerminalExit.Mod
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
MODULE testUnixTerminalExit;
|
||||
|
||||
IMPORT Terminals := ulmTerminals, UnixTerminals := ulmUnixTerminals;
|
||||
|
||||
BEGIN
|
||||
ASSERT(Terminals.console # NIL);
|
||||
Terminals.Echo(Terminals.console, Terminals.off);
|
||||
Terminals.SetTermMode(Terminals.console, Terminals.raw)
|
||||
END testUnixTerminalExit.
|
||||
26
src/test/ulm/testUnixTerminals.Mod
Normal file
26
src/test/ulm/testUnixTerminals.Mod
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
MODULE testUnixTerminals;
|
||||
|
||||
IMPORT Streams := ulmStreams, Terminals := ulmTerminals,
|
||||
UnixTerminals := ulmUnixTerminals, Write := ulmWrite;
|
||||
|
||||
VAR status: Terminals.Status; caps: Terminals.CapabilitySet;
|
||||
|
||||
BEGIN
|
||||
ASSERT(Terminals.console # NIL);
|
||||
ASSERT(Streams.stdout = Terminals.console);
|
||||
caps := Terminals.Capabilities(Terminals.console);
|
||||
ASSERT(Terminals.setEcho IN caps);
|
||||
ASSERT(Terminals.setTermMode IN caps);
|
||||
|
||||
Terminals.GetStatus(Terminals.console, status);
|
||||
ASSERT((status.lines > 0) & (status.columns > 0));
|
||||
|
||||
Terminals.Echo(Terminals.console, Terminals.off);
|
||||
Terminals.Echo(Terminals.console, Terminals.on);
|
||||
Terminals.SetTermMode(Terminals.console, Terminals.raw);
|
||||
Terminals.SetTermMode(Terminals.console, Terminals.cooked);
|
||||
|
||||
Write.String("ulmUnixTerminals ok");
|
||||
Write.Ln;
|
||||
ASSERT(Streams.Close(Terminals.console))
|
||||
END testUnixTerminals.
|
||||
|
|
@ -314,7 +314,9 @@ ulm:
|
|||
cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmResources.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmForwarders.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmRelatedEvents.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmStreamsHost.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmStreams.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmTerminals.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmStrings.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysTypes.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmTexts.Mod
|
||||
|
|
@ -336,6 +338,8 @@ ulm:
|
|||
cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmConstStrings.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmPlotters.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysIO.Mod
|
||||
if [ "$(PLATFORM)" = "unix" ]; then cd $(BUILDDIR)/$(MODEL) && "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmUnixFiles.Mod; fi
|
||||
if [ "$(PLATFORM)" = "unix" ]; then cd $(BUILDDIR)/$(MODEL) && "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmUnixTerminals.Mod; fi
|
||||
cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmLoader.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmNetIO.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmPersistentObjects.Mod
|
||||
|
|
|
|||
34
src/tools/vloksh/Makefile
Normal file
34
src/tools/vloksh/Makefile
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
# Optional Unix prototype, built against an existing VOC installation.
|
||||
VOC ?= voc
|
||||
CC ?= cc
|
||||
VOCROOT ?= /usr/share/voc
|
||||
VOCLIBDIR ?= $(dir $(shell $(CC) -print-file-name=libvoc-O2.so))
|
||||
ROOT := $(abspath $(dir $(lastword $(MAKEFILE_LIST)))/../../..)
|
||||
BUILD ?= $(ROOT)/build/vloksh
|
||||
SUPPORT := $(ROOT)/src/library/v4
|
||||
TOOLS := $(ROOT)/src/tools/vloksh
|
||||
INCLUDES := -I$(VOCROOT)/2/include -I$(SUPPORT) -I$(TOOLS) -I$(BUILD)
|
||||
|
||||
.PHONY: all test demo
|
||||
all: $(BUILD)/vloksh
|
||||
|
||||
$(BUILD):
|
||||
mkdir -p "$@"
|
||||
|
||||
$(BUILD)/CommandSymbols.c: $(SUPPORT)/CommandSymbols.Mod | $(BUILD)
|
||||
cd "$(BUILD)" && VOCROOT="$(VOCROOT)" VOCLIBDIR="$(VOCLIBDIR)" $(VOC) -sFS "$(SUPPORT)/CommandSymbols.Mod"
|
||||
|
||||
$(BUILD)/SharedModules.c: $(SUPPORT)/SharedModules.Mod $(BUILD)/CommandSymbols.c
|
||||
cd "$(BUILD)" && VOCROOT="$(VOCROOT)" VOCLIBDIR="$(VOCLIBDIR)" $(VOC) -sFS "$(SUPPORT)/SharedModules.Mod"
|
||||
|
||||
$(BUILD)/vloksh.c: $(TOOLS)/vloksh.Mod $(BUILD)/SharedModules.c
|
||||
cd "$(BUILD)" && VOCROOT="$(VOCROOT)" VOCLIBDIR="$(VOCLIBDIR)" $(VOC) -sSm "$(TOOLS)/vloksh.Mod"
|
||||
|
||||
$(BUILD)/vloksh: $(BUILD)/vloksh.c $(BUILD)/SharedModules.c $(BUILD)/CommandSymbols.c $(SUPPORT)/SharedModulesSupport.c $(SUPPORT)/SharedModulesSupport.h $(TOOLS)/Terminal.c $(TOOLS)/Terminal.h
|
||||
$(CC) $(CFLAGS) -fPIC -g -Wno-stringop-overflow $(INCLUDES) $(BUILD)/vloksh.c $(BUILD)/SharedModules.c $(BUILD)/CommandSymbols.c $(SUPPORT)/SharedModulesSupport.c $(TOOLS)/Terminal.c $(LDFLAGS) -L$(VOCLIBDIR) -Wl,-rpath,$(abspath $(VOCLIBDIR)) -o "$@" -lvoc-O2 -lreadline -ldl
|
||||
|
||||
test: all
|
||||
VOC="$(VOC)" VOCROOT="$(VOCROOT)" VOCLIBDIR="$(VOCLIBDIR)" CC="$(CC)" python3 "$(TOOLS)/test.py" "$(BUILD)/vloksh"
|
||||
|
||||
demo: all
|
||||
VOC="$(VOC)" VOCROOT="$(VOCROOT)" VOCLIBDIR="$(VOCLIBDIR)" CC="$(CC)" python3 "$(TOOLS)/demo.py" "$(BUILD)"
|
||||
86
src/tools/vloksh/Terminal.c
Normal file
86
src/tools/vloksh/Terminal.c
Normal file
|
|
@ -0,0 +1,86 @@
|
|||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <unistd.h>
|
||||
#include <readline/readline.h>
|
||||
#include <readline/history.h>
|
||||
#include "Terminal.h"
|
||||
|
||||
static VlokshComplete complete;
|
||||
static char **candidates;
|
||||
static size_t count, next;
|
||||
|
||||
void Vloksh_add_completion(const char *name)
|
||||
{
|
||||
char **grown;
|
||||
char *copy;
|
||||
size_t i;
|
||||
for (i = 0; i < count; i++) if (!strcmp(candidates[i], name)) return;
|
||||
copy = strdup(name);
|
||||
if (!copy) return;
|
||||
grown = realloc(candidates, (count + 1) * sizeof *candidates);
|
||||
if (!grown) { free(copy); return; }
|
||||
candidates = grown;
|
||||
candidates[count++] = copy;
|
||||
}
|
||||
|
||||
static char *candidate(const char *text, int state)
|
||||
{
|
||||
(void)text;
|
||||
if (!state) next = 0;
|
||||
return next < count ? strdup(candidates[next++]) : NULL;
|
||||
}
|
||||
|
||||
static char **matches(const char *text, int start, int end)
|
||||
{
|
||||
char **result;
|
||||
size_t i;
|
||||
(void)end;
|
||||
/* First word: Oberon commands. Arguments: Readline's file completion. */
|
||||
for (i = 0; i < (size_t)start; i++)
|
||||
if (rl_line_buffer[i] != ' ' && rl_line_buffer[i] != '\t') return NULL;
|
||||
rl_attempted_completion_over = 1;
|
||||
/* A completed module ends in '.', not a space: the command follows. */
|
||||
rl_completion_suppress_append = strchr(text, '.') == NULL;
|
||||
count = 0;
|
||||
complete((CHAR *)text, (ADDRESS)strlen(text) + 1);
|
||||
result = rl_completion_matches(text, candidate);
|
||||
for (i = 0; i < count; i++) free(candidates[i]);
|
||||
free(candidates);
|
||||
candidates = NULL;
|
||||
count = 0;
|
||||
return result;
|
||||
}
|
||||
|
||||
void Vloksh_terminal_init(VlokshComplete callback)
|
||||
{
|
||||
complete = callback;
|
||||
rl_readline_name = "vloksh";
|
||||
rl_completer_word_break_characters = " \t\n";
|
||||
rl_attempted_completion_function = matches;
|
||||
using_history();
|
||||
stifle_history(64);
|
||||
}
|
||||
|
||||
int Vloksh_read_line(char *line, ADDRESS capacity)
|
||||
{
|
||||
char *input = NULL;
|
||||
size_t allocated = 0, length;
|
||||
ssize_t n;
|
||||
if (isatty(STDIN_FILENO)) {
|
||||
input = readline("> ");
|
||||
if (!input) return 0;
|
||||
if (*input) add_history(input);
|
||||
length = strlen(input);
|
||||
} else {
|
||||
n = getline(&input, &allocated, stdin);
|
||||
if (n < 0) { free(input); return 0; }
|
||||
length = (size_t)n;
|
||||
while (length && (input[length - 1] == '\n' || input[length - 1] == '\r')) --length;
|
||||
input[length] = 0;
|
||||
}
|
||||
if (length >= (size_t)capacity) { free(input); return -1; }
|
||||
memcpy(line, input, length + 1);
|
||||
free(input);
|
||||
return 1;
|
||||
}
|
||||
11
src/tools/vloksh/Terminal.h
Normal file
11
src/tools/vloksh/Terminal.h
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
#ifndef VLOKSH_TERMINAL_H
|
||||
#define VLOKSH_TERMINAL_H
|
||||
|
||||
#include "SYSTEM.h"
|
||||
|
||||
typedef void (*VlokshComplete)(CHAR *prefix, ADDRESS length);
|
||||
void Vloksh_terminal_init(VlokshComplete complete);
|
||||
int Vloksh_read_line(char *line, ADDRESS capacity);
|
||||
void Vloksh_add_completion(const char *name);
|
||||
|
||||
#endif
|
||||
19
src/tools/vloksh/demo.py
Normal file
19
src/tools/vloksh/demo.py
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
#!/usr/bin/env python3
|
||||
"""Build the optional strutils experiment without modifying that repository."""
|
||||
|
||||
import os
|
||||
from pathlib import Path
|
||||
import subprocess
|
||||
import sys
|
||||
|
||||
tools = Path(__file__).resolve().parent
|
||||
compiler = tools.parents[2]
|
||||
strutils = Path(os.environ.get("STRUTILS", str(compiler.parent / "strutils")))
|
||||
output = Path(sys.argv[1]).resolve() / "strutils-demo"
|
||||
output.mkdir(parents=True, exist_ok=True)
|
||||
for source in [strutils / "src/strTypes.Mod", strutils / "src/strUtils.Mod",
|
||||
tools / "examples/StrDemo.Mod"]:
|
||||
subprocess.run([sys.executable, str(tools / "voc-shared.py"), str(source)],
|
||||
cwd=output, check=True)
|
||||
print(f"\nRun: {output.parent / 'vloksh'} -P{output} StrDemo.Run")
|
||||
print(f"Or: {output.parent / 'vloksh'} -P{output} (then StrDemo.<Tab>)")
|
||||
28
src/tools/vloksh/examples/StrDemo.Mod
Normal file
28
src/tools/vloksh/examples/StrDemo.Mod
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
MODULE StrDemo;
|
||||
|
||||
(* A command module; neither it nor strUtils is linked into vloksh. *)
|
||||
IMPORT strUtils, Out, Oberon, Texts;
|
||||
|
||||
VAR count: LONGINT;
|
||||
|
||||
PROCEDURE Run*;
|
||||
VAR words: strUtils.pstrings; i: LONGINT;
|
||||
BEGIN
|
||||
words := strUtils.tokenize("shared modules really work", " ");
|
||||
i := 0;
|
||||
WHILE i < LEN(words^) DO
|
||||
Out.String(words^[i]^); Out.Ln; INC(i)
|
||||
END;
|
||||
INC(count);
|
||||
Out.String("calls: "); Out.Int(count, 0); Out.Ln
|
||||
END Run;
|
||||
|
||||
PROCEDURE Echo*;
|
||||
VAR r: Texts.Reader; ch: CHAR;
|
||||
BEGIN
|
||||
Texts.OpenReader(r, Oberon.Par.text, Oberon.Par.pos);
|
||||
WHILE ~r.eot DO Texts.Read(r, ch); IF ~r.eot THEN Out.Char(ch) END END;
|
||||
Out.Ln
|
||||
END Echo;
|
||||
|
||||
END StrDemo.
|
||||
206
src/tools/vloksh/test.py
Normal file
206
src/tools/vloksh/test.py
Normal file
|
|
@ -0,0 +1,206 @@
|
|||
#!/usr/bin/env python3
|
||||
"""Integration tests using the installed VOC, ELF loader, and a real pty."""
|
||||
|
||||
import os
|
||||
from pathlib import Path
|
||||
import pty
|
||||
import re
|
||||
import select
|
||||
import shlex
|
||||
import subprocess
|
||||
import sys
|
||||
import tempfile
|
||||
import time
|
||||
|
||||
tools = Path(__file__).resolve().parent
|
||||
shell = Path(sys.argv[1]).resolve()
|
||||
helper = tools / "voc-shared.py"
|
||||
|
||||
PROVIDER = '''MODULE Provider;
|
||||
IMPORT Out;
|
||||
VAR count: LONGINT;
|
||||
PROCEDURE Next*(): LONGINT;
|
||||
BEGIN INC(count); RETURN count END Next;
|
||||
BEGIN Out.String("provider initialized"); Out.Ln
|
||||
END Provider.
|
||||
'''
|
||||
|
||||
CONSUMER = '''MODULE Consumer;
|
||||
IMPORT Provider, Out, Oberon, Texts, Heap;
|
||||
CONST A* = 1234567890; B* = {1, 3}; C* = "string"; D* = 1.5; E* = NIL;
|
||||
TYPE Node* = POINTER TO NodeDesc;
|
||||
NodeDesc* = RECORD next*: Node; n*: LONGINT END;
|
||||
Handler* = PROCEDURE (VAR node: Node): Node;
|
||||
Grid* = ARRAY 3, 4 OF Node;
|
||||
VAR kept*: Node; handler*: Handler;
|
||||
PROCEDURE (node: Node) Touch*;
|
||||
BEGIN INC(node.n) END Touch;
|
||||
PROCEDURE Function*(): LONGINT;
|
||||
BEGIN RETURN 17 END Function;
|
||||
PROCEDURE WithArg*(n: LONGINT);
|
||||
BEGIN Out.Int(n, 0) END WithArg;
|
||||
(** A command documented in the symbol file. *)
|
||||
PROCEDURE Run*;
|
||||
BEGIN
|
||||
IF kept = NIL THEN NEW(kept); kept.n := 40 END;
|
||||
kept.Touch; Heap.GC(TRUE);
|
||||
Out.String("run "); Out.Int(Provider.Next(), 0);
|
||||
Out.String(" kept "); Out.Int(kept.n, 0); Out.Ln
|
||||
END Run;
|
||||
PROCEDURE Echo*;
|
||||
VAR r: Texts.Reader; ch: CHAR;
|
||||
BEGIN
|
||||
Texts.OpenReader(r, Oberon.Par.text, Oberon.Par.pos);
|
||||
WHILE ~r.eot DO Texts.Read(r, ch); IF ~r.eot THEN Out.Char(ch) END END;
|
||||
Out.Ln
|
||||
END Echo;
|
||||
BEGIN Out.String("consumer initialized"); Out.Ln
|
||||
END Consumer.
|
||||
'''
|
||||
|
||||
|
||||
def run(*args, input=None, expected=0, env=None):
|
||||
result = subprocess.run([str(shell), *map(str, args)], input=input, text=True,
|
||||
stdout=subprocess.PIPE, stderr=subprocess.STDOUT,
|
||||
env=env, timeout=10)
|
||||
assert result.returncode == expected, (args, result.returncode, result.stdout)
|
||||
return result.stdout
|
||||
|
||||
|
||||
def build(directory, name, source):
|
||||
file = directory / f"{name}.Mod"
|
||||
file.write_text(source)
|
||||
subprocess.run([sys.executable, str(helper), str(file)], cwd=directory, check=True)
|
||||
|
||||
|
||||
def interactive(directory):
|
||||
pid, fd = pty.fork()
|
||||
if pid == 0:
|
||||
os.execv(str(shell), [str(shell), f"-P{directory}"])
|
||||
collected = bytearray()
|
||||
|
||||
def until(needle):
|
||||
data = bytearray()
|
||||
deadline = time.monotonic() + 10
|
||||
while needle not in data:
|
||||
remaining = deadline - time.monotonic()
|
||||
assert remaining > 0, (needle, bytes(data))
|
||||
ready, _, _ = select.select([fd], [], [], remaining)
|
||||
assert ready, (needle, bytes(data))
|
||||
chunk = os.read(fd, 65536)
|
||||
assert chunk, bytes(data)
|
||||
data.extend(chunk)
|
||||
collected.extend(data)
|
||||
return bytes(data)
|
||||
|
||||
try:
|
||||
until(b"> ")
|
||||
# Completion reads symbols even when ELF dependencies cannot be loaded.
|
||||
dependency = directory / "libvoc-Provider-O2.so"
|
||||
hidden = dependency.with_suffix(".hidden")
|
||||
dependency.rename(hidden)
|
||||
try:
|
||||
os.write(fd, b"Consu\t")
|
||||
result = until(b"Consumer.")
|
||||
assert b"initialized" not in result
|
||||
os.write(fd, b"R\t")
|
||||
result = until(b"Run")
|
||||
assert b"initialized" not in result
|
||||
finally:
|
||||
hidden.rename(dependency)
|
||||
os.write(fd, b"\n")
|
||||
result = until(b"> ")
|
||||
assert b"run 1 kept 41" in result, result
|
||||
# History and in-process state survive the first call.
|
||||
os.write(fd, b"\x1b[A\n")
|
||||
result = until(b"> ")
|
||||
assert b"run 2 kept 42" in result, result
|
||||
os.write(fd, b"\x04")
|
||||
_, status = os.waitpid(pid, 0)
|
||||
assert os.waitstatus_to_exitcode(status) == 0
|
||||
pid = None
|
||||
finally:
|
||||
os.close(fd)
|
||||
if pid:
|
||||
os.kill(pid, 9)
|
||||
os.waitpid(pid, 0)
|
||||
|
||||
|
||||
def main(directory):
|
||||
build(directory, "Provider", PROVIDER)
|
||||
build(directory, "Consumer", CONSUMER)
|
||||
path = f"-P{directory}"
|
||||
listed = run(path, "Consumer")
|
||||
assert set(listed.splitlines()) == {" Consumer.Echo", " Consumer.Run"}, listed
|
||||
assert "initialized" not in listed
|
||||
assert "Function" not in listed and "WithArg" not in listed and "Touch" not in listed
|
||||
# Discovery does not require any shared object at all.
|
||||
library = directory / "libvoc-Consumer-O2.so"
|
||||
library.rename(library.with_suffix(".hidden"))
|
||||
assert run(path, "Consumer") == listed
|
||||
library.with_suffix(".hidden").rename(library)
|
||||
|
||||
output = run(path, "Consumer.Run")
|
||||
assert "provider initialized\nconsumer initialized\nrun 1 kept 41\n" == output, output
|
||||
output = run(path, input="Consumer.Run\nConsumer.Run\nConsumer.Echo batch parameters\nquit\n")
|
||||
assert output.count("consumer initialized") == 1, output
|
||||
assert "run 1 kept 41\nrun 2 kept 42\nbatch parameters\n" in output, output
|
||||
assert run(path, "Consumer.Echo", "hello", "world").endswith("hello world\n")
|
||||
env = dict(os.environ, VOC_MODULE_PATH=str(directory))
|
||||
assert "run 1 kept 41" in run("Consumer.Run", env=env)
|
||||
assert "libvoc-Absent-O2.so" in run(path, "Absent.Run", expected=1)
|
||||
assert "not found" in run(path, "Consumer.Absent", expected=1)
|
||||
assert "symbol file not found" in run(path, "Absent", expected=1)
|
||||
assert "too long" in run(path, input="x" * 4096 + "\n", expected=1)
|
||||
assert "needs a module path" in run("-P", expected=1)
|
||||
|
||||
# Symbol reader handles the same rich interfaces as showdef.
|
||||
root = Path(os.environ.get("VOCROOT", "/usr/share/voc"))
|
||||
for name in ("Texts", "Files", "Heap", "Math", "oocStrings", "ulmObjects"):
|
||||
interface = subprocess.check_output(["showdef", name], text=True)
|
||||
expected = set(re.findall(r"^ PROCEDURE (\w+)\s*;", interface, re.MULTILINE))
|
||||
# Use a fresh name so even linked-in core modules exercise the .sym
|
||||
# parser rather than falling back to their in-memory command registry.
|
||||
symbols = (root / "2/sym" / f"{name}.sym").read_bytes()
|
||||
(directory / "SymbolProbe.sym").write_bytes(
|
||||
symbols.replace(name.encode() + b"\0", b"SymbolProbe\0", 1))
|
||||
actual = {line.strip().split(".", 1)[1] for line in run(path, "SymbolProbe").splitlines()}
|
||||
assert actual == expected, (name, actual, expected)
|
||||
|
||||
# Scan the entire installed symbol corpus, not only the example's types.
|
||||
for symbols in (root / "2/sym").glob("*.sym"):
|
||||
(directory / "SymbolProbe.sym").write_bytes(symbols.read_bytes().replace(
|
||||
symbols.stem.encode() + b"\0", b"SymbolProbe\0", 1))
|
||||
run(path, "SymbolProbe")
|
||||
|
||||
# Fail closed on unsupported versions, truncated streams and malformed tags.
|
||||
good = (directory / "Consumer.sym").read_bytes().replace(b"Consumer\0", b"Broken\0", 1)
|
||||
(directory / "Broken.sym").write_bytes(good)
|
||||
assert "Broken.Run" in run(path, "Broken")
|
||||
for content in (good[:1], good[:20], good[:-1], good[:1] + b"\x00" + good[2:],
|
||||
good[:2] + b"\x80" * 40):
|
||||
(directory / "Broken.sym").write_bytes(content)
|
||||
assert "invalid or unsupported" in run(path, "Broken", expected=1)
|
||||
|
||||
for name, descriptor in (("BadABI", "export const INT32 BadABI__voc_abi[8] = {1, 0};"),
|
||||
("NoABI", "")):
|
||||
source = directory / f"{name}.c"
|
||||
source.write_text('#include "SYSTEM.h"\n' + descriptor +
|
||||
f'\nexport void *{name}__init(void) {{ return 0; }}\n')
|
||||
subprocess.run([*shlex.split(os.environ.get("CC", "cc")), "-fPIC", "-shared",
|
||||
f"-I{root / '2/include'}", str(source), "-o",
|
||||
str(directory / f"libvoc-{name}-O2.so")], check=True)
|
||||
assert "ABI" in run(path, f"{name}.Run", expected=1)
|
||||
|
||||
dynamic = subprocess.check_output(["readelf", "-d", str(library)], text=True)
|
||||
assert "libvoc-Provider-O2.so" in dynamic and "libvoc-O2.so" in dynamic
|
||||
assert "$ORIGIN" in dynamic
|
||||
interactive(directory)
|
||||
print("vloksh tests passed: symbols, no-init completion, pty/history, shared dependencies, GC/state, errors, ABI")
|
||||
|
||||
|
||||
if __name__ == "__main__":
|
||||
temp_root = Path("/tmp/opencode")
|
||||
temp_root.mkdir(exist_ok=True)
|
||||
with tempfile.TemporaryDirectory(prefix="vloksh-test-", dir=temp_root) as directory:
|
||||
main(Path(directory))
|
||||
201
src/tools/vloksh/vloksh.Mod
Normal file
201
src/tools/vloksh/vloksh.Mod
Normal file
|
|
@ -0,0 +1,201 @@
|
|||
MODULE vloksh;
|
||||
|
||||
(* Vishap Linux Oberon Kommand Shell. Commands execute in this process,
|
||||
not in child processes, just as in loksh and the Oberon UI. *)
|
||||
|
||||
IMPORT SYSTEM, Modules, SharedModules, Oberon, Texts, Out, Heap, Platform;
|
||||
|
||||
VAR
|
||||
prefix, modulePrefix: ARRAY 128 OF CHAR;
|
||||
failed, quit: BOOLEAN;
|
||||
|
||||
PROCEDURE -AInclude '#include "Terminal.h"';
|
||||
PROCEDURE -InitTerminal(complete: SharedModules.Visitor)
|
||||
'Vloksh_terminal_init(complete)';
|
||||
PROCEDURE -ReadLine(VAR line: ARRAY OF CHAR): SYSTEM.INT32
|
||||
'Vloksh_read_line((char*)line, line__len)';
|
||||
PROCEDURE -AddCompletion(name: ARRAY OF CHAR)
|
||||
'Vloksh_add_completion((char*)name)';
|
||||
|
||||
PROCEDURE StartsWith(name, prefix: ARRAY OF CHAR): BOOLEAN;
|
||||
VAR i: INTEGER;
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (i < LEN(prefix)) & (prefix[i] # 0X) DO
|
||||
IF (i >= LEN(name)) OR (name[i] # prefix[i]) THEN RETURN FALSE END;
|
||||
INC(i)
|
||||
END;
|
||||
RETURN TRUE
|
||||
END StartsWith;
|
||||
|
||||
PROCEDURE Append(source: ARRAY OF CHAR; VAR target: ARRAY OF CHAR): BOOLEAN;
|
||||
VAR i, j: INTEGER;
|
||||
BEGIN
|
||||
i := 0; WHILE (i < LEN(target)) & (target[i] # 0X) DO INC(i) END;
|
||||
j := 0;
|
||||
WHILE (j < LEN(source)) & (source[j] # 0X) DO
|
||||
IF i >= LEN(target) - 1 THEN RETURN FALSE END;
|
||||
target[i] := source[j]; INC(i); INC(j)
|
||||
END;
|
||||
target[i] := 0X;
|
||||
RETURN TRUE
|
||||
END Append;
|
||||
|
||||
PROCEDURE CompleteModule(name: ARRAY OF CHAR);
|
||||
VAR candidate: ARRAY 128 OF CHAR; ok: BOOLEAN;
|
||||
BEGIN
|
||||
IF StartsWith(name, prefix) THEN
|
||||
COPY(name, candidate); ok := Append(".", candidate);
|
||||
IF ok THEN AddCompletion(candidate) END
|
||||
END
|
||||
END CompleteModule;
|
||||
|
||||
PROCEDURE CompleteCommand(name: ARRAY OF CHAR);
|
||||
VAR candidate: ARRAY 128 OF CHAR; ok: BOOLEAN;
|
||||
BEGIN
|
||||
COPY(modulePrefix, candidate);
|
||||
ok := Append(".", candidate) & Append(name, candidate);
|
||||
IF ok & StartsWith(candidate, prefix) THEN AddCompletion(candidate) END
|
||||
END CompleteCommand;
|
||||
|
||||
PROCEDURE Complete(text: ARRAY OF CHAR);
|
||||
VAR i, j: INTEGER; valid: BOOLEAN;
|
||||
BEGIN
|
||||
IF LEN(text) > LEN(prefix) THEN RETURN END;
|
||||
COPY(text, prefix);
|
||||
i := 0; WHILE (prefix[i] # 0X) & (prefix[i] # ".") DO INC(i) END;
|
||||
IF prefix[i] = "." THEN
|
||||
j := 0; WHILE j < i DO modulePrefix[j] := prefix[j]; INC(j) END;
|
||||
modulePrefix[j] := 0X;
|
||||
valid := SharedModules.EnumerateCommands(modulePrefix, CompleteCommand)
|
||||
ELSE
|
||||
IF StartsWith("help", prefix) THEN AddCompletion("help") END;
|
||||
IF StartsWith("quit", prefix) THEN AddCompletion("quit") END;
|
||||
IF StartsWith("exit", prefix) THEN AddCompletion("exit") END;
|
||||
SharedModules.EnumerateModules(CompleteModule)
|
||||
END
|
||||
END Complete;
|
||||
|
||||
PROCEDURE Help;
|
||||
BEGIN
|
||||
Out.String("vloksh - Vishap Linux Oberon Kommand Shell"); Out.Ln;
|
||||
Out.String(" vloksh [-Ppath] [Module.Command [arguments]]"); Out.Ln;
|
||||
Out.String(" vloksh < script run a batch of commands"); Out.Ln;
|
||||
Out.String(" Module list its commands without initializing it"); Out.Ln;
|
||||
Out.String(" Tab: completion; arrows: history; quit/exit/Ctrl-D: leave"); Out.Ln;
|
||||
Out.String(" VOC_MODULE_PATH: colon-separated module directories"); Out.Ln;
|
||||
Out.String(" Modules stay loaded; HALT or a fault terminates this prototype."); Out.Ln
|
||||
END Help;
|
||||
|
||||
PROCEDURE ShowCommand(name: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
Out.String(" "); Out.String(modulePrefix); Out.Char("."); Out.String(name); Out.Ln
|
||||
END ShowCommand;
|
||||
|
||||
PROCEDURE Error;
|
||||
BEGIN
|
||||
Out.String("vloksh: "); Out.String(SharedModules.resMsg); Out.Ln;
|
||||
failed := TRUE
|
||||
END Error;
|
||||
|
||||
PROCEDURE Execute(line: ARRAY OF CHAR);
|
||||
VAR i, j, dot, start: INTEGER; name: ARRAY 128 OF CHAR;
|
||||
command: ARRAY 64 OF CHAR; m: SharedModules.Module;
|
||||
proc: SharedModules.Command; par, previous: Oberon.ParList;
|
||||
W: Texts.Writer;
|
||||
BEGIN
|
||||
i := 0; WHILE (line[i] = " ") OR (line[i] = 09X) DO INC(i) END;
|
||||
IF (line[i] = 0X) OR (line[i] = "#") THEN RETURN END;
|
||||
j := 0; dot := -1;
|
||||
WHILE (line[i] # 0X) & (line[i] > " ") DO
|
||||
IF j >= LEN(name) - 1 THEN
|
||||
SharedModules.resMsg := "command name too long"; Error; RETURN
|
||||
END;
|
||||
IF line[i] = "." THEN dot := j END;
|
||||
name[j] := line[i]; INC(i); INC(j)
|
||||
END;
|
||||
name[j] := 0X;
|
||||
IF (name = "quit") OR (name = "exit") THEN quit := TRUE; RETURN END;
|
||||
IF (name = "help") OR (name = "--help") OR (name = "-h") THEN Help; RETURN END;
|
||||
IF dot < 0 THEN
|
||||
COPY(name, modulePrefix);
|
||||
IF ~SharedModules.EnumerateCommands(name, ShowCommand) THEN Error END;
|
||||
Out.Flush; RETURN
|
||||
END;
|
||||
name[dot] := 0X;
|
||||
j := 0; start := dot + 1;
|
||||
WHILE name[start] # 0X DO
|
||||
IF j >= LEN(command) - 1 THEN
|
||||
SharedModules.resMsg := "command name too long"; Error; RETURN
|
||||
END;
|
||||
command[j] := name[start]; INC(j); INC(start)
|
||||
END;
|
||||
command[j] := 0X;
|
||||
WHILE (line[i] = " ") OR (line[i] = 09X) DO INC(i) END;
|
||||
NEW(par); NEW(par.text); Texts.Open(par.text, ""); par.pos := 0;
|
||||
Texts.OpenWriter(W);
|
||||
WHILE line[i] # 0X DO Texts.Write(W, line[i]); INC(i) END;
|
||||
Texts.Append(par.text, W.buf);
|
||||
(* Set parameters before __init too, for modules that inspect them there. *)
|
||||
previous := Oberon.Par; Oberon.Par := par;
|
||||
m := SharedModules.ThisMod(name);
|
||||
IF m # NIL THEN
|
||||
proc := SharedModules.ThisCommand(m, command);
|
||||
IF proc # NIL THEN proc ELSE Error END
|
||||
ELSE Error
|
||||
END;
|
||||
Oberon.Par := previous;
|
||||
Out.Flush;
|
||||
Heap.GC(TRUE)
|
||||
END Execute;
|
||||
|
||||
PROCEDURE Run;
|
||||
VAR i, status: INTEGER; line: ARRAY 4096 OF CHAR;
|
||||
arg: ARRAY 4096 OF CHAR; ok: BOOLEAN;
|
||||
BEGIN
|
||||
i := 1;
|
||||
IF i < Modules.ArgCount THEN
|
||||
Modules.GetArg(i, arg);
|
||||
IF (arg[0] = "-") & (arg[1] = "P") THEN
|
||||
IF arg[2] = 0X THEN
|
||||
INC(i);
|
||||
IF i >= Modules.ArgCount THEN
|
||||
Out.String("vloksh: -P needs a module path"); Out.Ln; Platform.Exit(1)
|
||||
END;
|
||||
Modules.GetArg(i, SharedModules.path)
|
||||
ELSE
|
||||
status := 0;
|
||||
WHILE arg[status + 2] # 0X DO
|
||||
SharedModules.path[status] := arg[status + 2]; INC(status)
|
||||
END;
|
||||
SharedModules.path[status] := 0X
|
||||
END;
|
||||
INC(i)
|
||||
END
|
||||
END;
|
||||
IF i < Modules.ArgCount THEN
|
||||
line := "";
|
||||
WHILE i < Modules.ArgCount DO
|
||||
Modules.GetArg(i, arg);
|
||||
ok := Append(arg, line);
|
||||
IF i < Modules.ArgCount - 1 THEN ok := ok & Append(" ", line) END;
|
||||
IF ~ok THEN Out.String("vloksh: command line too long"); Out.Ln; Platform.Exit(1) END;
|
||||
INC(i)
|
||||
END;
|
||||
Execute(line)
|
||||
ELSE
|
||||
InitTerminal(Complete);
|
||||
WHILE ~quit DO
|
||||
status := SHORT(ReadLine(line));
|
||||
IF status = 0 THEN quit := TRUE
|
||||
ELSIF status < 0 THEN
|
||||
Out.String("vloksh: input line too long"); Out.Ln; failed := TRUE
|
||||
ELSE Execute(line)
|
||||
END
|
||||
END
|
||||
END;
|
||||
IF failed THEN Heap.FINALL; Platform.Exit(1) END
|
||||
END Run;
|
||||
|
||||
BEGIN Run
|
||||
END vloksh.
|
||||
123
src/tools/vloksh/voc-shared.py
Normal file
123
src/tools/vloksh/voc-shared.py
Normal file
|
|
@ -0,0 +1,123 @@
|
|||
#!/usr/bin/env python3
|
||||
"""Build one VOC module per ELF shared object, with a single shared runtime."""
|
||||
|
||||
import argparse
|
||||
import os
|
||||
from pathlib import Path
|
||||
import re
|
||||
import shlex
|
||||
import shutil
|
||||
import subprocess
|
||||
import sys
|
||||
|
||||
|
||||
def installation(voc, model):
|
||||
compiler = Path(shutil.which(voc) or voc).resolve()
|
||||
prefix = compiler.parent.parent
|
||||
roots = [prefix / "share/voc", prefix]
|
||||
root = Path(os.environ["VOCROOT"]) if "VOCROOT" in os.environ else next(
|
||||
(p for p in roots if (p / model / "include/SYSTEM.h").is_file()), roots[0]
|
||||
)
|
||||
library = f"libvoc-O{model}.so"
|
||||
directories = [root / "lib", prefix / "lib64", prefix / "lib"]
|
||||
libdir = Path(os.environ["VOCLIBDIR"]) if "VOCLIBDIR" in os.environ else next(
|
||||
(p for p in directories if (p / library).is_file()), directories[0]
|
||||
)
|
||||
return root, libdir
|
||||
|
||||
|
||||
def run(command, **kwargs):
|
||||
print("+ " + shlex.join(str(part) for part in command), flush=True)
|
||||
result = subprocess.run([str(part) for part in command], **kwargs)
|
||||
if isinstance(result.stdout, str):
|
||||
print(result.stdout, end="", flush=True)
|
||||
result.check_returncode()
|
||||
return result
|
||||
|
||||
|
||||
def build(args):
|
||||
root, libdir = installation(args.voc, args.model)
|
||||
root = Path(args.root or root).resolve()
|
||||
libdir = Path(args.libdir or libdir).resolve()
|
||||
include = root / args.model / "include"
|
||||
runtime = libdir / f"libvoc-O{args.model}.so"
|
||||
if not (include / "SYSTEM.h").is_file() or not runtime.is_file():
|
||||
raise ValueError("cannot find VOC installation; use --root and --libdir")
|
||||
|
||||
source = Path(args.source).resolve()
|
||||
env = dict(os.environ, VOCROOT=str(root), VOCLIBDIR=str(libdir))
|
||||
directories = [Path.cwd(), *map(Path, args.library_path), libdir]
|
||||
directories = list(dict.fromkeys(p.resolve() for p in directories))
|
||||
# -S translates only. Compile the generated C explicitly with PIC even if
|
||||
# the installed compiler's default C command does not enable it.
|
||||
result = run([args.voc, f"-O{args.model}", "-sFS", source], env=env,
|
||||
stdout=subprocess.PIPE, text=True)
|
||||
|
||||
# Let VOC read ASCII or binary V4 source and report the MODULE name; the
|
||||
# generated __REGMOD must agree. Never assume it matches the file name.
|
||||
declared = re.search(r"\bCompiling ([A-Za-z][A-Za-z0-9_]*)\.", result.stdout)
|
||||
if not declared:
|
||||
raise ValueError("cannot determine VOC's generated module name")
|
||||
name = declared[1]
|
||||
text = Path(f"{name}.c").read_text()
|
||||
registered = re.search(r'__REGMOD\("([A-Za-z][A-Za-z0-9_]*)",', text)
|
||||
if not registered or registered[1] != name:
|
||||
raise ValueError(f"{name} is not a non-main module")
|
||||
commands = re.findall(r'__REGCMD\("([A-Za-z][A-Za-z0-9_]*)",', text)
|
||||
if len(name) > 19 or any(len(command) > 23 for command in commands):
|
||||
raise ValueError("VOC's runtime registry limits module names to 19 and commands to 23 characters")
|
||||
|
||||
symbols = subprocess.check_output(["nm", "-D", "--defined-only", str(runtime)], text=True)
|
||||
runtime_symbols = {line.split()[-1] for line in symbols.splitlines() if line.split()}
|
||||
imports = list(dict.fromkeys(re.findall(r"__MODULE_IMPORT\((\w+)\)", text)))
|
||||
dependencies = []
|
||||
for imported in imports:
|
||||
library = f"libvoc-{imported}-O{args.model}.so"
|
||||
if f"{imported}__init" in runtime_symbols:
|
||||
# Never duplicate modules already provided by the shared runtime.
|
||||
continue
|
||||
if not any((directory / library).is_file() for directory in directories):
|
||||
raise ValueError(f"missing shared dependency {library}; build {imported} first or use -L")
|
||||
dependencies.append(f"-l:{library}")
|
||||
|
||||
shared = Path(f"{name}.shared.c")
|
||||
shared.write_text(text + f'''\n/* Shared-module ABI shape, checked before calling __init. */
|
||||
#include "Heap.h"
|
||||
export const INT32 {name}__voc_abi[] = {{
|
||||
1, sizeof(ADDRESS), sizeof(SHORTINT), sizeof(INTEGER), sizeof(LONGINT),
|
||||
sizeof(SET), sizeof(Heap_ModuleDesc), sizeof(Heap_CmdDesc)
|
||||
}};
|
||||
''')
|
||||
library = f"libvoc-{name}-O{args.model}.so"
|
||||
cc = shlex.split(args.cc)
|
||||
includes = [Path.cwd(), include, *map(Path, args.include)]
|
||||
flags = shlex.split(os.environ.get("CFLAGS", ""))
|
||||
ldflags = shlex.split(os.environ.get("LDFLAGS", ""))
|
||||
extra_libs = shlex.split(os.environ.get("LDLIBS", ""))
|
||||
run([*cc, *flags, "-fPIC", "-Wno-stringop-overflow", "-shared", shared,
|
||||
*[f"-I{directory}" for directory in includes], *ldflags,
|
||||
*[f"-L{directory}" for directory in directories],
|
||||
"-Wl,-z,defs", f"-Wl,-soname,{library}", "-Wl,-rpath,$ORIGIN",
|
||||
"-Wl,--no-as-needed", *dependencies, f"-lvoc-O{args.model}",
|
||||
*extra_libs, "-o", library])
|
||||
print(f"Built {library}; keep {name}.sym and {name}.h for development/completion.")
|
||||
|
||||
|
||||
def main():
|
||||
parser = argparse.ArgumentParser(description=__doc__)
|
||||
parser.add_argument("source", help="one non-main Oberon module")
|
||||
parser.add_argument("--model", choices=("2", "C"), default="2")
|
||||
parser.add_argument("--voc", default=os.environ.get("VOC", "voc"))
|
||||
parser.add_argument("--cc", default=os.environ.get("CC", "cc"))
|
||||
parser.add_argument("--root", help="VOC resource directory, e.g. /usr/share/voc")
|
||||
parser.add_argument("--libdir", help="directory containing libvoc-O2.so")
|
||||
parser.add_argument("-I", "--include", action="append", default=[])
|
||||
parser.add_argument("-L", "--library-path", action="append", default=[])
|
||||
try:
|
||||
build(parser.parse_args())
|
||||
except (ValueError, OSError, subprocess.CalledProcessError) as error:
|
||||
parser.exit(1, f"voc-shared: {error}\n")
|
||||
|
||||
|
||||
if __name__ == "__main__":
|
||||
main()
|
||||
Loading…
Add table
Add a link
Reference in a new issue