Threaded Terminal Emulation

Für Fragen von Einsteigern und Programmieranfängern...
Antworten
HobbyProgrammer
Beiträge: 166
Registriert: Di 29. Okt 2019, 12:51
Wohnort: Deutschland , Baden-Württemberg

Threaded Terminal Emulation

Beitrag von HobbyProgrammer »

Hallo,

einige von euch haben ja schon beim meinem Programm 'Z180SoftSystem' herein geschaut.
Dort bin ich gerade dabei die Terminal Emulation in einem eigenen Thread laufen zu lassen, um diese von der eigentlichen Emulation des Z180 Prozessor System zu entkoppeln.
Das funktioniert soweit auch, jedoch hätte ich noch ein kleines Problem für welches ich eine evtl. elegantere oder generell bessere Lösung suche.

Ich habe den Terminal Code auf das wesentliche reduziert (wären ansonsten über 1000 Zeilen):

Code: Alles auswählen

unit System_Terminal;

{$mode objfpc}{$H+}

interface

uses SysUtils, Graphics, Classes;

type
    TTerminalEmulation = class(TThread)
    private

    protected
        procedure Execute; override;

    public
        constructor Create(CreateSuspended: boolean);

    end;

...

var
    ...
    TerminalEmulation: TTerminalEmulation;


procedure writeTerminalCharacter(character: byte);

implementation

type
    TTermMode = (STANDARD, VT52_ESC, ANSI_ESC, ANSI_ESC_PAR, DCA_ROW, DCA_COLUMN);

var
    termMode: TTermMode;
    newCharWriting: boolean;
    ...
    characterBuffer: string;
    ...
    enableTerminalLogging: boolean;
    loggingFile: file of char;
    ...

// --------------------------------------------------------------------------------
procedure writeTerminalCharacter(character: byte);
begin
    if (character > $00) then begin
        newCharWriting := True;
        characterBuffer := characterBuffer + char(character);
        newCharWriting := False;
    end;
end;

// --------------------------------------------------------------------------------
procedure TTerminalEmulation.Execute;
var
    character: byte;

    ...

    // ----------------------------------------
begin
    repeat

        if ((characterBuffer.Length = 0) or (newCharWriting)) then begin
            Sleep(10);
        end
        else begin
            character := byte(characterBuffer[1]);
            Delete(characterBuffer, 1, 1);

            case termMode of
                STANDARD: normalTerminalMode;
                VT52_ESC: vt52EscapeMode;
                ANSI_ESC: ansiEscapeMode;
                ANSI_ESC_PAR: ansiEscapeModeParameter;
                DCA_ROW: begin
                    if (character >= $20) then begin
                        dcaRow := character - $20;
                        termMode := DCA_COLUMN;
                    end
                    else begin
                        termMode := STANDARD;
                    end;
                end;
                DCA_COLUMN: begin
                    if (character >= $20) then begin
                        setCursorPosition(dcaRow, character - $20);
                    end;
                    termMode := STANDARD;
                end;
            end;

            if (enableTerminalLogging) then begin
                Write(loggingFile, chr(character));
            end;

        end;

    until (Terminated);

end;

// --------------------------------------------------------------------------------
constructor TTerminalEmulation.Create(CreateSuspended: boolean);
begin
    FreeOnTerminate := True;
    inherited Create(CreateSuspended);
end;

// --------------------------------------------------------------------------------
initialization
begin
    newCharWriting := True;
        
    ...
        
    characterBuffer := '';
end;

// --------------------------------------------------------------------------------
end.
Der String 'characterBuffer' dient als FIFO-Buffer für die Zeichen welche zur Anzeige gebracht werden sollen.
In der Threaded-Methode 'execute' wird dieser ausgelesen und entsprechend ausgegeben oder eben die Steuerzeichen verarbeitet. Wenn nun aber die Prozessor Emulation gerade ein Zeichen in den Buffer schreibt und gleichzeitig die 'execute'-Methode daraus lesen will, ergeben sich sporadisch fehlende oder falsche Zeichen auf dem Terminal Display.
Das habe ich mit dem Flag 'newCharWriting' versucht zu umgehen. Funktioniert auch bis auf sehr sehr seltene Fehler. Mich würde nun interessieren ob es da wie schon geschrieben eine elegantere oder generell besser Variante gibt.
Ich habe bis jetzt noch nichts mit Threading programmiert. Im Wiki habe ich vom CriticalSections gelesen,
konnte das aber bis jetzt nicht für mein Problem adaptieren.
Würde mich über Hilfe sehr freuen.

