diff --git a/ReadMe.md b/ReadMe.md index 1a43b4cf..323aef23 100644 --- a/ReadMe.md +++ b/ReadMe.md @@ -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. diff --git a/doc/SharedModules.md b/doc/SharedModules.md new file mode 100644 index 00000000..e5a1abf5 --- /dev/null +++ b/doc/SharedModules.md @@ -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. diff --git a/make.cmd b/make.cmd index ba2c072f..81902051 100644 --- a/make.cmd +++ b/make.cmd @@ -391,7 +391,9 @@ cd %BUILDDIR%\%MODEL% %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmResources.Mod || exit /b %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmForwarders.Mod || exit /b %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmRelatedEvents.Mod || exit /b +%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmStreamsHost.Mod || exit /b %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmStreams.Mod || exit /b +%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmTerminals.Mod || exit /b %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmStrings.Mod || exit /b %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmSysTypes.Mod || exit /b %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmTexts.Mod || exit /b diff --git a/makefile b/makefile index f895559f..eb06f3b5 100644 --- a/makefile +++ b/makefile @@ -113,6 +113,17 @@ usage: tags: ctags -R --options=oberon.ctags --extras=+q +# Optional Unix command shell; does not rebuild or install the compiler. +.PHONY: vloksh vloksh-test vloksh-demo +vloksh: + $(MAKE) -f src/tools/vloksh/Makefile all + +vloksh-test: + $(MAKE) -f src/tools/vloksh/Makefile test + +vloksh-demo: + $(MAKE) -f src/tools/vloksh/Makefile demo + # Generate config files Configuration.Make and Configuration.Mod FORCE: diff --git a/src/compiler/OPM.Mod b/src/compiler/OPM.Mod index 5635fa03..44d9ff6f 100755 --- a/src/compiler/OPM.Mod +++ b/src/compiler/OPM.Mod @@ -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 '; + 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; diff --git a/src/compiler/OPS.Mod b/src/compiler/OPS.Mod index f81bcae6..be08ede4 100644 --- a/src/compiler/OPS.Mod +++ b/src/compiler/OPS.Mod @@ -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 '; + 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; diff --git a/src/library/ooc/oocLRealMath.Mod b/src/library/ooc/oocLRealMath.Mod index 552f8c20..48b65bff 100644 --- a/src/library/ooc/oocLRealMath.Mod +++ b/src/library/ooc/oocLRealMath.Mod @@ -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; diff --git a/src/library/ooc/oocLowLReal.Mod b/src/library/ooc/oocLowLReal.Mod index e28e13cf..6a301a07 100644 --- a/src/library/ooc/oocLowLReal.Mod +++ b/src/library/ooc/oocLowLReal.Mod @@ -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; diff --git a/src/library/ooc/oocLowReal.Mod b/src/library/ooc/oocLowReal.Mod index 5bbd5fb3..e8ddcf07 100644 --- a/src/library/ooc/oocLowReal.Mod +++ b/src/library/ooc/oocLowReal.Mod @@ -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=0.5 THEN i:=i+ONE END; (* the first dropped bit set: away from zero *) + RETURN scale(i, -k)*sign(x) END END round; diff --git a/src/library/ooc/oocRealMath.Mod b/src/library/ooc/oocRealMath.Mod index 611f1f96..82c750e6 100644 --- a/src/library/ooc/oocRealMath.Mod +++ b/src/library/ooc/oocRealMath.Mod @@ -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) 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; diff --git a/src/library/ulm/ulmStreams.Mod b/src/library/ulm/ulmStreams.Mod index 37f25dfd..c14e31f2 100644 --- a/src/library/ulm/ulmStreams.Mod +++ b/src/library/ulm/ulmStreams.Mod @@ -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); diff --git a/src/library/ulm/ulmStreamsHost.Mod b/src/library/ulm/ulmStreamsHost.Mod new file mode 100644 index 00000000..eecff7bc --- /dev/null +++ b/src/library/ulm/ulmStreamsHost.Mod @@ -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. diff --git a/src/library/ulm/ulmSysIO.Mod b/src/library/ulm/ulmSysIO.Mod index 3274efda..f83f797d 100644 --- a/src/library/ulm/ulmSysIO.Mod +++ b/src/library/ulm/ulmSysIO.Mod @@ -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; diff --git a/src/library/ulm/ulmTerminals.Mod b/src/library/ulm/ulmTerminals.Mod new file mode 100644 index 00000000..7977d8b3 --- /dev/null +++ b/src/library/ulm/ulmTerminals.Mod @@ -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. diff --git a/src/library/ulm/ulmUnixFiles.Mod b/src/library/ulm/ulmUnixFiles.Mod new file mode 100644 index 00000000..bfc4f9df --- /dev/null +++ b/src/library/ulm/ulmUnixFiles.Mod @@ -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. diff --git a/src/library/ulm/ulmUnixTerminals.Mod b/src/library/ulm/ulmUnixTerminals.Mod new file mode 100644 index 00000000..03361e6d --- /dev/null +++ b/src/library/ulm/ulmUnixTerminals.Mod @@ -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. diff --git a/src/library/v4/CommandSymbols.Mod b/src/library/v4/CommandSymbols.Mod new file mode 100644 index 00000000..e2bbc121 --- /dev/null +++ b/src/library/v4/CommandSymbols.Mod @@ -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. diff --git a/src/library/v4/SharedModules.Mod b/src/library/v4/SharedModules.Mod new file mode 100644 index 00000000..5df6aaa8 --- /dev/null +++ b/src/library/v4/SharedModules.Mod @@ -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. diff --git a/src/library/v4/SharedModulesSupport.c b/src/library/v4/SharedModulesSupport.c new file mode 100644 index 00000000..153b4b4a --- /dev/null +++ b/src/library/v4/SharedModulesSupport.c @@ -0,0 +1,211 @@ +#define _GNU_SOURCE +#include +#include +#include +#include +#include +#include +#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; +} diff --git a/src/library/v4/SharedModulesSupport.h b/src/library/v4/SharedModulesSupport.h new file mode 100644 index 00000000..8c044b91 --- /dev/null +++ b/src/library/v4/SharedModulesSupport.h @@ -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 diff --git a/src/runtime/Math.Mod b/src/runtime/Math.Mod index 89707f0f..71075283 100644 --- a/src/runtime/Math.Mod +++ b/src/runtime/Math.Mod @@ -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; diff --git a/src/runtime/MathL.Mod b/src/runtime/MathL.Mod index 4c1e57a7..71f4e944 100644 --- a/src/runtime/MathL.Mod +++ b/src/runtime/MathL.Mod @@ -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; diff --git a/src/runtime/Out.Mod b/src/runtime/Out.Mod index 8895037c..7dc245c5 100644 --- a/src/runtime/Out.Mod +++ b/src/runtime/Out.Mod @@ -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; diff --git a/src/runtime/Platformunix.Mod b/src/runtime/Platformunix.Mod index 0fc15bff..4a88fe5d 100644 --- a/src/runtime/Platformunix.Mod +++ b/src/runtime/Platformunix.Mod @@ -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 '; PROCEDURE -Aincludefcntl '#include '; PROCEDURE -Aincludeerrno '#include '; PROCEDURE -Aincludeutime '#include '; +PROCEDURE -Aincludetermios '#include '; +PROCEDURE -Aincludesysioctl '#include '; PROCEDURE -Astdlib '#include '; PROCEDURE -Astdio '#include '; PROCEDURE -Aerrno '#include '; @@ -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)"; diff --git a/src/runtime/Platformwindows.Mod b/src/runtime/Platformwindows.Mod index 3d2f7729..5ae1097d 100644 --- a/src/runtime/Platformwindows.Mod +++ b/src/runtime/Platformwindows.Mod @@ -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; diff --git a/src/test/confidence/math/expected b/src/test/confidence/math/expected index fb01dc20..ca8feaae 100644 --- a/src/test/confidence/math/expected +++ b/src/test/confidence/math/expected @@ -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 diff --git a/src/test/confidence/out/expected b/src/test/confidence/out/expected index dab1e079..cb43b5e3 100644 --- a/src/test/confidence/out/expected +++ b/src/test/confidence/out/expected @@ -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 diff --git a/src/test/confidence/planned-binary-change b/src/test/confidence/planned-binary-change index 9135bbd2..ceba94ea 100644 --- a/src/test/confidence/planned-binary-change +++ b/src/test/confidence/planned-binary-change @@ -1 +1 @@ -18 Dec 2016 16:55:53 +Tue Oct 6 20:11:12 +04 2026 diff --git a/src/test/ulm/readme.md b/src/test/ulm/readme.md new file mode 100644 index 00000000..42002128 --- /dev/null +++ b/src/test/ulm/readme.md @@ -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. diff --git a/src/test/ulm/testUnixFiles.Mod b/src/test/ulm/testUnixFiles.Mod new file mode 100644 index 00000000..23d1ebe3 --- /dev/null +++ b/src/test/ulm/testUnixFiles.Mod @@ -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. diff --git a/src/test/ulm/testUnixTerminalExit.Mod b/src/test/ulm/testUnixTerminalExit.Mod new file mode 100644 index 00000000..0cd105b9 --- /dev/null +++ b/src/test/ulm/testUnixTerminalExit.Mod @@ -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. diff --git a/src/test/ulm/testUnixTerminals.Mod b/src/test/ulm/testUnixTerminals.Mod new file mode 100644 index 00000000..e9691605 --- /dev/null +++ b/src/test/ulm/testUnixTerminals.Mod @@ -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. diff --git a/src/tools/make/oberon.mk b/src/tools/make/oberon.mk index 46d24905..182c7861 100644 --- a/src/tools/make/oberon.mk +++ b/src/tools/make/oberon.mk @@ -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 diff --git a/src/tools/vloksh/Makefile b/src/tools/vloksh/Makefile new file mode 100644 index 00000000..52b5920a --- /dev/null +++ b/src/tools/vloksh/Makefile @@ -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)" diff --git a/src/tools/vloksh/Terminal.c b/src/tools/vloksh/Terminal.c new file mode 100644 index 00000000..ad41005a --- /dev/null +++ b/src/tools/vloksh/Terminal.c @@ -0,0 +1,86 @@ +#include +#include +#include +#include +#include +#include +#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; +} diff --git a/src/tools/vloksh/Terminal.h b/src/tools/vloksh/Terminal.h new file mode 100644 index 00000000..c85bd2b0 --- /dev/null +++ b/src/tools/vloksh/Terminal.h @@ -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 diff --git a/src/tools/vloksh/demo.py b/src/tools/vloksh/demo.py new file mode 100644 index 00000000..801ade98 --- /dev/null +++ b/src/tools/vloksh/demo.py @@ -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.)") diff --git a/src/tools/vloksh/examples/StrDemo.Mod b/src/tools/vloksh/examples/StrDemo.Mod new file mode 100644 index 00000000..deb6f5a9 --- /dev/null +++ b/src/tools/vloksh/examples/StrDemo.Mod @@ -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. diff --git a/src/tools/vloksh/test.py b/src/tools/vloksh/test.py new file mode 100644 index 00000000..db0cdcc0 --- /dev/null +++ b/src/tools/vloksh/test.py @@ -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)) diff --git a/src/tools/vloksh/vloksh.Mod b/src/tools/vloksh/vloksh.Mod new file mode 100644 index 00000000..230741a9 --- /dev/null +++ b/src/tools/vloksh/vloksh.Mod @@ -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. diff --git a/src/tools/vloksh/voc-shared.py b/src/tools/vloksh/voc-shared.py new file mode 100644 index 00000000..5c7eedbf --- /dev/null +++ b/src/tools/vloksh/voc-shared.py @@ -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()