A Stack of Quads

[danbaron]

[font=courier new]Here is a script that implements a stack of Quads.

:oops:
Dan :x :P


'-----------------------------------------------------------------------------------------------------------------------
'file = qstack.tbasicc
'-----------------------------------------------------------------------------------------------------------------------
Uses "console"
'-----------------------------------------------------------------------------------------------------------------------

'Implementation of a stack, to hold Quads.

'As I bet you know, the name, "stack", comes from the analogy to a stack of plates.
'The first plate, the one that you start a stack with (on the bottom), is the last plate that you remove from it.
'The last plate, that you put on the top, is the first plate that you remove from it.
'So, in computer science, a stack is a LIFO (last in first out) structure.
'"push" means, "put a plate on the stack".
'"pop" means, "remove a plate from the stack".
'Here, "plate", means "Quad".

'I made it to use with something else.
'I did it without much thinking - instead, typing and changing until it seemed to work.
'I know that is the lazy, unreliable way to do it; detail by detail, until,
'it seems to magically do what it is supposed to do. In that case, the plus side is - it works,
'the minus side is - you may not know how or why.

'It could be buggy, but it seems to function OK.

'-----------------------------------------------------------------------------------------------------------------------

%quadsize = SizeOf(Quad)
%nodesize = %quadsize + SizeOf(DWord)

Global stack As DWord = 0

'-----------------------------------------------------------------------------------------------------------------------

Function TBMain()
Local ss As DWord = 4
Local i, j As Integer
Local v As Quad

For i = 1 To 2

For j = -ss To ss
push(j)
Next

For j = -ss To ss + 1
If emptystack() Then
Console_WriteLine("Stack empty.")
Console_WriteLine()
Else
v = pop()
Console_WriteLine(v)
EndIf
Next

Next

Console_WriteLine("Done. Press a key.")
WaitKey
End Function

'-----------------------------------------------------------------------------------------------------------------------

Function push(v As Quad)
Local plate As DWord
plate = HEAP_Alloc(%nodesize)
Poke(Quad, plate, v)
Poke(DWord, plate + %quadsize, stack)
stack = plate
End Function

'-----------------------------------------------------------------------------------------------------------------------

Function pop() As Quad
Local v As Quad
Local crackedplate As DWord
crackedplate = stack
v = Peek(Quad, stack)
stack = Peek(DWord, stack + %quadsize)
HEAP_Free(crackedplate)
Return v
End Function

'-----------------------------------------------------------------------------------------------------------------------

Function emptystack() As Byte
If stack = 0 Then Return TRUE
Return FALSE
End Function

'-----------------------------------------------------------------------------------------------------------------------

[Charles Pegge]

I love stacks and strings :)

Here is a quad stack held inside a string. When you run out of stack space the string is automatically extended.




'==========================
'QUAD STACK USING A STRING:
'==========================

Dim As String s 'STACK
Dim As Long p=1 'STACK POINTER


'------------------
Sub push(q As Quad)
'==================
If p+8>Len(s) Then
s+=String$(8000,Chr$(0))
End If
Mid$(s,p)=MKQ$(q)
p+=8
End Sub

'---------------------
Function pop() As Quad
'=====================
If p<9 Then
MsgBox 0,"Stack empty!"
Exit Function
End If
p-=8
Function=CVQ(s, p)
End Function


push 1 : push 2 push 3

MsgBox 0,"POPS"+$CRLF+pop+$CRLF+pop+$CRLF+pop

pop 'ATTEMPT TO POP FROM AN EMPTY STACK

[danbaron]

[font=courier new]I like it.

I learned a lot.

Your way is shorter, and seems better. :twisted:

I put some comments in your code.

:oops:
Dan :x :P


'==========================
'file = QStringStack.tbasic
'==========================
'QUAD STACK USING A STRING:
'==========================

'I didn't know you could do all this stuff with a string.

Dim As String s 'STACK
Dim As Long p = 1 'STACK POINTER
Dim i As Byte

'------------------
Sub push(q As Quad)
'==================
If p + 8 > Len(s) Then
'I didn't know you could do "s += " for strings.
'You only have to allocate more string space, if the number of quads exceeds 999.
'And, you never have to deallocate string space.
'My way allocates for every "push", and deallocates for every "pop".
s += String$(8000, Chr$(0))
End If
'I didn't know about MKQ$().
Mid$(s, p) = MKQ$(q)
p += 8
End Sub

'---------------------
Function pop() As Quad
'=====================

'p = 1, 9, 17, ..
If p = 1 Then
MsgBox 0,"Stack empty!"
Exit Function
End If
p -= 8
'I didn't know about CVQ.
'I always use "Return ". You use "Function = ".
Function = CVQ(s, p)
End Function

'Do it twice, to make sure.
For i = 1 To 2

'Apparently, you don't need parentheses.
push 1 : push 2 push 3
'I always use Console_Writeline. You use MsgBox.
'I didn't know about $CRLF.
MsgBox 0,"POPS"+$CRLF+pop+$CRLF+pop+$CRLF+pop

pop 'ATTEMPT TO POP FROM AN EMPTY STACK

Next

[Charles Pegge]

If you don't need the flexibility of strings then the simplest way is to use an array. Redim Preserve allows the stack to be expanded.

A script is often easier to read when unnecessary brackets are omitted, though sometimes you need to keep the brackets in to show that the symbol really is a function, not a simple variable.

Charles



'==========================
'QUAD STACK USING AN ARRAY:
'==========================

Dim As Quad s(1) 'STACK
Dim As Long i=1 'STACK INDEX


'------------------
Sub push(q As Quad)
'==================
If i>UBound(s) Then
ReDim Preserve s(i+100)
End If
s(i)=q
Incr i
End Sub

'---------------------
Function pop() As Quad
'=====================
If i<2 Then
MsgBox 0,"Stack empty!"
Exit Function
End If
Decr i
Function=s(i)
End Function


push 1 : push 2 push 3

MsgBox 0,"POPS"+$CRLF+pop+$CRLF+pop+$CRLF+pop

pop 'ATTEMPT TO POP FROM AN EMPTY STACK

[danbaron]

[font=courier]Using Redim Preserve, is simply simple.

It makes the code to implement a stack, look like nothing.

And, I think you could use it for UDTs.

:oops:
Dan :x :P


'------------------------------------------------------------------
'file = qstack2.tbasicc
'------------------------------------------------------------------

Uses "Console"

%range = 2
'Make %stackincrement small for this test, to make sure the allocation works correctly.
%stackincrement = 8

Global stack(1) As Quad
Global sindex As DWord = 1

'------------------------------------------------------------------

Function TBMain()
Local i, j As Quad

For i = 1 To 10

For j = -%range * i To %range * i
push(j)
Next

For j = -%range * i To %range * i + 1
If emptystack() Then
Console_WriteLine("Stack empty.")
else
Console_WriteLine(pop())
EndIf
Next

Next

End Function

'------------------------------------------------------------------

Sub push(q As Quad)
If sindex > UBound(stack) Then
ReDim Preserve stack(sindex + %stackincrement)
End If
stack(sindex) = q
Incr sindex
End Sub

'------------------------------------------------------------------

Function pop() As Quad
Decr sindex
Return stack(sindex)
End Function

'------------------------------------------------------------------

Function emptystack() As Byte
If sindex = 1 Then Return TRUE
Return FALSE
End Function

'------------------------------------------------------------------