Compare commits

...

6 commits

Author SHA1 Message Date
Norayr Chilingarian
c18945bc70 starting work on dynamically loaded modules and shell 2026-10-09 03:13:59 +04:00
Norayr Chilingarian
531bfe168b fixing Math, MathL and the ooc real math
sincos took cos as sqrt(1 - sin*sin): its sign was lost and it was
0 near pi/2 (tan(pi/2) gave large, tan(-pi) the wrong sign); REAL tan
and sin/cos reduced in LONGREAL with REAL pi and pi/2; REAL arcsin and
arccos returned their unadjusted value after any earlier error
(err stays set). in oocLowReal, scale, intpart, trunc and round
treated a REAL as a 64 bit SET (RealMath.sqrt(2) was about 1E9); now
with Reals.SetExpo and ENTIER. LowReal.small and LowLReal.small are
the exact constants again. the math test expects the right values.
2026-10-06 20:14:42 +04:00
Norayr Chilingarian
e69f33a0cd converting and writing real constants exactly
the scanner built a decimal constant digit by digit, rounding at
each step (1.1D3 was not 1100), and the code generator wrote reals
with 15 digits, so very small values came out as 0 (LowReal.small,
LowLReal.small, MathL's miny). now the scanner converts with strtod
and strtof, a constant is out of range only when its value is, and
reals are written with 17 significant digits, which read back as the
same double. MAX(REAL) and MAX(LONGREAL) are set from their bits
(MAX(LONGREAL) was 1.79769296342094D308).
2026-10-06 20:14:42 +04:00
Norayr Chilingarian
d6d99b4fbe fixing Out.Real and Out.LongReal: the exponent missed the rounding carry
the exponent digits were written before the mantissa was rounded, so
a carry into the next power of ten was lost: 0.99999999999999989
came out as 1.0D-001, and Math.sqrt(1.0) as 1.00000E-01.
2026-10-06 20:14:31 +04:00
Norayr Chilingarian
9701249ad2 adding ulm unix file and terminal streams. 2026-09-25 19:05:52 +04:00
Norayr Chilingarian
fcf59d5d93 connecting ulm standard streams to platform. 2026-09-21 15:22:53 +04:00
41 changed files with 2813 additions and 185 deletions

View file

@ -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
View 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.

View file

@ -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

View file

@ -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:

View file

@ -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;

View file

@ -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;

View file

@ -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;

View file

@ -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;

View file

@ -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;

View file

@ -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;

View file

@ -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);

View 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.

View file

@ -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;

View 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.

View 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.

View 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.

View 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.

View 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.

View 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;
}

View 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

View file

@ -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;

View file

@ -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;

View file

@ -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;

View file

@ -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)";

View file

@ -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;

View file

@ -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

View file

@ -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

View file

@ -1 +1 @@
18 Dec 2016 16:55:53
Tue Oct 6 20:11:12 +04 2026

27
src/test/ulm/readme.md Normal file
View 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.

View 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.

View 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.

View 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.

View file

@ -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
View 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)"

View 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;
}

View 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
View 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>)")

View 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
View 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
View 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.

View 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()