Eigener dynamischer Stack

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Josef Sniatecki
Beiträge: 657
Registriert: 02.06.2008 21:29
Kontaktdaten:

Eigener dynamischer Stack

Beitrag von Josef Sniatecki »

Hi,

hier habe ich mal ein Template für euch, mit aufgefrischten Stack
Befehlen. Mit denen kann man kinderleicht Daten in einen eigenen
Stack pushen und poppen:

Code: Alles auswählen

;Structures:
Structure Stack
  DefaultSize.l
  *Top.Stack_Item
  *First.Stack_Item
  ItemCount.l
EndStructure
Structure Stack_Item
  *Memory
  Size.l
  *Previous.Stack_Item
EndStructure



;Functions:
Procedure.l CreateStack(DefaultSize.l=4) ;Create a new empty stack.
  Protected *Stack.Stack
  
  *Stack=AllocateMemory(SizeOf(Stack))
  *Stack\DefaultSize=DefaultSize
  ProcedureReturn *Stack
EndProcedure
Procedure.l FreeStack(*Stack.Stack) ;Remove the specified stack and all items from memory.
  ;Diese Schleife löscht alle restlichen Items
  ;im Stack:
  While *Stack\Top
    FreeMemory(*Stack\Top\Memory)
    *Stack\Top=*Stack\Top\Previous
  Wend
  
  FreeMemory(*Stack)
EndProcedure

Procedure.l StackFirst(*Stack.Stack) ;Return the address of the first item in the stack.
  ProcedureReturn *Stack\First
EndProcedure
Procedure.l StackTop(*Stack.Stack) ;Return the address of the item on the top of the stack.
  ProcedureReturn *Stack\Top
EndProcedure
Procedure.l StackSize(*Stack.Stack) ;Return the count of items in the stack.
  ProcedureReturn *Stack\ItemCount
EndProcedure
Procedure.l StackItemSize(*Item.Stack_Item) ;Return the memory size of the specified item of a stack.
  ProcedureReturn *Item\Size
EndProcedure

Procedure.l Push(*Stack.Stack,*Memory,Size.l=0) ;Push a copy of the specified memory in the stack.
  Protected *Item.Stack_Item
  
  If Size=0
    Size=*Stack\DefaultSize
  EndIf
  
  *Item=AllocateMemory(SizeOf(Stack_Item))
  *Item\Memory=AllocateMemory(Size)
  CopyMemory(*Memory,*Item\Memory,Size)
  *Item\Size=Size
  
  If *Stack\Top
    *Item\Previous=*Stack\Top
  Else
    *Stack\First=*Item
  EndIf
  *Stack\Top=*Item
  *Stack\ItemCount+1
EndProcedure
Procedure.l Pop(*Stack.Stack,*Pointer) ;Pop the memory on the top of the stack.
  Protected *Item.Stack_Item
  
  If *Stack\Top
    ;Ist ein Item im Stack, so werden die Daten des obersten Items
    ;in die angegebene Adresse des Zeigers kopiert.
    CopyMemory(*Stack\Top\Memory,*Pointer,*Stack\Top\Size)
    
    ;Das oberste Item wird gelöscht:
    If *Stack\Top=*Stack\First
      *Stack\First=0
    EndIf
    *Item=*Stack\Top
    *Stack\Top=*Stack\Top\Previous
    FreeMemory(*Item\Memory)
    FreeMemory(*Item)
    *Stack\ItemCount-1
    ProcedureReturn #True
  Else
    ;Ist kein Item mehr im Stack vorhanden, so gibt die Funktion
    ;Null als Resultat zurück.
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure.l PushB(*Stack.Stack,Byte.b) ;Push a byte in the specified stack.
  Push(*Stack,@Byte,SizeOf(Byte))
EndProcedure
Procedure.l PushC(*Stack.Stack,Character.c) ;Push a character in the specified stack.
  Push(*Stack,@Character,SizeOf(Character))
EndProcedure
Procedure.l PushW(*Stack.Stack,Word.w) ;Push a word in the specified stack.
  Push(*Stack,@Word,SizeOf(Word))
EndProcedure
Procedure.l PushL(*Stack.Stack,Long.l) ;Push a long in the specified stack.
  Push(*Stack,@Long,SizeOf(Long))
EndProcedure
Procedure.l PushI(*Stack.Stack,Integer.i) ;Push an integer in the specified stack.
  Push(*Stack,@Integer,SizeOf(Integer))
