LongListC.inc - Long Linked List Class - Hybrid COM Object

[Stanley Durham]

Long Linked List & Long Link List Node Class

Hybrid COM Object:
part of the object is an allocated UDT
- can't build list nodes out of pure COM objects - too heavy
- Hybrid; only a pointer the allocated resource is used in list

these classes use an error handler: ErrT (in download source)
local e as ErrT
o.Initialize(e)

this is necessary to trap a memory allocation failure

hybrid object needs internal memory allocated before use:
o.Alloc()
internal memory must be freed before object goes out of scope:
o.Free()

Source: LongListC.zip: Long Linked List Class. > http://deadtheorywalking.com/pb.aspx
public domain - use at own risk
need to download all files to compile

[Stanley Durham]

'PB 5/9
'LongListC.inc
'
'   Long Linked List - Hybrid COM Object
'
#Include Once "Error.inc"
#Include Once "GlobalMem.inc"
#Include Once "LongListNodeC.inc"
'
%LongListC_Hash = 465682666
'
Macro LongListC_ErrStatus(exitWhat) = If pe = %null Or @pe.err Then Exit exitWhat
Macro LongListC_ExitIf(test, message, exitWhat)
    If test Then
        Err_Set @pe, %ErrUndefined, "LongListC.inc", "LongListC", "LongListI", FuncName$, message
        Exit exitWhat
    End If
End Macro
'
Type LongListCT
    hash As Long
    Count As Long
    first As LongListNodeCT Ptr
    last As LongListNodeCT Ptr
