PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

OnErrorGoto mit Threads

https://www.purebasic.fr/german/viewtopic.php?t=23858

Seite 1 von 1

OnErrorGoto mit Threads

Verfasst: 12.02.2011 16:50
von CSHW89
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

Re: OnErrorGoto mit Threads

Verfasst: 12.02.2011 17:32
von Nino
Vielleicht geht es mit OnErrorCall(), ungefähr so:

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)
Ist nur 'ne Idee.

Grüße, Nino

Re: OnErrorGoto mit Threads

Verfasst: 12.02.2011 17:36
von CSHW89
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

Re: OnErrorGoto mit Threads

Verfasst: 12.02.2011 18:20
von Nino
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:

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()
Grüße, Nino

Re: OnErrorGoto mit Threads

Verfasst: 12.02.2011 18:42
von CSHW89
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

Re: OnErrorGoto mit Threads

Verfasst: 12.02.2011 19:46
von Nino
Das hat mich doch etwas mehr interessiert. :-)

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

Verfasst: 13.02.2011 01:09
von CSHW89
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

Re: OnErrorGoto mit Threads

Verfasst: 13.02.2011 17:15
von Nino
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.
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: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.
Unten ist eine überarbeitete Fassung meines zweiten Beispiels von oben:
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. :mrgreen: 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
Grüße, Nino

Re: OnErrorGoto mit Threads

Verfasst: 04.08.2018 15:49
von juergenkulow
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.

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
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de