PureBoard

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

Schleife in Prozedur: 1. Aufruf OK, 2. Aufruf endlos

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

Seite 2 von 2

Re: Schleife in Prozedur: 1. Aufruf OK, 2. Aufruf endlos

Verfasst: 30.07.2010 15:59
von helpy
Mok hat geschrieben:Das Previous kann nicht existieren, weil es im Stack nur ein Next gibt (FILO)
Das ist Definitionssache und hängt vom Blickpunkt ab! Ich selbst würde auch eher Previous nehmen.

Hier nun doch ein Beispiel ohne Next/Prev ... mit einer PureBasic List:

Code: Alles auswählen

EnableExplicit

Structure tStack
	List *Items()
EndStructure

Procedure InitStack()
	Protected *NewStack.tStack
	
	*NewStack = AllocateMemory( SizeOf(tStack) )
	If *NewStack
		InitializeStructure( *NewStack, tStack )
	EndIf
	
	ProcedureReturn *NewStack
EndProcedure

Procedure CountStack(*Stack.tStack)
	If *Stack
		ProcedureReturn ListSize( *Stack\Items() )
	Else
		ProcedureReturn #Null
	EndIf
EndProcedure

Procedure Push(*Stack.tStack, *Value)
	Protected *NewStackItem
	
	If Not *Stack : ProcedureReturn #False : EndIf
	
	With *Stack
		LastElement( \Items() )
		*NewStackItem = AddElement( \Items() )
		If *NewStackItem
			\Items() = *Value
			ProcedureReturn #True
		Else
			ProcedureReturn #False
		EndIf
	EndWith
EndProcedure

Procedure Pop(*Stack.tStack)
	Protected *LastItem
	Protected *Value
	
	If Not *Stack : ProcedureReturn #Null : EndIf
	
	With *Stack
		*LastItem       = LastElement( \Items() )
		If *LastItem
			*Value        = \Items()
			DeleteElement ( \Items() )
		Else
			*Value        = #Null
		EndIf
	EndWith
	
	ProcedureReturn *Value
EndProcedure

Procedure ClearStack(*Stack.tStack)
	Protected *Item
	
	If Not *Stack : ProcedureReturn #False : EndIf
	
	ClearList( *Stack\Items() )
	
	ProcedureReturn #True
EndProcedure

Procedure FreeStack(*Stack.tStack)
	If ClearStack( *Stack )
		ClearStructure( *Stack, tStack )
		FreeMemory( *Stack )
		ProcedureReturn #True
	Else
		ProcedureReturn #False
	EndIf
EndProcedure



Define.tStack *MyStack = InitStack()
Define.i Item1 = 5
Define.i Item2 = 20

If *MyStack
	Debug Push(*MyStack,@Item1)  ; Rückgabewert ist 1 => Aufruf OK
	Debug "---"
	Debug @Item1                 ; Zum Test die Adresse von Item1
	Debug Pop(*MyStack)          ; Rückgabewert ist eine Adresse => OK, wenn beide Adressen identisch!
	Debug "---"
	Debug CountStack(*MyStack)   ; Gibt Null zurück, da keine Elemente mehr auf dem Stack
	Debug Push(*MyStack,@Item1)  ; Item1 auf den Stack, gibt #True (1) zurück!
	Debug Push(*MyStack,@Item2)  ; Item2 auf den Stack, gibt #True (1) zurück!
	Debug CountStack(*MyStack)   ; Gibt 2 zurück ==> zwei Elemente auf dem Stack
	Debug "---"
	Debug ClearStack(*MyStack)   ; Aufruf OK, gibt #True (1) zurück!
	Debug CountStack(*MyStack)   ; Gibt 0 zurück ==> keine Elemente mehr auf dem Stack
	Debug "---"	
	Debug Push(*MyStack,@Item1)  ; Adresse von Item1 auf den Stack, gibt #True (1) zurück!
	Debug Push(*MyStack,@Item2)  ; Adresse von Item2 auf den Stack, gibt #True (1) zurück!
	Debug PeekI( pop(*MyStack) ) ; Gibt 20 zurück (Item2)
	Debug PeekI( pop(*MyStack) ) ; Gibt  5 zurück (Item1)
	Debug CountStack(*MyStack)   ; Gibt 0 zurück ==> keine Elemente mehr auf dem Stack
	Debug "---"
	
	For Item1 = 1 To 10
		Debug "Push " + Str(Item1)
		Push(*MyStack, Item1)
	Next
	While CountStack(*MyStack)
		Item1 = Pop(*MyStack)
		Debug "Pop " + Str(Item1)
	Wend
	
	FreeStack( *MyStack ) : *MyStack = #Null