EndProcedure
Procedure.l PushF(*Stack.Stack,Float.f) ;Push a float in the specified stack.
  Push(*Stack,@Float,SizeOf(Float))
EndProcedure
Procedure.l PushQ(*Stack.Stack,Quad.q) ;Push a quad in the specified stack.
  Push(*Stack,@Quad,SizeOf(Quad))
EndProcedure
Procedure.l PushD(*Stack.Stack,Double.d) ;Push a double in the specified stack.
  Push(*Stack,@Double,SizeOf(Double))
EndProcedure
Procedure.l PushS(*Stack.Stack,String.s) ;Push a string in the specified stack.
  Push(*Stack,@String,Len(String))
EndProcedure

Procedure.b PopB(*Stack.Stack) ;Pop a byte of the specified stack.
  Protected Byte.b
  
  Pop(*Stack,@Byte)
  ProcedureReturn Byte
EndProcedure
Procedure.c PopC(*Stack.Stack) ;Pop a character of the specified stack.
  Protected Character.c
  
  Pop(*Stack,@Character)
  ProcedureReturn Character
EndProcedure
Procedure.w PopW(*Stack.Stack) ;Pop a word of the specified stack.
  Protected Word.w
  
  Pop(*Stack,@Word)
  ProcedureReturn Word
EndProcedure
Procedure.l PopL(*Stack.Stack) ;Pop a long of the specified stack.
  Protected Long.l
  
  Pop(*Stack,@Long)
  ProcedureReturn Long
EndProcedure
Procedure.i PopI(*Stack.Stack) ;Pop an integer of the specified stack.
  Protected Integer.i
  
  Pop(*Stack,@Integer)
  ProcedureReturn Integer
EndProcedure
Procedure.f PopF(*Stack.Stack) ;Pop a float of the specified stack.
  Protected Float.f
  
  Pop(*Stack,@Float)
  ProcedureReturn Float
EndProcedure
Procedure.q PopQ(*Stack.Stack) ;Pop a quad of the specified stack.
  Protected Quad.q
  
  Pop(*Stack,@Quad)
  ProcedureReturn Quad
EndProcedure
Procedure.d PopD(*Stack.Stack) ;Pop a double of the specified stack.
  Protected Double.d
  
  Pop(*Stack,@Double)
  ProcedureReturn Double
EndProcedure
Procedure.s PopS(*Stack.Stack) ;Pop a string of the specified stack.
  Protected String.s
  
  String=Space(StackItemSize(StackTop(*Stack)))
  Pop(*Stack,@String)
  ProcedureReturn String
EndProcedure
Hier ein Beispiel:

Code: Alles auswählen

Procedure.l PushRandomLongs(Items.l)
  Protected Stack.l
  
  Stack=CreateStack(SizeOf(Long))
  While Items
    ;Erweitert den Stack mit einer zufälligen Zahl (Long):
    PushL(Stack,Random(100)))
    Items-1
  Wend
  ProcedureReturn Stack
EndProcedure

Result=PushRandomLongs(10)
While StackSize(Result) ;Solange Items im Stack vorhanden sind:
  Debug PopL(Result) ;Gebe das letzte Long aus und lösche dieses aus dem Stack.
Wend
FreeStack(Result) ;Lösche den Stack.

End
Zwar ist dieses Beispiel nicht gerade das, wofür man eigentlich wirklich
Stacks braucht, doch man sieht, wie man Stacks mit diesem Template
behandeln kann.
In dem Beispiel pusht eine Prozedur zufällige Longs in einen neuen Stack
und gibt diesen zurück. Dabei kann man die Anzahl der zu pushenden
Longs angeben.

Wer will, kann daraus schnell eine UserLib machen, indem er einfach nach
jedem "Prozedure" ein "DLL" hinzufügt. (am besten durch Ersetzen).

Gruß Josef
PB 4.61 | Windows Vista - 32Bit
Homepage

"Wahrlich es ist nicht das Wissen, sondern das Lernen, nicht das Besitzen sondern das Erwerben, nicht das Dasein, sondern das Hinkommen, was den grössten Genuss gewährt." - Carl Friedrich Gauß
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

Warum nutzt Du denn überall Long statt Integer? So wird es, grob
überflogen, unter X64 wohl kaum laufen, abgesehen davon, das ein
Pointer nunmal die Größe von Integer hat, auch wenn dies bei 32-Bit einem
Long entspricht ist dies nicht empfehlenswert.

Procedure.b, Procedure.l usw. machen auch nicht unbedingt Sinn,
Procedure.I ist schneller und kann auch kleinere Werte zurückgeben. Das ist
ja eher eine Frage welchem Typ ich das Ergebnis zuordne.