End Type
'
'
'
Class LongListC
    Instance p As LongListCT Ptr
    Instance pe As ErrT Ptr
    Instance cNode As LongListNodeI
    '
    Class Method Create()
        cNode = Class "LongListNodeC"
    End Method
    '
    Interface LongListI : Inherit IUnknown
        '
        Method Initialize(e As ErrT)
            'set error handler
            pe = VarPtr(e)
            cNode.Initialize(e)
        End Method
        '
        Method Alloc()
            'allocate new instance
            LongListC_ErrStatus(Method)
            p = GMem_Alloc(SizeOf(@p), @pe)
            If @pe.err Then Exit Method
            @p.hash = %LongListC_Hash
        End Method
        '
        Method Free()
            'free instance
            LongListC_ErrStatus(Method)
            If p Then
                me.Clear()
                p = GMem_Free(p, @pe)
            End If
        End Method
        '
        Property Get Ptr() As Long
            'get current instance
            LongListC_ErrStatus(Property)
            Property = p
        End Property
        '
        Property Set Ptr(ByVal hMem As Long)
            'set current instance
            LongListC_ErrStatus(Property)
            p = hMem
            If p Then
                LongListC_ExitIf(@p.hash <> %LongListC_Hash, "invalid instance handle", Property)
            End If
        End Property
        '
        Method Count() As Long
            'get list item count
            LongListC_ErrStatus(Method)
            LongListC_ExitIf(p = %null, "null instance", Method)
            Method = @p.count
        End Method
        '
        Method Clear()
            'delete all items
            LongListC_ErrStatus(Method)
            LongListC_ExitIf(p = %null, "null instance", Method)
            While @p.first
                cNode.Ptr = @p.first
                @p.first = @[email protected]
                cNode.Free()
            Wend
            @p.count = 0
            @p.first = %null
            @p.last = %null
        End Method
        '
        Method Add(ByVal v As Long)
            'append value to end of list
            LongListC_ErrStatus(Method)
            LongListC_ExitIf(p = %null, "null instance", Method)
            '
            cNode.Alloc()
            Local node As LongListNodeCT Ptr
            node = cNode.Ptr
            '
            @node.value = v
            If @p.last Then @[email protected] = node
            @node.prev = @p.last
            @p.last = node
            If @p.first = 0 Then @p.first = node
            Incr @p.count
        End Method
        '
        Method Insert(ByVal v As Long)
            'insert value in front of list
            LongListC_ErrStatus(Method)
            LongListC_ExitIf(p = %null, "null instance", Method)
            '
            cNode.Alloc()
            Local node As LongListNodeCT Ptr
            node = cNode.Ptr
            '
            @node.value = v
            If @p.first Then @[email protected] = node
            @node.next = @p.first
            @p.first = node
            If @p.last = 0 Then @p.last = node
            Incr @p.count
        End Method
        '
        Method Remove(ByVal hNode As Long)
            'remove node from list
            LongListC_ErrStatus(Method)
            LongListC_ExitIf(p = %null, "null instance", Method)
            LongListC_ExitIf(hNode = %null, "null node handle", Method)
            '
            Local node As LongListNodeCT Ptr
            node = hNode
            LongListC_ExitIf(@node.hash <> %LongListNodeC_Hash, "invalid node handle", Method)
            '
            If @p.first = node Then @p.first = @[email protected]
            If @p.last = node Then @p.last = @[email protected]
            If @node.prev Then @[email protected] = @node.next
            If @node.next Then @[email protected] = @node.prev
            cNode.Ptr = node
            cNode.Free()
            Decr @p.count
        End Method
        '
        Method First() As Long
            'move to first item in list - return node handle
            LongListC_ErrStatus(Method)
            LongListC_ExitIf(p = %null, "null instance", Method)
            Method = @p.first
        End Method
        '
        Method Last() As Long
            'move to last item in list - return node handle
            LongListC_ErrStatus(Method)
            LongListC_ExitIf(p = %null, "null instance", Method)
            Method = @p.last
        End Method
        '
        Method Previous(ByVal hNode As Long) As Long
            'move to node befor hNode - return node handle
            LongListC_ErrStatus(Method)
            If hNode Then
                Local node As LongListNodeCT Ptr
                node = hNode
                LongListC_ExitIf(@node.hash <> %LongListNodeC_Hash, "invalid node handle", Method)
                Method = @node.prev
            End If
        End Method
        '
        Method Next(ByVal hNode As Long) As Long
            'move to node after hNode - return node handle
            LongListC_ErrStatus(Method)
            If hNode Then
                Local node As LongListNodeCT Ptr
                node = hNode
                LongListC_ExitIf(@node.hash <> %LongListNodeC_Hash, "invalid node handle", Method)
                Method = @node.next
            End If
        End Method
        '
        Method GetValueAt(ByVal hNode As Long) As Long
            'get node's value
            LongListC_ErrStatus(Method)
            LongListC_ExitIf(hNode = %null, "null node handle", Method)
            Local node As LongListNodeCT Ptr
            node = hNode
            LongListC_ExitIf(@node.hash <> %LongListNodeC_Hash, "invalid node handle", Method)
            Method = @node.value
        End Method
        '
        Method SetValueAt(ByVal hNode As Long, ByVal v As Long)
            'set node's value
            LongListC_ErrStatus(Method)
            LongListC_ExitIf(hNode = %null, "null node handle", Method)
            Local node As LongListNodeCT Ptr
            node = hNode
            LongListC_ExitIf(@node.hash <> %LongListNodeC_Hash, "invalid node handle", Method)
            @node.value = v
        End Method
        '
        Method Compare(ByVal hNode As Long, ByVal v As Long) As Long
            'node's Value with v
            'Value = v : Method = 0
            'Value < v : Method < 0
            'Value > v : Method > 0
            LongListC_ErrStatus(Method)
            LongListC_ExitIf(hNode = %null, "null node handle", Method)
            cNode.Ptr = hNode
            Method = cNode.Compare(v)
        End Method
        '
        Method InsertBefore(ByVal hNode As Long, ByVal v As Long)
            'insert new value before hNode
            LongListC_ErrStatus(Method)
            LongListC_ExitIf(p = %null, "null instance", Method)
            LongListC_ExitIf(hNode = %null, "null node handle", Method)
            '
            Local node, newNode As LongListNodeCT Ptr
            node = hNode
            LongListC_ExitIf(@node.hash <> %LongListNodeC_Hash, "invalid node handle", Method)
            '
            If node = @p.first Then
                me.Insert(v)
            Else
                cNode.Alloc()
                newNode = cNode.Ptr
                @newNode.value = v
                '
                @newNode.prev = @node.prev
                @[email protected] = newNode
                @newNode.next = node
                @node.prev = newNode
                '
                Incr @p.count
            End If
        End Method
        '
        Method InsertAfter(ByVal hNode As Long, ByVal v As Long)
            'insert new value after hNode
            LongListC_ErrStatus(Method)
            LongListC_ExitIf(p = %null, "null instance", Method)
            LongListC_ExitIf(hNode = %null, "null node handle", Method)
            '
            Local node, newNode As LongListNodeCT Ptr
            node = hNode
            LongListC_ExitIf(@node.hash <> %LongListNodeC_Hash, "invalid node handle", Method)
            '
            If node = @p.last Then
                me.Add(v)
            Else
                cNode.Alloc()
                newNode = cNode.Ptr
                @newNode.value = v
                '
                @newNode.next = @node.next
                @[email protected] = newNode
                @newNode.prev = node
                @node.next = newNode
                '
                Incr @p.count
            End If
        End Method
        '
        Method RemovePrevoius(ByVal hNode As Long)
            'remove value before node
            LongListC_ErrStatus(Method)
            LongListC_ExitIf(p = %null, "null instance", Method)
            LongListC_ExitIf(hNode = %null, "null node handle", Method)
            '
            Local node, newNode As LongListNodeCT Ptr
            node = hNode
            LongListC_ExitIf(@node.hash <> %LongListNodeC_Hash, "invalid node handle", Method)
            LongListC_ExitIf(@node.prev = %null, "null node reference", Method)
            me.Remove(@node.prev)
        End Method
        '
        Method RemoveNext(ByVal hNode As Long)
            'remove value after node
            LongListC_ErrStatus(Method)
            LongListC_ExitIf(p = %null, "null instance", Method)
            LongListC_ExitIf(hNode = %null, "null node handle", Method)
            '
            Local node, newNode As LongListNodeCT Ptr
            node = hNode
            LongListC_ExitIf(@node.hash <> %LongListNodeC_Hash, "invalid node handle", Method)
            LongListC_ExitIf(@node.next = %null, "null node reference", Method)
            me.Remove(@node.next)
        End Method
        '
    End Interface
    '