Else
	Debug "Stack konnte nicht initialisiert werden"
EndIf
IsStackEmpty() ist eigentlich nicht nötig, denn mit der folgenden Zeile kann man das das ebenso abfragen:

Code: Alles auswählen

If Not CountStack(*MyStack)
  ; Stack ist leer!
EndIf
Hoffe, das hilft ein wenig weiter!
cu, guido

Re: Schleife in Prozedur: 1. Aufruf OK, 2. Aufruf endlos

Verfasst: 30.07.2010 17:41
von Mok
@helpy: An die Idee, einen Stack als Liste zu realisieren hatte ich auch schon gedacht, nur dürfte eine Structure mit Pointern speichereffizienter sein (denk ich mal). Ansonsten, danke für dein Posting, damit sind nun einige Unklarheiten beseitigt :allright:

Re: Schleife in Prozedur: 1. Aufruf OK, 2. Aufruf endlos

Verfasst: 30.07.2010 17:51
von helpy
Mok hat geschrieben:@helpy: An die Idee, einen Stack als Liste zu realisieren hatte ich auch schon gedacht, nur dürfte eine Structure mit Pointern speichereffizienter sein (denk ich mal). Ansonsten, danke für dein Posting, damit sind nun einige Unklarheiten beseitigt :allright:
Hier mit Pointer, nur mit einer zusätzlichen Struktur ;-):

Code: Alles auswählen

EnableExplicit

Structure tStack
	*TopItem.tStackItem
	Count.i
EndStructure

Structure tStackItem
	*Value
	*Prev.tStackItem
EndStructure


Procedure InitStack()
	Protected *NewStack.tStack
	*NewStack = AllocateMemory(SizeOf(tStack))
	ProcedureReturn *NewStack
EndProcedure

Procedure CountStack(*Stack.tStack)
	If *Stack
		ProcedureReturn *Stack\Count
	Else
		ProcedureReturn #Null
	EndIf
EndProcedure

Procedure Push(*Stack.tStack, *Value)
	Protected *NewStackItem.tStackItem
	
	If Not *Stack : ProcedureReturn #False : EndIf
	
	With *Stack
		*NewStackItem = AllocateMemory( SizeOf(tStackItem) )
		If *NewStackItem
			*NewStackItem\Value  = *Value
			If \Count
				*NewStackItem\Prev = \TopItem
				\TopItem           = *NewStackItem
				\Count             + 1
			Else
				\TopItem           = *NewStackItem
				\Count             = 1
			EndIf
			ProcedureReturn #True
		Else
			ProcedureReturn #False
		EndIf
	EndWith
EndProcedure

Procedure Pop(*Stack.tStack)
	Protected *item.tStackItem
	Protected *value
	
	If Not *Stack : ProcedureReturn #Null : EndIf
	
	With *Stack
		*item     = \TopItem
		*value    = *item\Value
		\TopItem  = \TopItem\Prev
		\Count    - 1
		FreeMemory( *item )
	EndWith
	
	ProcedureReturn *value
EndProcedure

Procedure ClearStack(*Stack.tStack)
	Protected *item.tStackItem
	
	If Not *Stack : ProcedureReturn #False : EndIf
	
	While *Stack\TopItem
		*item = *Stack\TopItem
		*Stack\TopItem = *item\Prev
		FreeMemory( *item )
		*Stack\Count - 1
	Wend
	
	*Stack\TopItem = #Null
	
	ProcedureReturn #True
EndProcedure

Procedure FreeStack(*Stack.tStack)
	If ClearStack( *Stack )
		FreeMemory( *Stack )
		ProcedureReturn #True
	Else
		ProcedureReturn #False
	EndIf
EndProcedure



Define.tStack *MyStack = InitStack()
Define.i Item1 = 5
Define.i Item2 = 20