Grüße
HobbyProgrammer
Host: Core i7-12700H, NVIDIA RTX3050 6GB, 32GB Ram, 1TB NVME SSD mit KUbuntu 22.04LTS 64bit , VM KUbuntu 22.04 LTS 64bit mit Lazarus 2.2.6 und Cross-Platform Compiler für Linux 32/64bit und Windows 32/64bit. Wine für erste Tests der Windows Binarys.

Benutzeravatar
Winni
Beiträge: 1577
Registriert: Mo 2. Mär 2009, 16:45
OS, Lazarus, FPC: Laz2.2.2, fpc 3.2.2
CPU-Target: 64Bit
Wohnort: Fast Dänemark

Re: Threaded Terminal Emulation

Beitrag von Winni »

Hi!

So was wird gerne als Ringbuffer implementiert.
Also als Variable mit konstanter Grösse:

Code: Alles auswählen

var Buf: array[0..1023] of char;
Jetzt brauchst Du noch zwei Pointer für Einlesen und Auslesen.
Wenn einer auf Buf-Element > 1023 zugreifen will, dann wieder bei Null anfangen.

Keinerlei Massnahmen sind nötig, um die Daten zu bewegen, die Größe zu ändern oder sonstwas.
Du brauchst nicht mal die ausgelesenen chars nullen - die werden automatisch überschrieben.

An einer Stelle musst Du aber aufpassen: der Pointer zum Auslesen darf den Pointer zum Einlesen
nicht "überholen". Im mildesten Fall gibt's Salat.

Oder es gibt einen Systemstillstand:
Es gab eine Kollegin mit atemberaubenden 10-Finger-System: high speed.
Die hatte ab und zu den OS9-Server (Unix Derrivat) bzw. dessen Ringbuffer mit nur 128 Zeichen vollgeknallt.
Dann fror der Server ein. Hat lange gedauert, bis wir das rausgefunden hatten.
Jaja, das war Anfang der 90er.

Winni

PascalDragon
Beiträge: 825
Registriert: Mi 3. Jun 2020, 07:18
OS, Lazarus, FPC: L 2.0.8, FPC Trunk, OS Win/Linux
CPU-Target: Aarch64 bis Z80 ;)
Wohnort: München

Re: Threaded Terminal Emulation

Beitrag von PascalDragon »

HobbyProgrammer hat geschrieben:
Fr 23. Okt 2020, 18:06
Ich habe bis jetzt noch nichts mit Threading programmiert. Im Wiki habe ich vom CriticalSections gelesen,
konnte das aber bis jetzt nicht für mein Problem adaptieren.
Kritische Bereiche sind eigentlich der saubere Weg für sowas (es gibt dann noch LockFree Datenstrukturen, da muss man dann allerdings auch aufpassen, wenn man die schreibt).

Du legst eine Instanz von TCriticalSection (Unit SyncObjs) an (zum Beispiel im initialization-Abschnitt deiner Unit).
Mit der Method Enter belegst du den kritischen Bereich und mit Leave verlässt du ihn wieder. Damit schützt du einmal das Schreiben in den Puffer und einmal das Auslesen (mit der selben Instanz von TCriticalSection!), dann hast du wechselseitigen Ausschluss sichergestellt. Falls ein weiterer Thread während dieser Zeit Enter aufruft wird dieser vom Betriebssystem so lange blockiert, bis der andere Thread Leave aufruft.

Die beiden Bereiche bei dir, die du schützen musst:

Code: Alles auswählen

        newCharWriting := True;
        characterBuffer := characterBuffer + char(character);
        newCharWriting := False;
und

Code: Alles auswählen

            character := byte(characterBuffer[1]);
            Delete(characterBuffer, 1, 1);
Zusätzlich könntest du auch noch ein TEvent nutzen. Dieses signalisiert du (SetEvent), wenn ein neues Zeichen in deinen Puffer geschrieben wird und du wartest darauf (WaitFor) in deinem Thread, dann musst du nämlich nicht Sleep nutzen, sondern das Betriebsystem legt deinen Thread schlafen, bis das Event signalisiert wird.
FPC Compiler Entwickler

HobbyProgrammer
Beiträge: 166
Registriert: Di 29. Okt 2019, 12:51
Wohnort: Deutschland , Baden-Württemberg