Hab mal was ähnliches mit Macros im engl. Forum gesehen, sollte schneller
sein.

Gruß vom Kritiker :wink:
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
Josef Sniatecki
Beiträge: 657
Registriert: 02.06.2008 21:29
Kontaktdaten:

Beitrag von Josef Sniatecki »

Hm.. war seit 4.30 verwirrt, welchen Typ ich nun nehmen sollte.
Long oder Integer?
Immerhin ist doch der Standard-Typ immernoch "Long", oder?

Na, gut. Jetzt habe ich was vom Kritiker gelernt.
Ich werde dann das ganze überarbeiten...
PB 4.61 | Windows Vista - 32Bit
Homepage

"Wahrlich es ist nicht das Wissen, sondern das Lernen, nicht das Besitzen sondern das Erwerben, nicht das Dasein, sondern das Hinkommen, was den grössten Genuss gewährt." - Carl Friedrich Gauß
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

Josef Sniatecki hat geschrieben: Immerhin ist doch der Standard-Typ immernoch "Long", oder?
Nein, Standard-Typ ist Integer :wink:
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
Josef Sniatecki
Beiträge: 657
Registriert: 02.06.2008 21:29
Kontaktdaten:

Beitrag von Josef Sniatecki »

Uff, das jetzt der Stanard-Typ "Integer" ist, überrascht mich sehr. (jetzt
muss ich einiges bearbeiten).

OK ... hier die überarbeitete Version - Speziell für Integer:

Code: Alles auswählen

;Structures:
Structure Stack
  DefaultSize.l
  *Top.Stack_Item
  *First.Stack_Item
  ItemCount.i
EndStructure
Structure Stack_Item
  *Memory
  Size.i
  *Previous.Stack_Item
EndStructure



;Functions:
Procedure.i CreateStack(DefaultSize.i=4) ;Create a new empty stack.
  Protected *Stack.Stack
  
  *Stack=AllocateMemory(SizeOf(Stack))
  *Stack\DefaultSize=DefaultSize
  ProcedureReturn *Stack
EndProcedure
Procedure.i FreeStack(*Stack.Stack) ;Remove the specified stack and all items from memory.
  ;Diese Schleife löscht alle restlichen Items
  ;im Stack:
  While *Stack\Top
    FreeMemory(*Stack\Top\Memory)
    *Stack\Top=*Stack\Top\Previous
  Wend
  
  FreeMemory(*Stack)
EndProcedure

Procedure.i StackFirst(*Stack.Stack) ;Return the address of the first item in the stack.
  ProcedureReturn *Stack\First
EndProcedure
Procedure.i StackTop(*Stack.Stack) ;Return the address of the item on the top of the stack.
  ProcedureReturn *Stack\Top
EndProcedure
Procedure.i StackSize(*Stack.Stack) ;Return the count of items in the stack.
  ProcedureReturn *Stack\ItemCount
EndProcedure
Procedure.i StackItemSize(*Item.Stack_Item) ;Return the memory size of the specified item of a stack.
  ProcedureReturn *Item\Size
EndProcedure

Procedure.i Push(*Stack.Stack,*Memory,Size.i=0) ;Push a copy of the specified memory in the stack.
  Protected *Item.Stack_Item
  
  If Size=0
    Size=*Stack\DefaultSize
  EndIf
  
  *Item=AllocateMemory(SizeOf(Stack_Item))
  *Item\Memory=AllocateMemory(Size)
  CopyMemory(*Memory,*Item\Memory,Size)
  *Item\Size=Size
  
  If *Stack\Top
    *Item\Previous=*Stack\Top
  Else
    *Stack\First=*Item
  EndIf
  *Stack\Top=*Item
  *Stack\ItemCount+1
EndProcedure
Procedure.i Pop(*Stack.Stack,*Pointer) ;Pop the memory on the top of the stack.
  Protected *Item.Stack_Item
  
  If *Stack\Top
    ;Ist ein Item im Stack, so werden die Daten des obersten Items
    ;in die angegebene Adresse des Zeigers kopiert.
    CopyMemory(*Stack\Top\Memory,*Pointer,*Stack\Top\Size)
    
    ;Das oberste Item wird gelöscht:
    If *Stack\Top=*Stack\First
      *Stack\First=0
    EndIf
    *Item=*Stack\Top
    *Stack\Top=*Stack\Top\Previous
    FreeMemory(*Item\Memory)
    FreeMemory(*Item)
    *Stack\ItemCount-1
    ProcedureReturn #True
  Else
    ;Ist kein Item mehr im Stack vorhanden, so gibt die Funktion
    ;Null als Resultat zurück.
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure.i PushI(*Stack.Stack,Integer.i) ;Push an integer in the specified stack.
  Push(*Stack,@Integer,SizeOf(Integer))