End Class

[Stanley Durham]

'PB 5/9 .02
'LongListNodeC.inc
'
'   Node Class for Long Linked List, and derivatives
'       Hybrid COM Object
'
#Include Once "Error.inc"
#Include Once "GlobalMem.inc"
'
Macro LongListNodeC_ErrStatus(exitWhat) = If pe = %null Or @pe.err Then Exit exitWhat
Macro LongListNodeC_ExitIf(test, message, exitWhat)
    If test Then
        Err_Set @pe, %ErrUndefined, "LongListNodeC.inc", "LongListNodeC", "LongListNodeI", FuncName$, message
        Exit exitWhat
    End If
End Macro
'
%LongListNodeC_Hash = -1827108340
'
Type LongListNodeCT
    hash As Long
    Next As LongListNodeCT Ptr
    prev As LongListNodeCT Ptr
    value As Long
End Type
'
'
'
Class LongListNodeC
    Instance p As LongListNodeCT Ptr
    Instance pe As ErrT Ptr
    '
    Interface LongListNodeI : Inherit IUnknown
        '
        Method Initialize(e As ErrT)
            'set error handler
            pe = VarPtr(e)
        End Method
        '
        Method Alloc()
            'allocate new instance
            LongListNodeC_ErrStatus(Method)
            p = GMem_Alloc(SizeOf(@p), @pe)
            If @pe.err Then Exit Method
            @p.hash = %LongListNodeC_Hash
        End Method
        '
        Method Free()
            'free instance
            LongListNodeC_ErrStatus(Method)
            If p Then p = GMem_Free(p, @pe)
        End Method
        '
        Property Get Ptr() As Long
            'get current instance
            LongListNodeC_ErrStatus(Property)
            Property = p
        End Property
        '
        Property Set Ptr(ByVal hMem As Long)
            'set current instance
            LongListNodeC_ErrStatus(Property)
            p = hMem
            If p Then
                LongListNodeC_ExitIf(@p.hash <> %LongListNodeC_Hash, "invalid memory handle", Property)
            End If
        End Property
        '
        Property Get Next() As Long
            LongListNodeC_ErrStatus(Property)
            LongListNodeC_ExitIf(p = %null, "null instance", Property)
            Property = @p.next
        End Property
        '
        Property Set Next(ByVal v As Long)
            LongListNodeC_ErrStatus(Property)
            LongListNodeC_ExitIf(p = %null, "null instance", Property)
            @p.next = v
        End Property
        '
        Property Get Prev() As Long
            LongListNodeC_ErrStatus(Property)
            LongListNodeC_ExitIf(p = %null, "null instance", Property)
            Property = @p.prev
        End Property
        '
        Property Set Prev(ByVal v As Long)
            LongListNodeC_ErrStatus(Property)
            LongListNodeC_ExitIf(p = %null, "null instance", Property)
            @p.prev = v
        End Property
        '
        Property Get Value() As Long
            LongListNodeC_ErrStatus(Property)
            LongListNodeC_ExitIf(p = %null, "null instance", Property)
            Property = @p.value
        End Property
        '
        Property Set Value(ByVal v As Long)
            LongListNodeC_ErrStatus(Property)
            LongListNodeC_ExitIf(p = %null, "null instance", Property)
            @p.value = v
        End Property
        '
        Method Compare(ByVal v As Long) As Long
            LongListNodeC_ErrStatus(Method)
            LongListNodeC_ExitIf(p = %null, "null instance", Method)
            If @p.value < v Then
                Method = -1
            ElseIf @p.value > v Then
                Method = 1
            Else
                Method = 0
            End If
        End Method
        '
    End Interface
    '