Re: Threaded Terminal Emulation

Beitrag von HobbyProgrammer »

Ich habe den characterBuffer nun nach Winnis Vorschlag aufgebaut.

Code: Alles auswählen

unit System_Terminal;

{$mode objfpc}{$H+}

interface

uses SysUtils, Graphics, Classes;

...

procedure writeTerminalCharacter(character: byte);

implementation

type
    TTermMode = (STANDARD, VT52_ESC, ANSI_ESC, ANSI_ESC_PAR, DCA_ROW, DCA_COLUMN);

    TTerminalEmulation = class(TThread)
    private

    protected
        procedure Execute; override;

    public
        constructor Create(CreateSuspended: boolean);

    end;

var
    termMode: TTermMode;
    ...
    characterBuffer: array[0..1023] of byte;
    characterReadIndex, characterWriteIndex: integer;
    ...
    enableTerminalLogging: boolean;
    loggingFile: file of char;
    ...
    TerminalEmulation: TTerminalEmulation;

    
// --------------------------------------------------------------------------------
procedure writeTerminalCharacter(character: byte);
begin
    if (character > $00) then begin
        characterBuffer[characterWriteIndex] := character;
        Inc(characterWriteIndex);
        if (characterWriteIndex > 1023) then
            characterWriteIndex := 0;
    end;
end;

// --------------------------------------------------------------------------------
procedure TTerminalEmulation.Execute;
var
    character: byte;

    ...

    // ----------------------------------------
begin
    repeat

        if (characterReadIndex = characterWriteIndex) then begin
            Sleep(50);
        end
        else begin
            character := characterBuffer[characterReadIndex];
            Inc(characterReadIndex);
            if (characterReadIndex > 1023) then
                characterReadIndex := 0;

            case termMode of
                STANDARD: normalTerminalMode;
                VT52_ESC: vt52EscapeMode;
                ANSI_ESC: ansiEscapeMode;
                ANSI_ESC_PAR: ansiEscapeModeParameter;
                DCA_ROW: begin
                    if (character >= $20) then begin
                        dcaRow := character - $20;
                        termMode := DCA_COLUMN;
                    end
                    else begin
                        termMode := STANDARD;
                    end;
                end;
                DCA_COLUMN: begin
                    if (character >= $20) then begin
                        setCursorPosition(dcaRow, character - $20);
                    end;
                    termMode := STANDARD;
                end;
            end;

            if (enableTerminalLogging) then begin
                Write(loggingFile, chr(character));
            end;

        end;

    until (Terminated);

end;

// --------------------------------------------------------------------------------
constructor TTerminalEmulation.Create(CreateSuspended: boolean);
begin
    FreeOnTerminate := True;
    inherited Create(CreateSuspended);
end;

// --------------------------------------------------------------------------------
initialization
begin
    ...
    characterReadIndex := 0;
    characterWriteIndex := 0;
    TerminalEmulation := TTerminalEmulation.Create(False);
end;

// --------------------------------------------------------------------------------
finalization
begin
    TerminalEmulation.Terminate;
    TerminalEmulation.Free;
end;

// --------------------------------------------------------------------------------
end.
Das ganze läuft auch unter Linux richtig gut. Das Terminal kompiliert und läuft auch unter Windows (7) sehr Rund. Nur beim Beenden bekomme ich unter Windows einen Heap Fehler.
Mit dem Debugger konnte ich sehen das dieses nach oder beim Ausführen des 'TerminalEmulation.Free;' im finalization Abschnitt der Unit auftritt.
Hat von euch jemand dafür eine Lösung parat?

Grüße
HobbyProgrammer
Dateianhänge
Screenshot_20201024_135333.jpeg
Screenshot_20201024_135333.jpeg (69.99 KiB) 1348 mal betrachtet
Host: Core i7-12700H, NVIDIA RTX3050 6GB, 32GB Ram, 1TB NVME SSD mit KUbuntu 22.04LTS 64bit , VM KUbuntu 22.04 LTS 64bit mit Lazarus 2.2.6 und Cross-Platform Compiler für Linux 32/64bit und Windows 32/64bit. Wine für erste Tests der Windows Binarys.

Benutzeravatar
af0815
Lazarusforum e. V.
Beiträge: 6198
Registriert: So 7. Jan 2007, 10:20
OS, Lazarus, FPC: FPC fixes Lazarus fixes per fpcupdeluxe (win,linux,raspi)
CPU-Target: 32Bit (64Bit)
Wohnort: Burgenland
Kontaktdaten:

Re: Threaded Terminal Emulation

Beitrag von af0815 »

Grundlegend stellt sich die Frage, ob der Thread auf das Terminate reagieren kann, oder der vom Free ganz einfach hart getötet wird.
Blöd kann man ruhig sein, nur zu Helfen muss man sich wissen (oder nachsehen in LazInfos/LazSnippets).

Benutzeravatar
Winni
Beiträge: 1577
Registriert: Mo 2. Mär 2009, 16:45
OS, Lazarus, FPC: Laz2.2.2, fpc 3.2.2
CPU-Target: 64Bit
Wohnort: Fast Dänemark

Re: Threaded Terminal Emulation

Beitrag von Winni »

Hi!

Das seh ich genauso wie 08/15.

Versuch doch mal:

Code: Alles auswählen

procedure TForm1.FormDestroy(Sender: TObject);
begin
Repeat
application.processMessages;
until TerminalEmulation.finished;
end;
Keine Ahnung, aber vielleicht hilft es.

Winni

Benutzeravatar
Winni
Beiträge: 1577
Registriert: Mo 2. Mär 2009, 16:45
OS, Lazarus, FPC: Laz2.2.2, fpc 3.2.2
CPU-Target: 64Bit
Wohnort: Fast Dänemark

Re: Threaded Terminal Emulation

Beitrag von Winni »

Hi!

Hab gerade noch mal in TThread geguckt.

Es geht auch einfach:

Code: Alles auswählen

procedure TThread.Terminate;
Das sollte man vor Form.close mal aufrufen.

Winni

Benutzeravatar
af0815
Lazarusforum e. V.
Beiträge: 6198
Registriert: So 7. Jan 2007, 10:20
OS, Lazarus, FPC: FPC fixes Lazarus fixes per fpcupdeluxe (win,linux,raspi)
CPU-Target: 32Bit (64Bit)
Wohnort: Burgenland
Kontaktdaten:

Re: Threaded Terminal Emulation

Beitrag von af0815 »

Winni hat geschrieben:
Sa 24. Okt 2020, 18:44
Hab gerade noch mal in TThread geguckt.

Es geht auch einfach:

Code: Alles auswählen

procedure TThread.Terminate;
Das sollte man vor Form.close mal aufrufen.

Winni
Das ist sowieso, nur muss die Execute-Loop im Thread die Möglichkeit haben, das Teminate zu empfangen und anschliessend die Loop sauber zu beenden. Wen du im Main threadf ein Treminate aufrufst und dann gleich free, dann hat der Thread keine Möglichkeit zum Reagieren.
Testen kann man das indem man mal den Thread die dopplete Zeit gibt um sich zu beenden, als man schätzt :-)
Blöd kann man ruhig sein, nur zu Helfen muss man sich wissen (oder nachsehen in LazInfos/LazSnippets).

HobbyProgrammer
Beiträge: 166
Registriert: Di 29. Okt 2019, 12:51
Wohnort: Deutschland , Baden-Württemberg

Re: Threaded Terminal Emulation

Beitrag von HobbyProgrammer »

Nach dem Tipp von af0815 habe ich nun die Lösung gefunden:

Code: Alles auswählen

// --------------------------------------------------------------------------------
constructor TTerminalEmulation.Create(CreateSuspended: boolean);
begin
    FreeOnTerminate := True;
    inherited Create(CreateSuspended);
end;
wird zu:

Code: Alles auswählen

// --------------------------------------------------------------------------------
constructor TTerminalEmulation.Create(CreateSuspended: boolean);
begin
    FreeOnTerminate := False;
    inherited Create(CreateSuspended);
end;
dann beendet:

Code: Alles auswählen

// --------------------------------------------------------------------------------
finalization
begin
    TerminalEmulation.Terminate;
    TerminalEmulation.Free;
end;
die Terminal Emulation unter Linux und unter Windows ohne Fehler. :) :D
Host: Core i7-12700H, NVIDIA RTX3050 6GB, 32GB Ram, 1TB NVME SSD mit KUbuntu 22.04LTS 64bit , VM KUbuntu 22.04 LTS 64bit mit Lazarus 2.2.6 und Cross-Platform Compiler für Linux 32/64bit und Windows 32/64bit. Wine für erste Tests der Windows Binarys.

Antworten