From fcf59d5d931aab5bcb1e592d4c10e2bcb58e62ec Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Mon, 21 Sep 2026 14:56:54 +0400 Subject: [PATCH 1/6] connecting ulm standard streams to platform. --- src/library/ulm/ulmStreams.Mod | 44 +++++++++++++++++++++++++----- src/library/ulm/ulmStreamsHost.Mod | 35 ++++++++++++++++++++++++ src/tools/make/oberon.mk | 1 + 3 files changed, 73 insertions(+), 7 deletions(-) create mode 100644 src/library/ulm/ulmStreamsHost.Mod 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/tools/make/oberon.mk b/src/tools/make/oberon.mk index 46d24905..e56bb9f9 100644 --- a/src/tools/make/oberon.mk +++ b/src/tools/make/oberon.mk @@ -314,6 +314,7 @@ 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/ulmStrings.Mod cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysTypes.Mod From 9701249ad244cbdfd1c1df88af852be1484ae8e7 Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Fri, 25 Sep 2026 19:05:52 +0400 Subject: [PATCH 2/6] adding ulm unix file and terminal streams. --- make.cmd | 2 + src/library/ulm/ulmSysIO.Mod | 42 +++- src/library/ulm/ulmTerminals.Mod | 309 ++++++++++++++++++++++++ src/library/ulm/ulmUnixFiles.Mod | 235 ++++++++++++++++++ src/library/ulm/ulmUnixTerminals.Mod | 327 ++++++++++++++++++++++++++ src/runtime/Platformunix.Mod | 123 +++++++++- src/runtime/Platformwindows.Mod | 26 +- src/test/ulm/readme.md | 27 +++ src/test/ulm/testUnixFiles.Mod | 45 ++++ src/test/ulm/testUnixTerminalExit.Mod | 9 + src/test/ulm/testUnixTerminals.Mod | 26 ++ src/tools/make/oberon.mk | 3 + 12 files changed, 1163 insertions(+), 11 deletions(-) create mode 100644 src/library/ulm/ulmTerminals.Mod create mode 100644 src/library/ulm/ulmUnixFiles.Mod create mode 100644 src/library/ulm/ulmUnixTerminals.Mod create mode 100644 src/test/ulm/readme.md create mode 100644 src/test/ulm/testUnixFiles.Mod create mode 100644 src/test/ulm/testUnixTerminalExit.Mod create mode 100644 src/test/ulm/testUnixTerminals.Mod 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/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/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/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 e56bb9f9..182c7861 100644 --- a/src/tools/make/oberon.mk +++ b/src/tools/make/oberon.mk @@ -316,6 +316,7 @@ ulm: 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 @@ -337,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 From d6d99b4fbe5b3699a14888a6f9bfb6ff4b3c68a1 Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Tue, 6 Oct 2026 20:14:31 +0400 Subject: [PATCH 3/6] fixing Out.Real and Out.LongReal: the exponent missed the rounding carry the exponent digits were written before the mantissa was rounded, so a carry into the next power of ten was lost: 0.99999999999999989 came out as 1.0D-001, and Math.sqrt(1.0) as 1.00000E-01. --- src/runtime/Out.Mod | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) 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; From e69f33a0cd2058fea0bb28ad80a7ba7f9bdf0b96 Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Tue, 6 Oct 2026 20:14:42 +0400 Subject: [PATCH 4/6] converting and writing real constants exactly the scanner built a decimal constant digit by digit, rounding at each step (1.1D3 was not 1100), and the code generator wrote reals with 15 digits, so very small values came out as 0 (LowReal.small, LowLReal.small, MathL's miny). now the scanner converts with strtod and strtof, a constant is out of range only when its value is, and reals are written with 17 significant digits, which read back as the same double. MAX(REAL) and MAX(LONGREAL) are set from their bits (MAX(LONGREAL) was 1.79769296342094D308). --- src/compiler/OPM.Mod | 31 ++++++++++++++-- src/compiler/OPS.Mod | 43 ++++++++++------------- src/test/confidence/out/expected | 8 ++--- src/test/confidence/planned-binary-change | 2 +- 4 files changed, 52 insertions(+), 32 deletions(-) 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/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 From 531bfe168b5ca831ba368ff43b20786a13581520 Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Tue, 6 Oct 2026 20:14:42 +0400 Subject: [PATCH 5/6] fixing Math, MathL and the ooc real math sincos took cos as sqrt(1 - sin*sin): its sign was lost and it was 0 near pi/2 (tan(pi/2) gave large, tan(-pi) the wrong sign); REAL tan and sin/cos reduced in LONGREAL with REAL pi and pi/2; REAL arcsin and arccos returned their unadjusted value after any earlier error (err stays set). in oocLowReal, scale, intpart, trunc and round treated a REAL as a 64 bit SET (RealMath.sqrt(2) was about 1E9); now with Reals.SetExpo and ENTIER. LowReal.small and LowLReal.small are the exact constants again. the math test expects the right values. --- src/library/ooc/oocLRealMath.Mod | 2 +- src/library/ooc/oocLowLReal.Mod | 3 +- src/library/ooc/oocLowReal.Mod | 44 ++++---- src/library/ooc/oocRealMath.Mod | 12 +- src/runtime/Math.Mod | 12 +- src/runtime/MathL.Mod | 2 +- src/test/confidence/math/expected | 182 +++++++++++++++--------------- 7 files changed, 128 insertions(+), 129 deletions(-) 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/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/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 From c18945bc704a778693648f083b551b0821762b03 Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Fri, 9 Oct 2026 03:13:59 +0400 Subject: [PATCH 6/6] starting work on dynamically loaded modules and shell --- ReadMe.md | 3 + doc/SharedModules.md | 158 +++++++++++++++++++ makefile | 11 ++ src/library/v4/CommandSymbols.Mod | 175 +++++++++++++++++++++ src/library/v4/SharedModules.Mod | 107 +++++++++++++ src/library/v4/SharedModulesSupport.c | 211 ++++++++++++++++++++++++++ src/library/v4/SharedModulesSupport.h | 17 +++ src/tools/vloksh/Makefile | 34 +++++ src/tools/vloksh/Terminal.c | 86 +++++++++++ src/tools/vloksh/Terminal.h | 11 ++ src/tools/vloksh/demo.py | 19 +++ src/tools/vloksh/examples/StrDemo.Mod | 28 ++++ src/tools/vloksh/test.py | 206 +++++++++++++++++++++++++ src/tools/vloksh/vloksh.Mod | 201 ++++++++++++++++++++++++ src/tools/vloksh/voc-shared.py | 123 +++++++++++++++ 15 files changed, 1390 insertions(+) create mode 100644 doc/SharedModules.md create mode 100644 src/library/v4/CommandSymbols.Mod create mode 100644 src/library/v4/SharedModules.Mod create mode 100644 src/library/v4/SharedModulesSupport.c create mode 100644 src/library/v4/SharedModulesSupport.h create mode 100644 src/tools/vloksh/Makefile create mode 100644 src/tools/vloksh/Terminal.c create mode 100644 src/tools/vloksh/Terminal.h create mode 100644 src/tools/vloksh/demo.py create mode 100644 src/tools/vloksh/examples/StrDemo.Mod create mode 100644 src/tools/vloksh/test.py create mode 100644 src/tools/vloksh/vloksh.Mod create mode 100644 src/tools/vloksh/voc-shared.py 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/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/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/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()