End Class

[Stanley Durham]

test/sample
needs Error.inc and GlobalMem.inc to compile (in download)

'PB 9
%ErrHaltActive = 1
$TestSource = "LongListC.bas"
$TestTitle = "LongListC"
#Compile Exe "LongListC.exe"
#Dim All
#Optimize Speed
#Include Once "PBForms.INC"
#Include "LongListC.inc"
'
%Dlg1    =  101
%BtnTest = 1002
%Lbx     = 1001
'
Sub BtnTest(ByVal hDlg As Long)
    Register i As Long
    Register Count As Long
    Local node As Long
    Register d As Ext
    Local e As ErrT
    Local list As LongListI : list = Class "LongListC" : list.Initialize(e)
    '
    ListBox Reset hDlg, %Lbx
    '
    '   this is a hybrid PB COM object
    '   internal memory must be allocated before use
    list.Alloc()
    '
    ListBox Add hDlg, %Lbx, ""
    ListBox Add hDlg, %Lbx, "get internal memory handle: " + Format$(list.Ptr)
    '
    ListBox Add hDlg, %Lbx, ""
    ListBox Add hDlg, %Lbx, "add 5 items"
    For i = 1 To 5
        list.Add(i)
    Next i
    ListBox Add hDlg, %Lbx, "traverse forward"
    node = list.First()
    While node
        ListBox Add hDlg, %Lbx, Str$(list.GetValueAt(node))
        node = list.Next(node)
    Wend
    ListBox Add hDlg, %Lbx, "traverse backward"
    node = list.Last()
    While node
        ListBox Add hDlg, %Lbx, Str$(list.GetValueAt(node))
        node = list.Previous(node)
    Wend
    '
    ListBox Add hDlg, %Lbx, ""
    ListBox Add hDlg, %Lbx, "got to first item"
    node = list.First()
    ListBox Add hDlg, %Lbx, "    insert 0 before"
    list.InsertBefore(node, 0)
    ListBox Add hDlg, %Lbx, "    insert 11 after"
    list.InsertAfter(node, 11)
    '
    ListBox Add hDlg, %Lbx, "got to last item"
    node = list.Last()
    ListBox Add hDlg, %Lbx, "    insert 44 before"
    list.InsertBefore(node, 44)
    ListBox Add hDlg, %Lbx, "    insert 55 after"
    list.InsertAfter(node, 55)
    '
    ListBox Add hDlg, %Lbx, "traverse list"
    node = list.First()
    While node
        ListBox Add hDlg, %Lbx, Str$(list.GetValueAt(node))
        node = list.next(node)
    Wend
    '
    ListBox Add hDlg, %Lbx, ""
    ListBox Add hDlg, %Lbx, "move to second item in list: = 1"
    node = list.First() : node = list.Next(node)
    ListBox Add hDlg, %Lbx, "    delete item before"
    list.RemovePrevoius(node)
    ListBox Add hDlg, %Lbx, "    delete item after"
    list.RemoveNext(node)
    '
    ListBox Add hDlg, %Lbx, ""
    ListBox Add hDlg, %Lbx, "move to second from end of list: = 5"
    node = list.Last() : node = list.Previous(node)
    ListBox Add hDlg, %Lbx, "    delete item before"
    list.RemovePrevoius(node)
    ListBox Add hDlg, %Lbx, "    delete item after"
    list.RemoveNext(node)
    '
    ListBox Add hDlg, %Lbx, "traverse list"
    node = list.First()
    While node
        ListBox Add hDlg, %Lbx, Str$(list.GetValueAt(node))
        node = list.Next(node)
    Wend
    '
    '
    Count = 100000
    ListBox Add hDlg, %Lbx, ""
    ListBox Add hDlg, %Lbx, ""
    ListBox Add hDlg, %Lbx, "Speed Test"
    ListBox Add hDlg, %Lbx, "    clear list"
    list.Clear()
    ListBox Add hDlg, %Lbx, "    add "+Format$(Count, "#,.")+" items to list"
    d = Timer
    For i = Count To 1 Step - 1
        list.Add(i)
    Next i
    ListBox Add hDlg, %Lbx, "    Time = " + Format$(Timer - d, "0000000000.0000000000")
    '
    ListBox Add hDlg, %Lbx, ""
    ListBox Add hDlg, %Lbx, "    traverse all "+Format$(Count, "#,.")+" items"
    d = Timer
    node = list.First()
    While node
        ''''''''listbox add hDlg, %Lbx, format$(list.GetValueAt(node))
        node = list.Next(node)
    Wend
    ListBox Add hDlg, %Lbx, "    Time = " + Format$(Timer - d, "0000000000.0000000000")
    '
    '   internal memory must be freed before object goes out of scope
    list.Free()
    list = Nothing  'not necessary
    '
    ListBox Add hDlg, %Lbx, ""
    ListBox Add hDlg, %Lbx, "done..."