EndProcedure
Procedure.i PushF(*Stack.Stack,Float.f) ;Push a float in the specified stack.
  Push(*Stack,@Float,SizeOf(Float))
EndProcedure
Procedure.i PushQ(*Stack.Stack,Quad.q) ;Push a quad in the specified stack.
  Push(*Stack,@Quad,SizeOf(Quad))
EndProcedure
Procedure.i PushD(*Stack.Stack,Double.d) ;Push a double in the specified stack.
  Push(*Stack,@Double,SizeOf(Double))
EndProcedure
Procedure.i PushS(*Stack.Stack,String.s) ;Push a string in the specified stack.
  Push(*Stack,@String,Len(String))
EndProcedure

Procedure.i PopI(*Stack.Stack) ;Pop an integer of the specified stack.
  Protected Integer.i
  
  Pop(*Stack,@Integer)
  ProcedureReturn Integer
EndProcedure
Procedure.f PopF(*Stack.Stack) ;Pop a float of the specified stack.
  Protected Float.f
  
  Pop(*Stack,@Float)
  ProcedureReturn Float
EndProcedure
Procedure.q PopQ(*Stack.Stack) ;Pop a quad of the specified stack.
  Protected Quad.q
  
  Pop(*Stack,@Quad)
  ProcedureReturn Quad
EndProcedure
Procedure.d PopD(*Stack.Stack) ;Pop a double of the specified stack.
  Protected Double.d
  
  Pop(*Stack,@Double)
  ProcedureReturn Double
EndProcedure
Procedure.s PopS(*Stack.Stack) ;Pop a string of the specified stack.
  Protected String.s
  
  String=Space(StackItemSize(StackTop(*Stack)))
  Pop(*Stack,@String)
  ProcedureReturn String
EndProcedure
PB 4.61 | Windows Vista - 32Bit
Homepage

"Wahrlich es ist nicht das Wissen, sondern das Lernen, nicht das Besitzen sondern das Erwerben, nicht das Dasein, sondern das Hinkommen, was den grössten Genuss gewährt." - Carl Friedrich Gauß
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

Grob getestet, funzt unter X64, DefaultSize sollte auch in der Strukture vom
Typ integer sein und CreateStack besser so:

Code: Alles auswählen

Procedure.i CreateStack(DefaultSize.i = SizeOf(Integer)) ;Create a new empty stack.
  Protected *Stack.Stack
 
  *Stack=AllocateMemory(SizeOf(Stack))
  *Stack\DefaultSize=DefaultSize
  ProcedureReturn *Stack
EndProcedure
Das wars erstmal an Senf von mir, ich persönlich benötige das nicht, richtig
testen sollens dann doch lieber andere :wink:
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
edel
Beiträge: 3667
Registriert: 28.07.2005 12:39
Computerausstattung: GameBoy
Kontaktdaten:

Re: Eigener dynamischer Stack

Beitrag von edel »

Josef Sniatecki hat geschrieben:Wer will, kann daraus schnell eine UserLib machen, indem er einfach nach
jedem "Prozedure" ein "DLL" hinzufügt. (am besten durch Ersetzen).
Da der Code ohne grosse Schwierigkeiten in jeder anderen Sprache
umgesetzt werden kann, sollte man eine Userlib aus diesem Code
vermeiden. Eine Userlib die z.B. in C/C++ geschrieben wurde, haelt
sich laenger als eine die mit Tailbite kompiliert wurde.
Benutzeravatar
Josef Sniatecki
Beiträge: 657
Registriert: 02.06.2008 21:29
Kontaktdaten:

Beitrag von Josef Sniatecki »

Leider habe ich nur keine Erfahrungen damit, eine UserLib mit C++
zu erstellen. (was ich jedoch gerne wissen würde)

Bei mir sind alle UserLibs in PB programmiert.
PB 4.61 | Windows Vista - 32Bit
Homepage

"Wahrlich es ist nicht das Wissen, sondern das Lernen, nicht das Besitzen sondern das Erwerben, nicht das Dasein, sondern das Hinkommen, was den grössten Genuss gewährt." - Carl Friedrich Gauß
Antworten