If *MyStack
	Debug Push(*MyStack,@Item1)  ; Rückgabewert ist 1 => Aufruf OK
	Debug "---"
	Debug @Item1                 ; Zum Test die Adresse von Item1
	Debug Pop(*MyStack)          ; Rückgabewert ist eine Adresse => Aufruf OK
	Debug "---"
	Debug CountStack(*MyStack)   ; Gibt Null zurück, da keine Elemente mehr auf dem Stack
	Debug Push(*MyStack,@Item1)  ; Item1 auf den Stack, gibt #True (1) zurück!
	Debug Push(*MyStack,@Item2)  ; Item2 auf den Stack, gibt #True (1) zurück!
	Debug CountStack(*MyStack)   ; Sollte 2 zurückgeben, da zwei Elemente auf dem Stack
	Debug "---"
	Debug ClearStack(*MyStack)    ; Aufruf OK, gibt #True (1) zurück!
	Debug CountStack(*MyStack)   ; Sollte 0 zurückgeben, da zwei Elemente auf dem Stack
	Debug "---"	
	Debug Push(*MyStack,@Item1)  ; Item1 auf den Stack, gibt #True (1) zurück!
	Debug Push(*MyStack,@Item2)  ; Item2 auf den Stack, gibt #True (1) zurück!
	Debug PeekI( pop(*MyStack) ) ; Gibt 20 zurück (Item2)
	Debug PeekI( pop(*MyStack) ) ; Gibt  5 zurück (Item1)
	Debug CountStack(*MyStack)   ; Sollte 0 zurückgeben, da zwei Elemente auf dem Stack
	Debug "---"
	For Item1 = 1 To 10
		Debug "Push " + Str(Item1)
		Push(*MyStack, Item1)
	Next
	While CountStack(*MyStack)
		Item1 = Pop(*MyStack)
		Debug "Pop " + Str(Item1)
	Wend
	
	FreeStack( *MyStack ) : *MyStack = #Null
Else
	Debug "Stack konnte nicht initialisiert werden"
EndIf
Thread-Safe sind aber beide Vorschläge nicht!

Re: Schleife in Prozedur: 1. Aufruf OK, 2. Aufruf endlos

Verfasst: 30.07.2010 17:56
von Mok
Ich war grad dabei, dass ich es selber Code :D
Dank DRIVER_POWER_STATE_FAILURE (BlueScreen) könnte ich jetzt jedoch wieder von vordne anfangen...

Edit: Line 123: Syntax Error :? Wenn ich stattdessen die Adresse übergeb' bekomme ich nen ASM-Error
Edit 2: Mein Fehler. Prozeduren nicht nach ASM-Commands benennen, wenn EnableASM aktiviert ist :freak:

Re: Schleife in Prozedur: 1. Aufruf OK, 2. Aufruf endlos

Verfasst: 30.07.2010 18:05
von helpy
Mok hat geschrieben:Ich war grad dabei, dass ich es selber Code :D
Dank DRIVER_POWER_STATE_FAILURE (BlueScreen) könnte ich jetzt jedoch wieder von vordne anfangen...