End Sub
'
Function PBMain()
    ShowDlg1 %HWND_Desktop
End Function
CallBack Function ShowDlg1Proc()
    Select Case As Long CbMsg
        Case %WM_Command
            Select Case As Long CbCtl
                Case %BtnTest
                    If CbCtlMsg = %BN_Clicked Or CbCtlMsg = 1 Then
                        BtnTest(Cb.Hndl)
                    End If
            End Select
    End Select
End Function
Function ShowDlg1(ByVal hParent As Dword) As Long
    Local lRslt  As Long
    Local hDlg   As Dword
    Local hFont1 As Dword
    Dialog New hParent, $TestTitle, 67, 61, 341, 241, %WS_Popup _
        Or %WS_Border Or %WS_DlgFrame Or %WS_Caption Or %WS_SysMenu Or _
        %WS_MinimizeBox Or %WS_ClipSiblings Or %WS_Visible Or %DS_ModalFrame _
        Or %DS_3DLook Or %DS_NoFailCreate Or %DS_SetFont, _
        %WS_Ex_ControlParent Or %WS_Ex_Left Or %WS_Ex_LtrReading Or _
        %WS_Ex_RightScrollbar, To hDlg
    Control Add ListBox, hDlg, %Lbx, , 5, 5, 330, 210, %WS_Child Or _
        %WS_Visible Or %WS_HScroll Or %WS_VScroll Or %LBS_Notify Or _
        %LBS_NoIntegralHeight, %WS_Ex_ClientEdge Or %WS_Ex_Left Or _
        %WS_Ex_LtrReading Or %WS_Ex_RightScrollbar
    Control Add Button,  hDlg, %BtnTest, "Test", 275, 220, 60, 15
    hFont1 = PBFormsMakeFont("Courier New", 9, 400, %FALSE, %FALSE, %FALSE, _
        %ANSI_CHARSET)
    Control Send hDlg, %Lbx, %WM_SETFONT, hFont1, 0
    Dialog Show Modal hDlg, Call ShowDlg1Proc To lRslt
    DeleteObject hFont1
    Function = lRslt
End Function