OnErrorGoto mit Threads
OnErrorGoto mit Threads
Hi Leute,
gibt es vielleicht eine Alternative zu OnErrorGoto (z.B. Win-Api), die Threadabhängig ist. Ich stehe grad vor dem Problem, dass OnErrorGoto sozusagen global definiert wird, d.h. jeder Thread springt dann bei einem Fehler zu dieser Sprungmarke. Ich möchte aber, dass jeder Thread anders mit einem Fehler umgeht.
Danke schonmal
lg kevin
gibt es vielleicht eine Alternative zu OnErrorGoto (z.B. Win-Api), die Threadabhängig ist. Ich stehe grad vor dem Problem, dass OnErrorGoto sozusagen global definiert wird, d.h. jeder Thread springt dann bei einem Fehler zu dieser Sprungmarke. Ich möchte aber, dass jeder Thread anders mit einem Fehler umgeht.
Danke schonmal
lg kevin
http://www.jasik.de - Windows Hilfe Seite
padawan hat geschrieben:Ich liebe diese von hinten über die Brust ins Auge Lösungen
Re: OnErrorGoto mit Threads
Vielleicht geht es mit OnErrorCall(), ungefähr so:
Ist nur 'ne Idee.
Grüße, Nino
Code: Alles auswählen
Procedure ErrorHandler_1()
;...
EndProcedure
Procedure ErrorHandler_2()
;...
EndProcedure
Threaded *ErrHandlerAddress
; -- Thread 1:
*ErrHandlerAddress = @ErrorHandler_1()
OnErrorCall(*ErrHandlerAddress)
; -- Thread 2:
*ErrHandlerAddress = @ErrorHandler_2()
OnErrorCall(*ErrHandlerAddress)
Grüße, Nino
Re: OnErrorGoto mit Threads
Mit OnErrorCall() ist es das gleiche, wie mit OnErrorGoto().
Der zweite Aufruf überscheibt den ersten. Ist ganz egal, ob die Variable, die als Parameter übergeben wird, 'Threaded' ist.
aber trotzdem danke
lg kevin
Der zweite Aufruf überscheibt den ersten. Ist ganz egal, ob die Variable, die als Parameter übergeben wird, 'Threaded' ist.
aber trotzdem danke
lg kevin
http://www.jasik.de - Windows Hilfe Seite
padawan hat geschrieben:Ich liebe diese von hinten über die Brust ins Auge Lösungen
Re: OnErrorGoto mit Threads
Oder vielleicht ungefähr so? Hier ist das Label für OnErrorGoto immer das selbe, aber welche Prozedur nach dem Sprung zum Label aufgerufen wird, legt jeder Thread separat fest:
Grüße, Nino
Code: Alles auswählen
OnErrorGoto(?ErrorLabel)
Procedure ErrorHandler_1()
;...
EndProcedure
Procedure ErrorHandler_1()
;...
EndProcedure
Prototype ErrProcedure()
Threaded ErrorHandler.ErrProcedure
;-- Thread 1:
ErrorHandler = @ErrorHandler_1()
;-- Thread 2:
ErrorHandler = @ErrorHandler_2()
End
ErrorLabel:
ErrorHandler()
Re: OnErrorGoto mit Threads
Ja das hört sich schon ganz gut an, werds mal versuchen.
Das heißt aber nicht, dass ich mich nicht auf andere Ideen freuen würde
lg kevin
Das heißt aber nicht, dass ich mich nicht auf andere Ideen freuen würde
lg kevin
http://www.jasik.de - Windows Hilfe Seite
padawan hat geschrieben:Ich liebe diese von hinten über die Brust ins Auge Lösungen
Re: OnErrorGoto mit Threads
Das hat mich doch etwas mehr interessiert.
Meine zweite Idee funktioniert anscheinend, allerdings nicht mit ener Threaded Variablen, sondern mit Global:
Das lässt sich auch z.B. mit Nummerierung der Threads und Select / Case machen:
Grüße, Nino
Meine zweite Idee funktioniert anscheinend, allerdings nicht mit ener Threaded Variablen, sondern mit Global:
Code: Alles auswählen
DisableDebugger
OnErrorGoto(?ErrorLabel)
EnableExplicit
Global Message$
Prototype ErrProcedure()
Global ErrorHandler.ErrProcedure
Procedure ErrorHandler_1()
MessageRequester("ErrorHandler 1", Message$)
EndProcedure
Procedure ErrorHandler_2()
MessageRequester("ErrorHandler 2", Message$)
EndProcedure
Procedure MyThread_1(dummy)
Protected x, y
ErrorHandler = @ErrorHandler_1()
Repeat
x = Random(10000)
If x = 0
Message$ = "Fehler in Thread 1"
EndIf
y = 1 / x ; error when x = 0
ForEver
EndProcedure
Procedure MyThread_2(dummy)
Protected x, y
ErrorHandler = @ErrorHandler_2()
Repeat
x = Random(10000)
If x = 0
Message$ = "Fehler in Thread 2"
EndIf
y = 1 / x ; error when x = 0
ForEver
EndProcedure
CreateThread(@MyThread_1(), 0)
CreateThread(@MyThread_2(), 0)
Repeat
ForEver
End
ErrorLabel:
ErrorHandler()
Das lässt sich auch z.B. mit Nummerierung der Threads und Select / Case machen:
Code: Alles auswählen
DisableDebugger
OnErrorGoto(?ErrorLabel)
EnableExplicit
Global Message$, ThreadNo
Procedure MyThread_1(dummy)
Protected x, y
ThreadNo = 1
Repeat
x = Random(10000)
If x = 0
Message$ = "Fehler in Thread 1"
EndIf
y = 1 / x ; error when x = 0
ForEver
EndProcedure
Procedure MyThread_2(dummy)
Protected x, y
ThreadNo = 2
Repeat
x = Random(10000)
If x = 0
Message$ = "Fehler in Thread 2"
EndIf
y = 1 / x ; error when x = 0
ForEver
EndProcedure
CreateThread(@MyThread_1(), 0)
CreateThread(@MyThread_2(), 0)
Repeat
ForEver
End
ErrorLabel:
Select ThreadNo
Case 1
MessageRequester("ErrorHandler 1", Message$)
Case 2
MessageRequester("ErrorHandler 2", Message$)
Default
MessageRequester("Uups??", Message$)
EndSelect
Grüße, Nino
Re: OnErrorGoto mit Threads
Ich hab mir das grad mal angeguckt, und dacht, das kann doch nicht funktionieren, da du die Variable 'ErrorHandler' ja zweimal belegst. Die erste Belegung muss doch weg sein.
Jetzt hab ich des Rätsels Lösung: Der Fehler im ersten Thread passiert so schnell, dass der zweite Thread noch gar nicht gestartet ist. Wenn du bei beiden Random-Befehlen zwei Nullen drantuhst (d.h. es dauert kurz, bis der Fehler auftritt), passiert das, was ich dachte. Es wird zweimal der gleiche ErrorHandler aufgerufen. Also keine Lösung für mein Problem, aber nochmals danke
lg kevin
Jetzt hab ich des Rätsels Lösung: Der Fehler im ersten Thread passiert so schnell, dass der zweite Thread noch gar nicht gestartet ist. Wenn du bei beiden Random-Befehlen zwei Nullen drantuhst (d.h. es dauert kurz, bis der Fehler auftritt), passiert das, was ich dachte. Es wird zweimal der gleiche ErrorHandler aufgerufen. Also keine Lösung für mein Problem, aber nochmals danke
lg kevin
http://www.jasik.de - Windows Hilfe Seite
padawan hat geschrieben:Ich liebe diese von hinten über die Brust ins Auge Lösungen
Re: OnErrorGoto mit Threads
Na ja, das war so gedacht, dass die Variable 'ErrorHandler' im ersten Beispiel meines vorigen Postings -- bzw. die Variable 'ThreadNo' im zweiten Beispiel -- dauernd vom gerade aktiven Thread neu gesetzt wird (die Threads laufen ja nicht wirklich parallel, sondern immer kurz nacheinander). Ich habe aber den Fehler gemacht, den Variablen nur am Anfang jedes Threads einen Wert zuzuweisen.CSHW89 hat geschrieben:Ich hab mir das grad mal angeguckt, und dacht, das kann doch nicht funktionieren, da du die Variable 'ErrorHandler' ja zweimal belegst. Die erste Belegung muss doch weg sein.
Unten ist eine überarbeitete Fassung meines zweiten Beispiels von oben:CSHW89 hat geschrieben:Jetzt hab ich des Rätsels Lösung: Der Fehler im ersten Thread passiert so schnell, dass der zweite Thread noch gar nicht gestartet ist. Wenn du bei beiden Random-Befehlen zwei Nullen drantuhst (d.h. es dauert kurz, bis der Fehler auftritt), passiert das, was ich dachte. Es wird zweimal der gleiche ErrorHandler aufgerufen.
Ich habe jetzt noch in jeden Thread ein Delay() eingefügt, so dass das Verhalten deutlicher wird. Mal tritt der Fehler zuerst im 1. Thread auf, mal zuerst im 2. Thread. Die globale Variable 'ThreadNo' wird nun ständig neu gesetzt, möglichst kurz vor dem Fehler. Das scheint nun soweit zu funktionieren. Vielleicht geht es nicht, wenn in mehreren Threads sehr kurz nacheinander Fehler auftreten, ich weiß es nicht.
Außerem ist das Beispiel natürlich etwas praxisfremd, weil die Variable 'ThreadNo' jeweils kurz vor dem Fehler aktualisiert wird. In der Praxis weiß man ja nicht vorher, wann ein Fehler auftritt. Aber vielleicht eignet sich das immerhin, um kritische Stellen zu prüfen, an denen man einen möglichen Fehler vermutet? Etwas besseres fällt mir außerdem leider nicht ein. Das beste wäre wohl, wenn eine Unterstützung für soetwas in PB eingebaut wäre.
Code: Alles auswählen
DisableDebugger
OnErrorGoto(?ErrorLabel)
EnableExplicit
Global Message$, ThreadNo
Procedure MyThread_1(dummy)
Protected x, y
Delay(Random(2000))
Repeat
x = Random(10000)
If x = 0
ThreadNo = 1
Message$ = "Fehler in Thread 1"
EndIf
y = 1 / x ; error for x = 0
ForEver
EndProcedure
Procedure MyThread_2(dummy)
Protected x, y
Delay(Random(2000))
Repeat
x = Random(10000)
If x = 0
ThreadNo = 2
Message$ = "Fehler in Thread 2"
EndIf
y = 1 / x ; error for x = 0
ForEver
EndProcedure
CreateThread(@MyThread_1(), 0)
CreateThread(@MyThread_2(), 0)
Repeat
ForEver
End
ErrorLabel:
Select ThreadNo
Case 1
MessageRequester("ErrorHandler 1", Message$)
Case 2
MessageRequester("ErrorHandler 2", Message$)
Default
MessageRequester("Uups??", Message$)
EndSelect
- juergenkulow
- Beiträge: 188
- Registriert: 22.12.2016 12:49
- Wohnort: :D_üsseldorf-Wersten
Re: OnErrorGoto mit Threads
Hallo CSHW89,
ich habe Dein Programm etwas verändert, etwas mehr verändert. Jeder Thread hat einen eigenen Stack. Register rsp zeigt darauf. Die Nummer des Threads läßt sich damit herausfinden. Jetzt noch die Adresse der Fehlerbehandlung im Thread speichern und mit JMP rax am Ende der allgemeien Fehlerbehandlung an die richtige Stelle im Thread springen. Die Fehlermeldungen werden in Fehler.txt im Dokumentenverzeichnis gespeichert und ausgegeben.
...
Verbesserungsvorschläge mit Quellcode sind willkommen.
ich habe Dein Programm etwas verändert, etwas mehr verändert. Jeder Thread hat einen eigenen Stack. Register rsp zeigt darauf. Die Nummer des Threads läßt sich damit herausfinden. Jetzt noch die Adresse der Fehlerbehandlung im Thread speichern und mit JMP rax am Ende der allgemeien Fehlerbehandlung an die richtige Stelle im Thread springen. Die Fehlermeldungen werden in Fehler.txt im Dokumentenverzeichnis gespeichert und ausgegeben.
...
Verbesserungsvorschläge mit Quellcode sind willkommen.
Code: Alles auswählen
; Fehlerbehandlung bei Threads mit OnErrorGoto für mehrere Ausgabearten
; offen #DesktopOpenGL
; bleibt offen x86-ASM, MacOS Test, Linux Test, andere Stackeinstellungen
; Bemerkung FehlerText-Ausgabe in EXE kleiner als in der IDE bei openscreen
; Sind CPU-Uhrzeit oder andere Infos sinnvoll?
; Programm sollte nur einmal gleichzeitg laufen, wegen createFile Fehler.txt beim Start.
EnableExplicit
CompilerIf 1=#PB_Compiler_Debugger
CompilerWarning "Bitte ohne Debugger kompilieren oder als EXE erstellen."
CompilerEndIf
CompilerIf 0=#PB_Compiler_Thread
CompilerError "Bitte Compiler auf threadsicher stellen."
CompilerEndIf
CompilerIf 0=#PB_Compiler_LineNumbering
CompilerError "Bitte On-Error-Unterstüzung einschalten."
CompilerEndIf
CompilerIf #PB_Processor_x64<>#PB_Compiler_Processor
CompilerError "Source Code enthält x64-Register ASM-Befehle."
CompilerEndIf
;Macro TestMessageRequester(Titel,Text) : MessageRequester(Titel,Text) : EndMacro
Macro TestMessageRequester(Titel,Text) : EndMacro
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
#NeueZeile=#CRLF$
CompilerCase #PB_OS_MacOS
#NeueZeile=#CR$
CompilerCase #PB_OS_Linux
#NeueZeile=#LF$
CompilerDefault
#NeueZeile=#LF$
CompilerEndSelect
Structure ThreadTyp
Nummer.i
ID.i
rsp.i
Status.i
rip.i
EndStructure
Structure MyThread_1Typ
*ThreadInfo.ThreadTyp ; Pointer auf Element in Threadlist()
inWert.q
outWert.q
EndStructure
Structure MyThread_2Typ
*ThreadInfo.ThreadTyp
EndStructure
Structure NachrichtTyp
s.s
EndStructure
Enumeration ThreadStatus : #ThreadNull : #ThreadStart : #Threadbeenden: #ThreadEnde : EndEnumeration
Enumeration EnumDesktopStatus: #DesktopOhne : #DesktopWindow : #DesktopOpenScreen : #DesktopWindowScreen
#DesktopORGEWindowed : #DesktopORGEOpenScreen : #DesktopConsole :#DesktopConsoleGrafik : #DesktopOpenGL : EndEnumeration
;#DesktopStatus=#DesktopWindowScreen
;#DesktopStatus=#DesktopOpenScreen
;#DesktopStatus=#DesktopWindow
;#DesktopStatus=#DesktopORGEWindowed
#DesktopStatus=#DesktopORGEOpenScreen
;#DesktopStatus=#DesktopOhne
;#DesktopStatus=#DesktopOpenGL
;#DesktopStatus=#DesktopConsole
;#DesktopStatus=#DesktopConsoleGrafik
CompilerIf (#DesktopStatus=#DesktopOpenScreen Or #DesktopStatus=#DesktopORGEOpenScreen) And
1=#PB_Compiler_Debugger
CompilerError "OpenScreen läuft nicht im Debugger-Modus." ; Warum?
CompilerEndIf
Macro MyMessageRequester(Titel,Text)
; ggf Übersetzung von Titel und Text in andere Sprache
CompilerIf #DesktopStatus=#DesktopOpenScreen
NeuerDrawText(0,0,Titel+":"+Text, FontID(CourierNew14))
CompilerElseIf #DesktopStatus=#DesktopORGEOpenScreen Or #DesktopStatus=#DesktopORGEWindowed
Message$=Titel+":"+Text
CompilerElse
MessageRequester(Titel,Text)
If "FATAL"=UCase(Titel)
End
EndIf
CompilerEndIf
EndMacro
Structure NDTTyp
AlteNachricht.s
Sprite.i
EndStructure
Declare MyThread_1(*ptr.MyThread_1Typ)
Declare MyThread_2(*ptr.MyThread_2Typ)
Declare MyMessageThread(*p.NachrichtTyp)
Declare.i NeuerDrawText(x,y,Text$,Font)
Declare.i NeuerDrawText3(x,y,Text$,Font,*p.NDTTyp)
Declare PrintMehrzeilig(x.i,y.i,Text.s)
CompilerIf #PB_Compiler_Processor=#PB_Processor_x64
Structure RegTyp : xmm0.d : xmm1.d : xmm2.d : xmm3.d :EndStructure
Declare lesexmm(*p.RegTyp)
CompilerEndIf
Global NewList ThreadList.ThreadTyp()
Global Message$="", ThreadNo
Define rsp_reg.q
Define MyThread_1Daten.MyThread_1Typ
Define MyThread_2Daten.MyThread_2Typ
Define NDT.NDTTyp
Procedure Test(a.d,b.d,c.d,d.d) :EndProcedure
ElapsedMilliseconds()
Global Mutex = CreateMutex()
Define Fehlerdatei.s=GetUserDirectory(#PB_Directory_Documents)+"Fehler.txt"
If FileSize(Fehlerdatei)>0 ; Lösche Fehlerdatei wenn vorhanden.
If 0=DeleteFile(Fehlerdatei,#PB_FileSystem_Force)
MessageRequester("Info","Konnte Fehler.txt Datei nicht löschen.")
EndIf
EndIf
AddElement(ThreadList())
ThreadList()\ID=0 ; Hauptprogramm
EnableASM : MOV rsp_reg,rsp : DisableASM
ThreadList()\rsp=rsp_reg
ThreadList()\rip=?Fehlerbehandlung_Hauptschleife
CompilerIf 0=#PB_Compiler_Debugger
OnErrorGoto(?ErrorLabel)
CompilerEndIf
CompilerSelect #DesktopStatus
CompilerCase #DesktopOpenScreen
InitKeyboard() ; ohne gibt es eine Endlos-Fehlerschleife 59x pro Sekunde
InitSprite()
ExamineDesktops()
OpenScreen(DesktopWidth(0),DesktopHeight(0),DesktopDepth(0),"") ;Strg+Alt+Entf für MSG erforderlich
Define CourierNew14=LoadFont(#PB_Any,"Courier New", 14)
CompilerCase #DesktopWindowScreen
InitKeyboard()
InitSprite()
ExamineDesktops()
OpenScreen(DesktopWidth(0),DesktopHeight(0),DesktopDepth(0),"")
CloseScreen(); Trick, damit Pixelzugriff stimmt.
Define screens=ExamineDesktops()
If screens>1
Define s.s=InputRequester("Welcher Bildschirm","Welcher Bildschirm? ",Str(screens))
Define b=Val(s)-1
Else
b=0
EndIf
Define Fenster=OpenWindow(#PB_Any,DesktopX(b),DesktopY(b),DesktopWidth(b),DesktopHeight(b),"",#PB_Window_BorderLess)
OpenWindowedScreen(WindowID(Fenster),DesktopX(b),DesktopY(b),DesktopWidth(b),DesktopHeight(b))
CompilerCase #DesktopWindow
Define screens=ExamineDesktops()
If screens>1
Define s.s=InputRequester("Welcher Bildschirm","Welcher Bildschirm? ",Str(screens))
Define b=Val(s)-1
Else
b=0
EndIf
Define Fenster=OpenWindow(#PB_Any,DesktopX(b),DesktopY(b),DesktopWidth(b),DesktopHeight(b),"",#PB_Window_BorderLess)
CompilerCase #DesktopORGEWindowed
If 0=InitEngine3D() : MessageRequester("Fatal","InitEngine3D gescheitert.") : End : EndIf
InitSprite()
InitKeyboard()
InitMouse()
Define CourierNew14=LoadFont(#PB_Any,"Courier New", 14)
ExamineDesktops()
OpenScreen(DesktopWidth(0),DesktopHeight(0),DesktopDepth(0),"")
CloseScreen(); Trick, damit Pixelzugriff stimmt. Stört SetMeshData.
Define screens=ExamineDesktops()
If screens>1
Define s.s=InputRequester("Welcher Bildschirm","Welcher Bildschirm? ",Str(screens))
Define b=Val(s)-1
Else
b=0
EndIf
Define Fenster=OpenWindow(#PB_Any,DesktopX(b),DesktopY(b),DesktopWidth(b),DesktopHeight(b),"ORGE OpenWindowedScreen",#PB_Window_BorderLess)
OpenWindowedScreen(WindowID(Fenster),DesktopX(b),DesktopY(b),DesktopWidth(b),DesktopHeight(b))
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures" , #PB_3DArchive_FileSystem)
CreateMaterial(0, LoadTexture(0, "MRAMOR6X6.jpg"))
CreatePlane(0, 300, 300, 10, 10, 1, 1)
CreateEntity(0, MeshID(0), MaterialID(0), 0, 0, 0)
CreateCamera(0, 0, 0, 100, 100)
MoveCamera(0, 10, 150, 300, #PB_Absolute)
CameraLookAt(0, 0, 0, 0)
CompilerCase #DesktopORGEOpenScreen
If 0=InitEngine3D() : MessageRequester("Fatal","InitEngine3D gescheitert.") : End : EndIf
InitSprite()
InitKeyboard()
InitMouse()
Define CourierNew14=LoadFont(#PB_Any,"Courier New", 14)
ExamineDesktops()
OpenScreen(DesktopWidth(0),DesktopHeight(0),DesktopDepth(0),"ORGE OpenScreen")
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures" , #PB_3DArchive_FileSystem)
CreateMaterial(0, LoadTexture(0, "MRAMOR6X6.jpg"))
CreatePlane(0, 300, 300, 10, 10, 1, 1)
CreateEntity(0, MeshID(0), MaterialID(0), 0, 0, 0)
CreateCamera(0, 0, 0, 100, 100)
MoveCamera(0, 10, 150, 300, #PB_Absolute)
CameraLookAt(0, 0, 0, 0)
MyMessageRequester("Info","Das Programm ist gestarted.")
CompilerCase #DesktopOpenGL
CompilerCase #DesktopConsole
If 0=OpenConsole() : MessageRequester("FATAL","Konnte Console nicht öffnen.") : End : EndIf
CompilerCase #DesktopConsoleGrafik
If 0=OpenConsole() : MessageRequester("FATAL","Konnte Console nicht öffnen.") : End : EndIf
EnableGraphicalConsole(1)
CompilerEndSelect
TestMessageRequester("Hauptprogramm","Stack rsp:"+Hex(ThreadList()\rsp))
AddElement(ThreadList())
MyThread_1Daten\ThreadInfo=@ThreadList()
MyThread_1Daten\inWert=10000
MyThread_1Daten\outWert=99
ThreadList()\ID=CreateThread(@MyThread_1(), @MyThread_1Daten)
ThreadList()\Nummer=1
AddElement(ThreadList())
MyThread_2Daten\ThreadInfo=@ThreadList()
ThreadList()\ID=CreateThread(@MyThread_2(), @MyThread_2Daten)
ThreadList()\Nummer=2
Fehlerbehandlung_Hauptschleife:
CompilerSelect #DesktopStatus
CompilerCase #DesktopOhne
Repeat ; Hauptschleife
Delay(5000)
If Random(1) : PokeS(10,"Speicher-Fehler") :EndIf
Until #PB_MessageRequester_No=MessageRequester("IDEL","Bin noch da - Weiter?",#PB_MessageRequester_YesNo)
CompilerCase #DesktopOpenScreen
Define i=0
Repeat
If Message$<>""
Delay(1) ; Wenn Nachricht noch geschrieben wird.
NeuerDrawText(100,100,Message$, FontID(CourierNew14))
Message$=""
EndIf
ExamineKeyboard()
FlipBuffers()
Test(47.11,42.42,14.14,22.8)
If i=300: i=0 : PokeS(10,"Speicher-Fehler") : EndIf ; Kommandozeilen Version PB Direktausführung PureBasic.exe dreht Schleife, aber seperater Aufruf geht.
i+1
Until KeyboardPushed(#PB_Key_Escape) Or
(KeyboardPushed(#PB_Key_F4) And KeyboardPushed( #PB_Key_LeftAlt)) Or
(KeyboardPushed(#PB_Key_Tab ) And KeyboardPushed( #PB_Key_LeftAlt))
MyMessageRequester("Info","Das Programm wird jetzt beendet.")
Delay(2000)
CompilerCase #DesktopWindowScreen
Repeat
Repeat
Define Event = WindowEvent()
Until Event = 0
ExamineKeyboard()
FlipBuffers()
If 0=Random(5*59) : PokeS(10,"Speicher-Fehler") :EndIf
Until KeyboardPushed(#PB_Key_Escape) Or
(KeyboardPushed(#PB_Key_F4) And KeyboardPushed( #PB_Key_LeftAlt))
CompilerCase #DesktopWindow
Define fertig=#False
Repeat
Repeat
Define Event=WindowEvent()
Select Event
Case #PB_Event_CloseWindow : fertig=#True
MyMessageRequester("Info","Das Programm wird jetzt beendet")
EndSelect
Until Event=0
If 0=Random(5*59) : PokeS(10,"Speicher-Fehler") :EndIf
Delay(16)
Until fertig=#True
CompilerCase #DesktopORGEWindowed
Define fertig=#False
Repeat ; Hauptschleife
Repeat
Define Event=WindowEvent()
Select Event
Case #PB_Event_CloseWindow : fertig=#True
MyMessageRequester("Info","Das Programm wird jetzt beendet")
EndSelect
Until Event=0
ExamineKeyboard()
RotateCamera(0,0,0,1, #PB_Relative)
RenderWorld()
If Message$<>""
NeuerDrawText3(0,0,Message$, FontID(CourierNew14),@NDT)
EndIf
FlipBuffers()
If 0=Random(5*59) : PokeS(10,"Speicher-Fehler") :EndIf
Until KeyboardPushed(#PB_Key_Escape) Or
(KeyboardPushed(#PB_Key_F4) And KeyboardPushed( #PB_Key_LeftAlt)) Or
fertig=#True
Delay(2000)
; Lizenz der OGRE 3D Engine OGRE (www.ogre3d.org) is made available under the MIT License. Copyright (c) 2000-2009 Torus Knot Software Ltd Permission is hereby granted, free of charge, To any person obtaining a copy of this software And associated documentation files (the "Software"), To deal in the Software without restriction, including without limitation the rights To use, copy, modify, merge, publish, distribute, sublicense, And/Or sell copies of the Software, And To permit persons To whom the Software is furnished To do so, subject To the following conditions:The above copyright notice And this permission notice shall be included in all copies Or substantial portions of the Software.THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS Or IMPLIED, INCLUDING BUT Not LIMITED To THE WARRANTIES OF MERCHANTABILITY, FITNESS For A PARTICULAR PURPOSE And NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS Or COPYRIGHT HOLDERS BE LIABLE For ANY CLAIM, DAMAGES Or OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT Or OTHERWISE, ARISING FROM, OUT OF Or IN CONNECTION With THE SOFTWARE Or THE USE Or OTHER DEALINGS IN THE SOFTWARE.
CompilerCase #DesktopORGEOpenScreen
Repeat ; Hauptschleife
ExamineKeyboard()
RotateCamera(0,0,0,1, #PB_Relative)
RenderWorld()
If Message$<>""
NeuerDrawText3(0,0,Message$, FontID(CourierNew14),@NDT)
EndIf
FlipBuffers()
If 0=Random(5*59) : PokeS(10,"Speicher-Fehler") :EndIf
Until KeyboardPushed(#PB_Key_Escape) Or
(KeyboardPushed(#PB_Key_F4) And KeyboardPushed( #PB_Key_LeftAlt))
CompilerCase #DesktopOpenGL
CompilerCase #DesktopConsole
Define i=0
Repeat
Define KeyPressed$ = Inkey()
If i=3000 : PokeS(10,"Speicher-Fehler") : EndIf
i+1
Delay(1)
Until KeyPressed$ = Chr(27) ; Wartet, bis Escape gedrückt wird
CompilerCase #DesktopConsoleGrafik
Define i=0
Repeat
Define KeyPressed$ = Inkey()
If i=3000 : PokeS(10,"Speicher-Fehler") : EndIf
i+1
Delay(1)
Until KeyPressed$ = Chr(27) ; Wartet, bis Escape gedrückt wird
CompilerEndSelect
CompilerIf #DesktopStatus=#DesktopOpenScreen Or #DesktopStatus=#DesktopWindowScreen Or #DesktopStatus=#DesktopORGEWindowed
CloseScreen()
CompilerEndIf
TestMessageRequester("END","END")
End
ErrorLabel: ; Fehlerbehandlung auch für alle Threads. - Verhalten bei 2 Fehlern gleichzeitig?
EnableASM : MOV rsp_reg,rsp : DisableASM
CompilerIf #PB_Processor_x64=#PB_Compiler_Processor
Define Reg.RegTyp
lesexmm(@Reg)
CompilerEndIf
LockMutex(Mutex)
Message$ = "Ein Fehler im Programm "+ ErrorFile()+" ist aufgetreten:" + #NeueZeile
Message$ + "Fehlermeldung: " + ErrorMessage() + #NeueZeile
Message$ + "Fehlernummer: " + Hex(ErrorCode(),#PB_Long) + #NeueZeile
Message$ + "Fehleradresse: " + Hex(ErrorAddress()) + #NeueZeile
If ErrorCode() = #PB_OnError_InvalidMemory
Message$ + "Zieladresse: " + Hex(ErrorTargetAddress()) + #NeueZeile
EndIf
If ErrorLine() = -1
Message$ + "Keine Quellcode Zeilennummern vorhanden." + #NeueZeile
Else
Message$ + "Quellcodezeile: " + Str(ErrorLine()) + #NeueZeile
Message$ + "Quellcodedatei: " + ErrorFile() + #NeueZeile
EndIf
Message$ + "um: "+ FormatDate("%hh:%ii:%ss am: %dd.%mm.%yyyy", Date())+" "+
Str(ElapsedMilliseconds())+" ms"+#NeueZeile
Message$ + #NeueZeile
Message$ + "Registerinhalt:" + #NeueZeile
CompilerSelect #PB_Compiler_Processor
CompilerCase #PB_Processor_x86
Message$ + "EAX = " + Hex(ErrorRegister(#PB_OnError_EAX)) + #NeueZeile
Message$ + "EBX = " + Hex(ErrorRegister(#PB_OnError_EBX)) + #NeueZeile
Message$ + "ECX = " + Hex(ErrorRegister(#PB_OnError_ECX)) + #NeueZeile
Message$ + "EDX = " + Hex(ErrorRegister(#PB_OnError_EDX)) + #NeueZeile
Message$ + "EBP = " + Hex(ErrorRegister(#PB_OnError_EBP)) + #NeueZeile
Message$ + "ESI = " + Hex(ErrorRegister(#PB_OnError_ESI)) + #NeueZeile
Message$ + "EDI = " + Hex(ErrorRegister(#PB_OnError_EDI)) + #NeueZeile
Message$ + "ESP = " + Hex(ErrorRegister(#PB_OnError_ESP)) + #NeueZeile
CompilerCase #PB_Processor_x64
Message$ + "rsp = " + RSet(Hex(ErrorRegister(#PB_OnError_RSP)),16,"0") + Space(1)
Message$ + "rax = " + RSet(Hex(ErrorRegister(#PB_OnError_RAX)),16,"0") + #NeueZeile
Message$ + "rbx = " + RSet(Hex(ErrorRegister(#PB_OnError_RBX)),16,"0") + Space(1)
Message$ + "rcx = " + RSet(Hex(ErrorRegister(#PB_OnError_RCX)),16,"0") + #NeueZeile
Message$ + "rdx = " + RSet(Hex(ErrorRegister(#PB_OnError_RDX)),16,"0") + Space(1)
Message$ + "rbp = " + RSet(Hex(ErrorRegister(#PB_OnError_RBP)),16,"0") + #NeueZeile
Message$ + "rsi = " + RSet(Hex(ErrorRegister(#PB_OnError_RSI)),16,"0") + Space(1)
Message$ + "rdi = " + RSet(Hex(ErrorRegister(#PB_OnError_RDI)),16,"0") + #NeueZeile
Message$ + "r8 = " + RSet(Hex(ErrorRegister(#PB_OnError_R8 )),16,"0") + Space(1)
Message$ + "r9 = " + RSet(Hex(ErrorRegister(#PB_OnError_R9 )),16,"0") + #NeueZeile
Message$ + "r10 = " + RSet(Hex(ErrorRegister(#PB_OnError_R10)),16,"0") + Space(1)
Message$ + "r11 = " + RSet(Hex(ErrorRegister(#PB_OnError_R11)),16,"0") + #NeueZeile
Message$ + "r12 = " + RSet(Hex(ErrorRegister(#PB_OnError_R12)),16,"0") + Space(1)
Message$ + "r13 = " + RSet(Hex(ErrorRegister(#PB_OnError_R13)),16,"0") + #NeueZeile
Message$ + "r14 = " + RSet(Hex(ErrorRegister(#PB_OnError_R14)),16,"0") + Space(1)
Message$ + "r15 = " + RSet(Hex(ErrorRegister(#PB_OnError_R15)),16,"0") + #NeueZeile
Message$ + "xmm0:"+StrD(Reg\xmm0)+" xmm1:"+StrD(Reg\xmm1)+" xmm2:"+StrD(Reg\xmm2)+" xmm3:"+StrD(Reg\xmm3)+#NeueZeile
CompilerCase #PB_Processor_PowerPC
Message$ + "r0 = " + Hex(ErrorRegister(#PB_OnError_r0)) + #NeueZeile
Message$ + "r1 = " + Hex(ErrorRegister(#PB_OnError_r1)) + #NeueZeile
Message$ + "r2 = " + Hex(ErrorRegister(#PB_OnError_r2)) + #NeueZeile
Message$ + "r3 = " + Hex(ErrorRegister(#PB_OnError_r3)) + #NeueZeile
Message$ + "r4 = " + Hex(ErrorRegister(#PB_OnError_r4)) + #NeueZeile
Message$ + "r5 = " + Hex(ErrorRegister(#PB_OnError_r5)) + #NeueZeile
Message$ + "r6 = " + Hex(ErrorRegister(#PB_OnError_r6)) + #NeueZeile
Message$ + "r7 = " + Hex(ErrorRegister(#PB_OnError_r7)) + #NeueZeile
Message$ + "r8-r31 Register übersprungen." + #NeueZeile
CompilerEndSelect
ForEach ThreadList()
If ThreadList()\rsp-rsp_reg>=0 And ThreadList()\rsp-rsp_reg<$100000 And
ThreadList()\Status<>#ThreadEnde ; default Stackgröße
ThreadNo=ThreadList()\Nummer
EndIf
; Message$+Str(ThreadList()\ID)+" "+Hex(ThreadList()\rsp)+" "+Hex(ThreadList()\rsp-rsp_reg)+##NeueZeile
Next
Message$="Fehler im Thread:"+ThreadNo+#NeueZeile+Message$
SelectElement(ThreadList(),ThreadNo)
Define Nachricht.NachrichtTyp\s=Message$
rsp_reg=ThreadList()\rsp
EnableASM : MOV rsp,rsp_reg : DisableASM ; Setze Stack auf Anfangswert.
Define Datei=OpenFile(#PB_Any,Fehlerdatei,#PB_File_NoBuffering|#PB_File_Append)
WriteStringN(Datei,Message$,#PB_UTF8)
CloseFile(Datei)
CompilerIf #DesktopStatus=#DesktopOhne Or #DesktopStatus=#DesktopWindow Or #DesktopStatus=#DesktopWindowScreen
If 0=CreateThread(@MyMessageThread(),@Nachricht)
End ; Thread mit Fehler-Meldung konnte nicht gestarted werden. Abbruch - Fehler-Schleife.
EndIf
CompilerElseIf #DesktopStatus=#DesktopConsole
Print(Message$)
CompilerElseIf #DesktopStatus=#DesktopConsoleGrafik
PrintMehrzeilig(0,0,Message$)
CompilerEndIf ; Sonst Ausgabe erfolgt nahe der Hauptschleife
If FileSize(Fehlerdatei)>32000
End ; Wenn es zuviele Fehler gegeben hat wird das Programm beendet.
EndIf
Define rip_reg=ThreadList()\rip
UnlockMutex(Mutex)
EnableASM : MOV rax,rip_reg : JMP rax : DisableASM ; Springe zur Fehlerbehandlung
End ; Wird nicht erreicht!
Procedure Fehler(x)
Test(1.0,2.0,3.0,4.0)
ProcedureReturn 1/x ; Kann Division durch 0 auslösen.
EndProcedure
Procedure MyThread_1(*ptr.MyThread_1Typ)
Protected rsp_reg ; für Stackpointer
Protected x, y
EnableASM : MOV rsp_reg,rsp : DisableASM ; Lese Stackpointer aus.
*ptr\ThreadInfo\rsp=rsp_reg
*ptr\ThreadInfo\Status=#ThreadStart
*ptr\ThreadInfo\rip=?Fehlerbehandlung_MyThread1
Delay(Random(2000))
Repeat
x = Random(*ptr\inWert) ; 10000
y = Fehler(x) ; Fehler für x = 0
Until *ptr\ThreadInfo\Status=#Threadbeenden
Fehlerbehandlung_MyThread1:
*ptr\ThreadInfo\Status=#ThreadEnde
*ptr\outWert=y
TestMessageRequester("1","ENDE")
EndProcedure
Procedure Fehler2()
Fehler2() ; Stackoverflow
EndProcedure
Procedure MyThread_2(*ptr.MyThread_2Typ)
Protected rsp_reg
EnableASM : MOV rsp_reg,rsp : DisableASM
*ptr\ThreadInfo\rsp=rsp_reg
*ptr\ThreadInfo\Status=#ThreadStart
*ptr\ThreadInfo\rip=?Fehlerbehandlung_MyThread2
Delay(Random(2100))
Repeat
Fehler2()
Until *ptr\ThreadInfo\Status=#Threadbeenden
Fehlerbehandlung_MyThread2:
*ptr\ThreadInfo\Status=#ThreadEnde
TestMessageRequester("2","ENDE")
EndProcedure
Procedure MyMessageThread(*p.NachrichtTyp)
MessageRequester("Fehler-Nachricht",*p\s)
EndProcedure
Procedure.i NeuerDrawText(x,y,Text$,Font)
; ; Problem CreateSprite() muß im selben Thread aufgerufen werden, in dem OpenScreen() aufgerufen wurde.
Protected von=1, Laenge,i,Sprite,xmax=0,ymax=0,xWeigth=0,ylauf=0
Sprite=CreateSprite(#PB_Any,1,1)
If 0=Sprite : ProcedureReturn #False : EndIf
If 0=StartDrawing(SpriteOutput(Sprite)) : FreeSprite(Sprite) : ProcedureReturn #False : EndIf
DrawingFont(Font)
von=1
If 0<>FindString(Text$,#NeueZeile)
Laenge=FindString(Text$,#NeueZeile)-Len(#NeueZeile)+1
Else
Laenge=Len(Text$)
EndIf
Repeat
;Debug Mid(Text$,von,Laenge)
;DrawText(x,y,Mid(Text$,von,Laenge))
ymax+TextHeight("Q")
xWeigth=TextWidth(Mid(Text$,von,Laenge))
If xWeigth>xmax : xmax=xWeigth : EndIf
von+Laenge+Len(#NeueZeile)
If von<Len(Text$)
Laenge=FindString(Text$,#NeueZeile,von)
If Laenge<=0: Laenge=Len(Text$)-von+1 : Else : Laenge-von : EndIf
EndIf
Until von>=Len(Text$)
StopDrawing()
FreeSprite(Sprite)
Sprite=CreateSprite(#PB_Any,xmax,ymax)
StartDrawing(SpriteOutput(Sprite))
DrawingFont(Font)
von= 1
If 0<>FindString(Text$,#NeueZeile)
Laenge=FindString(Text$,#NeueZeile)-Len(#NeueZeile)+1
Else
Laenge=Len(Text$)
EndIf
Repeat
DrawText(0,ylauf,Mid(Text$,von,Laenge))
ylauf+TextHeight("Q")
von+Laenge+Len(#NeueZeile)
If von<Len(Text$)
Laenge=FindString(Text$,#NeueZeile,von)
If Laenge<=0: Laenge=Len(Text$)-von+1 : Else : Laenge-von : EndIf
EndIf
Until von>=Len(Text$)
StopDrawing()
;SaveSprite(Sprite,"D:\ErrSprite.bmp")
DisplaySprite(Sprite,x,y):FlipBuffers()
DisplaySprite(Sprite,x,y):FlipBuffers()
FreeSprite(Sprite)
ProcedureReturn #True
EndProcedure
Procedure.i NeuerDrawText3(x,y,Text$,Font,*p.NDTTyp)
Protected von=1, Laenge,i,Sprite,xmax=0,ymax=0,xWeigth=0,ylauf=0
If Text$<>*p\AlteNachricht
*p\AlteNachricht=Text$
If *p\Sprite<>0 : FreeSprite(*p\Sprite) : EndIf
Sprite=CreateSprite(#PB_Any,1,1)
If 0=Sprite : ProcedureReturn #False : EndIf
If 0=StartDrawing(SpriteOutput(Sprite)) : FreeSprite(Sprite) : ProcedureReturn #False : EndIf
DrawingFont(Font)
von=1
If 0<>FindString(Text$,#NeueZeile)
Laenge=FindString(Text$,#NeueZeile)-Len(#NeueZeile)+1
Else
Laenge=Len(Text$)
EndIf
Repeat
ymax+TextHeight("Q")
xWeigth=TextWidth(Mid(Text$,von,Laenge))
If xWeigth>xmax : xmax=xWeigth : EndIf
von+Laenge+Len(#NeueZeile)
If von<Len(Text$)
Laenge=FindString(Text$,#NeueZeile,von)
If Laenge<=0: Laenge=Len(Text$)-von+1 : Else : Laenge-von : EndIf
EndIf
Until von>=Len(Text$)
StopDrawing()
FreeSprite(Sprite)
Sprite=CreateSprite(#PB_Any,xmax,ymax)
StartDrawing(SpriteOutput(Sprite))
DrawingFont(Font)
von= 1
If 0<>FindString(Text$,#NeueZeile)
Laenge=FindString(Text$,#NeueZeile)-Len(#NeueZeile)+1
Else
Laenge=Len(Text$)
EndIf
Repeat
DrawText(0,ylauf,Mid(Text$,von,Laenge))
ylauf+TextHeight("Q")
von+Laenge+Len(#NeueZeile)
If von<Len(Text$)
Laenge=FindString(Text$,#NeueZeile,von)
If Laenge<=0: Laenge=Len(Text$)-von+1 : Else : Laenge-von : EndIf
EndIf
Until von>=Len(Text$)
StopDrawing()
;SaveSprite(Sprite,"D:\ErrSprite.bmp")
*p\Sprite=Sprite
EndIf
If 0<>*p\Sprite
DisplayTransparentSprite(*p\Sprite,x,y)
Else
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
CompilerIf #PB_Compiler_Processor=#PB_Processor_x64
Procedure lesexmm(*p.RegTyp)
Protected aa.Double,bb.Double,cc.Double,dd.Double
EnableASM
movsd aa,xmm0
movsd bb,xmm1
movsd cc,xmm2
movsd dd,xmm3
DisableASM
*p\xmm0=aa\d : *p\xmm1=bb\d : *p\xmm2=cc\d : *p\xmm3=dd\d
EndProcedure
CompilerEndIf
CompilerIf #DesktopStatus=#DesktopConsoleGrafik
Procedure PrintMehrzeilig(x.i,y.i,Text.s)
Protected Start=1, Zeilenende
Zeilenende=FindString(Text,#NeueZeile,Start)
While 0<>Zeilenende
ConsoleLocate(x,y)
y+1
Print(Mid(Text,Start,Zeilenende-Start))
Start=Zeilenende+Len(#NeueZeile)
Zeilenende=FindString(Text,#NeueZeile,Start)
Wend
ConsoleLocate(x,y)
Print(Mid(Text,Start))
EndProcedure
CompilerEndIf
Bitte stelle Deine Fragen, denn den Erkenntnisapparat einschalten entscheidet über das einzig bekannte Leben im Universum.
Jürgen Kulow Wersten :D_üsseldorf NRW D Europa Erde Sonnensystem Lokale_Flocke Lokale_Blase Orion-Arm
Milchstraße Lokale_Gruppe Virgo-Superhaufen Laniakea Sichtbares_Universum
Jürgen Kulow Wersten :D_üsseldorf NRW D Europa Erde Sonnensystem Lokale_Flocke Lokale_Blase Orion-Arm
Milchstraße Lokale_Gruppe Virgo-Superhaufen Laniakea Sichtbares_Universum