Edit: Line 123: Syntax Error :? Wenn ich stattdessen die Adresse übergeb' bekomme ich nen ASM-Error
hmmm ... jetzt habe ich Dich doch nicht Deinem eigenen Lern- und Forscher-Tempo überlassen :-(

Aber es gibt da sicher noch eine schnellere Variante! Denn jedesmal bei Push/Pop Speicher zu allokieren bzw. wieder freizugeben ist nicht gerade effizient!.
Schneller ist es sicher gleich einen Speicherblock (oder ein Array) bestimmter Anfangsgröße zu nehmen, den Du mit den entsprechenden Werten befüllst und nur einen Zeiger auf Anfang und Ende mitlaufen lässt. Falls die Stackgröße nicht ausreicht, dann könnte man den Stack block-weise vergrößeren bzw. verkleinern, also nicht bei jedem Push/Pop.

cu, guido

Re: Schleife in Prozedur: 1. Aufruf OK, 2. Aufruf endlos

Verfasst: 30.07.2010 19:16
von NicTheQuick
Hier mal das mit der blockweisen Vergrößerung.

Code: Alles auswählen

Structure StackArray
	*e[0]
EndStructure

Structure Stack
	*values.StackArray
	*newValues.StackArray
	size.i
	elements.i
EndStructure

; size=2 elements=2
; values:		08
; newValues:	0823

Procedure.i initStack()
	Protected *stack.Stack
	
	*stack = AllocateMemory(SizeOf(Stack))
	If Not *stack : ProcedureReturn #False : EndIf
	
	With *stack
		\values = AllocateMemory(SizeOf(Integer))
		\newValues = AllocateMemory(2 * SizeOf(Integer))
		\size = 1
		\elements = 0
	EndWith
	
	ProcedureReturn *stack
EndProcedure

Procedure push(*stack.Stack, *element)
	Protected *t
	With *stack
		If (\size = \elements)
			\size << 1
			Swap \values, \newValues
			
			*t = AllocateMemory((\size << 1) * SizeOf(Integer))
			If (Not \newValues)
				\size >> 1
				Swap \values, \newValues
				ProcedureReturn #False
			EndIf
			FreeMemory(\newValues)	;kein ReAllocateMemory, da ein Kopieren unnötig wäre
			\newValues = *t
		EndIf
		
		If (\elements)
			\newValues\e[\elements - \size >> 1] = \values\e[\elements - \size >> 1]
		EndIf
		
		\values\e[\elements] = *element
		\newValues\e[\elements] = *element
		\elements + 1
	EndWith
	ProcedureReturn #True
EndProcedure

Procedure.i pop(*stack.Stack)
	Protected *result
	
	With *stack
		If (\elements = 0)
			ProcedureReturn #False
		EndIf
		\elements - 1
		*result = \values\e[\elements]
		
		If (\size >= 2 And \elements = \size >> 2)
			Swap \values, \newValues
			\size >> 1
			\values = ReAllocateMemory(\values, \size * SizeOf(Integer))
		EndIf
	EndWith
	
	ProcedureReturn *result
EndProcedure

Procedure.i countStack(*stack.Stack)
	ProcedureReturn *stack\elements
EndProcedure

Procedure.i clearStack(*stack.Stack)
	With *stack
		\values = ReAllocateMemory(\values, SizeOf(Integer))
		\newValues = ReAllocateMemory(\newValues, 2 * SizeOf(Integer))
		\size = 1
		\elements = 0
	EndWith
	ProcedureReturn #True
EndProcedure

Procedure freeStack(*stack.Stack)
	With *stack
		FreeMemory(\values)
		FreeMemory(\newValues)
	EndWith
EndProcedure

Define.Stack *MyStack = InitStack()
Define.i Item1 = 5
Define.i Item2 = 20

If *MyStack
   Debug push(*MyStack,@Item1)  ; Rückgabewert ist 1 => Aufruf OK
   Debug "---"
   Debug @Item1                 ; Zum Test die Adresse von Item1
   Debug pop(*MyStack)          ; Rückgabewert ist eine Adresse => Aufruf OK
   Debug "---"
   Debug countStack(*MyStack)   ; Gibt Null zurück, da keine Elemente mehr auf dem Stack
   Debug push(*MyStack,@Item1)  ; Item1 auf den Stack, gibt #True (1) zurück!
   Debug push(*MyStack,@Item2)  ; Item2 auf den Stack, gibt #True (1) zurück!
   Debug countStack(*MyStack)   ; Sollte 2 zurückgeben, da zwei Elemente auf dem Stack
   Debug "---"
   Debug clearStack(*MyStack)    ; Aufruf OK, gibt #True (1) zurück!
   Debug countStack(*MyStack)   ; Sollte 0 zurückgeben, da zwei Elemente auf dem Stack
   Debug "---"   
   Debug push(*MyStack,@Item1)  ; Item1 auf den Stack, gibt #True (1) zurück!
   Debug push(*MyStack,@Item2)  ; Item2 auf den Stack, gibt #True (1) zurück!
   Debug PeekI( pop(*MyStack) ) ; Gibt 20 zurück (Item2)
   Debug PeekI( pop(*MyStack) ) ; Gibt  5 zurück (Item1)
   Debug countStack(*MyStack)   ; Sollte 0 zurückgeben, da zwei Elemente auf dem Stack
   Debug "---"
   For Item1 = 1 To 10
      Debug "Push " + Str(Item1)
      push(*MyStack, Item1)
   Next
   While countStack(*MyStack)
      Item1 = pop(*MyStack)
      Debug "Pop " + Str(Item1)
   Wend
   
   freeStack( *MyStack ) : *MyStack = #Null
Else
   Debug "Stack konnte nicht initialisiert werden"
EndIf
Ein Push und ein Pop gehen immer in O(1), aber dafür ist der Speicherverbrauch bis zu sechs mal so hoch wie die Menge an Elementen auf dem Stack.
Alle Zeiten sind UTC+02:00
Seite 2 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de