Object Oriented Programming in Bascom

Index

• [OOP 1a/3] Dynamic Memory Allocation using TLSF
• [OOP 1b/3] Static Memory Allocation
• [OOP 2/3] Object Oriented Programming in Bascom
• [OOP 3/3] Bascom-Precompiler

• Forum thread

Object as collection of data

Defining an Object

Each object consists of its own member variables (and functions, see below), which are organized in memory as a unit. For example, here is a simple object (in pseudocode, intended string size in parenthesis), storing some personal information:

Object Person
   Name As String(30)
   Birth_year As Word
   Height_cm As Byte
End Object

The member fields therefore have a fixed memory layout, the member's positions could be defined like this:

Const Person_name = 0                 ' Name string is starting at position 0
Const Person_birth_year = 31          ' year of birth is stored at position 31 (30 bytes string data + 0 terminator
Const Person_height_cm = 33           ' adding 2 bytes of previous field (word)
Const Person_object_size = 34         ' needing a total of 34 bytes

To create an instance of an object, a block of memory has to be reserved for the object's data (using either static or dynamic memory allocation). Further references to the object are done with the starting address of the memory block, the offsets obviously remain the same for each object of the same kind. The memory map defined above describes the address offsets of the member fields. Access and manipulation of the field data could then be done by adding the object's memory address and the member field's offset (pseudocode):

Object.Field = Data   ' store data at address + offset
Data = Object.Field   ' read data from address + offset

Working with Objects

Since Bascom does not support this kind of data access, own routines have to be created (read/write data for each variable type, for example the byte type):

Sub Setbyte(object As Word, Byval Offset As Word, Byval Value As Byte)
   ' calculate address + offset
   ' copy contents of Value to memory address
End Sub

Function Getbyte(object As Word, Byval Offset As Word) As Byte
   ' calculate address + offset
   ' copy contents from memory address to return value
End Function

"Interfacing" to the Bascom world needs the help of normal variables:

Dim Object As Word    ' reference to object instance; memory address

Dim Name As String * 30    ' needs to be big enough to store the string member data
Dim Birth_year As Word
Dim Height_cm As Byte

' Reserve memory 
Object = Malloc(Person_object_size)

' Fill the object with some data
Name = "John Doe"
Birth_year = 2000
Height_cm = 175
Setstring Object, Person_name, Name
Setword Object, Person_birth_year, Birth_year
Setbyte Object, Person_height_cm, Height_cm

' do some other things
' ...

' Get back the object's data
Name = Getstring(Object, Person_name)
Birth_year = Getword(Object, Person_birth_year)
Height_cm = Getbyte(Object, Person_height_cm)
Print Name; ": born in "; Birth_year; ", is measuring "; Height_cm; "cm."

Implementations of these functions for every data type can be found in the file os_memory.inc.

Member Functions

Lets expand the object definition by a function that prints the informations stored in the object (pseudocode):

Object Person
   Name As String(30)
   Birth_year As Word
   Height_cm As Byte

   Sub Print_info()
      Print Me.Name; ", "; Me.Birth_year; ", "; Me.Height_cm
   End Sub
End Object

Translated to Bascom, the sub needs to know which object it manipulates, by passing it the object reference:

Sub Print_info(byref Object As Word)
   Local Name As String * 30
   Local Birth_year As Word
   Local Height_cm As Byte
   Name = Getstring(Object, Person_name)
   Birth_year = Getword(Object, Person_birth_year)
   Height_cm = Getbyte(Object, Person_height_cm)
   Print Name; ": born in "; Birth_year; ", is measuring "; Height_cm; "cm."
End Sub

Inheritance and Polymorphism

The pseudocode-application is enhanced to manage two kinds of personal data connected to a person: one type consisting of address fields (street, city, state, ...), the other of email addresses. Since both of them still should have the same data as the person object from before, the field definitions could be copied to the second type. Instead, the person object could be extended by either the additional street address data or email address data (the abstracted objects inherit the base object):

Object Person
   Name As String(30)
   Birth_year As Word
   Height_cm As Byte

   Sub Print_info()
      Print Me.Name; ", "; Me.Birth_year; ", "; Me.Height_cm
   End Sub
End Object

Object Street_address
   Extends Person
   Street As String(50)
   Street_nr As String(5)
   City As String(20)
   State As String(30)
End Object

Object Email_address
   Extends Person
   Email As String(50)
End Object

The abstracted object definitions Street_address and Email_address each contain the fields of the base object Person (Name, Birth_year and Height_cm) as well as their own specialized fields. In other words, the abstracted object definitions contain an instance of the base object as additional member field.

Accordingly, the definitions in Bascom are extended to:

Const Person_name = 0                 ' Name string is starting at position 0
Const Person_birth_year = 31          ' year of birth is stored at position 31 (30 bytes string data + 0 terminator
Const Person_height_cm = 33           ' adding 2 bytes of previous field (word)
Const Person_object_size = 34         ' needing a total of 34 bytes

Const Street_address_person = 0            ' the first field consists of the inherited object
Const Street_address_street = Person_object_size   ' next field offset is the size of the previous field, object "Person", Street is String * 50
Const Street_address_street_nr = Person_object_size + 51
Const Street_address_city = Person_object_size + 57
Const Street_address_state = Person_object_size + 78
Const Street_address_object_size = Person_object_size + 109

Const Email_address_person = 0
Const Email_address_email = Person_object_size
Const Email_address_object_size = Person_object_size + 51

Note that the inherited object is always the first field of the abstracted object, which leads to the field offsets of the base object always beeing the same along the abstracted objects. The Name field always starts at position 0, Birth_year at position 31 and so on. Because of that, the base member function Print_info() could as well be used with objects of the type Street_address or Email_address:

Dim Personobject As Word
Dim Streetobject As Word
Dim Emailobject As Word

Dim Tempstring As String * 50
Dim Tempword As Word

Personobject = Malloc(Person_object_size)
Tempstring = "John Doe"
Setstring Personobject, Person_name, Tempstring
Tempword = 2000
Setword Personobject, Person_birth_year, Tempword

Streetobject = Malloc(Street_address_object_size)
Tempstring = "Joanne Doe"
Setstring Streetobject, Person_name, Tempstring
Tempword = 2001
Setword Streetobject, Person_birth_year, Tempword
Tempstring = "Doetown"
Setword Streetobject, Street_address_city, Tempstring


Emailobject = Malloc(Email_address_object_size)
Tempstring = "Joe Doe"
Setstring Emailobject, Person_name, Tempstring
Tempword = 1970
Setword Emailobject, Person_birth_year, Tempword
Tempstring = "joe@thedoes.com"
Setword Emailobject, Email_address_email, Tempstring

' ...

Print_info Personobject
Print_info Streetobject
Print_info Emailobject

Examples

TLSF Memory Allocator

Blocks of memory are organized in double linked lists, the corresponding data structure is located in the block header.

Single linked list

In this example, the user enters an arbitrary amount of strings into the console which are stored in a linked list. When completed, every second entry is deleted and the list is printed out again. First, here is an implementation in an OOP language, VB.net:

Module Module1
    ' Object definition
    Class ListEntry
        Public NextPtr As ListEntry     ' point to the next object in the list
        Public Size As UInt16           ' store the size of associated data
        Public Data As String           ' store the data

        ' print out information of an object
        Public Sub PrintInfo()
            Console.Write("Size: " & Size)
            Console.WriteLine(vbTab & "Text: " & Data)
        End Sub
    End Class

    ' reference to the first object in the list
    Public ListHead As ListEntry = Nothing

    ' adds an object to the single linked list
    Public Sub ListAdd(Data As String)
        Dim Entry As New ListEntry()    ' > Malloc

        Entry.NextPtr = ListHead        ' link to previous object in list
        ListHead = Entry                ' set new list head

        Entry.Size = Data.Length        ' store data size
        Entry.Data = Data               ' store data
    End Sub

    ' iterates through the list and deletes every second object
    Public Sub ListRemoveEverySecond()
        Dim Entry As ListEntry
        Dim NextEntry As ListEntry
        Dim DeleteEntry As ListEntry

        Entry = ListHead                ' begin iterating
        While Entry IsNot Nothing       ' as long as there is an object available
            DeleteEntry = Entry.NextPtr             ' get next entry which is to be deleted
            If DeleteEntry IsNot Nothing Then       ' object exists
                NextEntry = DeleteEntry.NextPtr     ' get next object in list
                Entry.NextPtr = NextEntry           ' update link from previous object
                ' garbage collection is responsible for freeing the object if there are no references to it anymore
                ' > Free DeleteObject
            Else
                NextEntry = Nothing                 ' no more objects in list
            End If
            Entry = NextEntry                       ' continue iterating
        End While
    End Sub

    ' iterates through the list and prints out information about the stored objects
    Public Sub ListPrint()
        Dim Entry As ListEntry

        Entry = ListHead                ' begin iterating
        While Entry IsNot Nothing       ' as long as there is an object available
            Entry.PrintInfo()           ' do something with the object
            Entry = Entry.NextPtr       ' continue with next list entry
        End While
    End Sub

    Sub Main()
        Dim Text As String
        Do
            Do
                Console.Write("Enter text (or ""exit""): ")
                Text = Console.ReadLine()
                If Text = "exit" Then Exit Do
                ListAdd(Text)
            Loop
            Console.WriteLine("----------------------------------")
            ListPrint()
            Console.WriteLine("----------------------------------")
            ListRemoveEverySecond()
            ListPrint()
            Console.WriteLine("----------------------------------")
        Loop
    End Sub
End Module

The same application implemented in Bascom (runs in the simulator):

$regfile = "m32def.dat"
$crystal = 16000000
$hwstack = 32
$swstack = 48
$framesize = 64
$baud = 9600

Config Submode = New
Config Com1 = Dummy , Synchrone = 0 , Parity = None , Stopbits = 1 , Databits = 8 , Clockpol = 0



' uncomment to view detailed debug output
'Const Debug_level_tlsf = 3

' Set start address of the free memory pool manually (examine compile report, "show internal variables" - setting enabled)
'Const Os_mem_start_free = 250

' include needed libraries
$include "inc\os_malloc_tlsf.inc"



' Object definition, this represents the memory layout of the object
Const List_next_ptr = 0                                     ' word (ram address), point to the next object in the list
Const List_data_size_ptr = 2                                ' byte, store the size of associated data
Const List_data_ptr = 3                                     ' string, store the data
Const List_header_size = 3                                  ' object header size (excl. data)

' print out information of an object
Sub Print_info(byref Object As Word)
   Local Size As Byte
   Size = Getbyte(object , List_data_size_ptr)
   Print "Size: " ; Size;
   Text = Getstring(object , List_data_ptr)
   Print "{009}Text: " ; Text
End Sub

' adds an object to the single linked list
Sub List_add(byref Text As String)
   Local Size As Byte
   Local Object As Word

   Size = Len(text)
   Size = Size + 1                                          ' string trailing zero byte
   Object = Size + List_header_size                         ' total memory size
   Object = Malloc(object)                                  ' try to allocate memory
   If Object = 0 Then Exit Sub                              ' check if successful

   Setword Object , List_next_ptr , List_head               ' link to previous object in list
   List_head = Object                                       ' set new list head

   Setbyte Object , List_data_size_ptr , Size               ' store data size
   Setstring Object , List_data_ptr , Text                  ' store data
End Sub

' iterates through the list and deletes every second object
Sub List_remove_every_second()
   Local Object As Word
   Local Next_object As Word
   Local Delete_object As Word

   Object = List_head                                       ' begin iterating
   While Object <> 0                                        ' as long as there is an object available
      Delete_object = Getword(object , List_next_ptr)       ' get next entry which is to be deleted
      If Delete_object <> 0 Then                            ' object exists
         Next_object = Getword(delete_object , List_next_ptr)       ' get next object in list
         Setword Object , List_next_ptr , Next_object       ' update link from previous object
         Free Delete_object                                 ' delete actual object
      Else
         Next_object = 0                                    ' no more objects in list
      End If
      Object = Next_object                                  ' continue iterating
   Wend
End Sub

' iterates through the list and prints out information about the stored objects
Sub List_print()
   Local Object As Word

   Object = List_head                                       ' begin iterating
   While Object <> 0                                        ' as long as there is an object available
      Print_info Object                                     ' do something with the object
      Object = Getword(object , List_next_ptr)              ' continue with next list entry
   Wend
End Sub



' reference to the first object in the list
Dim List_head As Word

Dim Text As String * 50

Do
   ' collect strings from the console and add to list
   Do
      Input "Enter text (or {034}exit{034}): " , Text
      If Text = "exit" Then Exit Do
      List_add Text
   Loop

   ' print out list of strings
   Print "----------------------------------"
   List_print

   ' modify list and print it out again
   Print "----------------------------------"
   List_remove_every_second
   List_print
   Print "----------------------------------"
Loop

In Bascom using the precompiler:

$regfile = "m32def.dat"
$crystal = 16000000
$hwstack = 32
$swstack = 48
$framesize = 64
$baud = 9600

Config Submode = New
Config Com1 = Dummy , Synchrone = 0 , Parity = None , Stopbits = 1 , Databits = 8 , Clockpol = 0



' uncomment to view detailed debug output
'Const Debug_level_tlsf = 3

' Set start address of the free memory pool manually (examine compile report, "show internal variables" - setting enabled)
'Const Os_mem_start_free = 250

' include needed libraries
$include "..\..\inc\os_common.inc"                          ' per default os_common.inc and os_memory.inc are included by the memory allocator and are expected
$include "..\..\inc\os_memory.inc"                          ' in the subdirectory "inc". To accomodate for the different directory structure of the samples,
                                                             ' we need to override the default includes
$include "..\..\inc\os_malloc_tlsf.inc"



' Object definition
Typedef Stringlist_item
   Next_item As Stringlist_item
   Data_size As Byte
   Stringdata As String * 1
End Typedef



' print out information of an object
Sub Print_info(byref Object As Stringlist_item)
   Local Size As Byte
   Size = Object.data_size
   Print "Size: " ; Size;
   Text = Object.stringdata
   Print "{009}Text: " ; Text
End Sub



' adds an object to the single linked list
Sub List_add(byref Text As String)
   Local Size As Byte
   Local Objectsize As Word
   Local Object As Stringlist_item

   Size = Len(text)
   Size = Size + 1                                          ' string trailing zero byte
   Objectsize = Typdefsize(stringlist_item) + Size          ' total memory size
   Object = Malloc(objectsize)                              ' try to allocate memory
   If Object = 0 Then Exit Sub                              ' check if successful

   Object.next_item = List_head
   List_head = Object                                       ' set new list head

   Object.data_size = Size
   Object.stringdata = Text
End Sub



' iterates through the list and deletes every second object
Sub List_remove_every_second()
   Local Object As Stringlist_item
   Local Next_object As Stringlist_item
   Local Delete_object As Stringlist_item

   Object = List_head                                       ' begin iterating
   While Object <> 0                                        ' as long as there is an object available
      Delete_object = Object.next_item                      ' get next entry which is to be deleted
      If Delete_object <> 0 Then                            ' object exists
         Next_object = Delete_object.next_item              ' get next object in list
         Object.next_item = Next_object                     ' update link from previous object
         Free Delete_object                                 ' delete actual object
      Else
         Next_object = 0                                    ' no more objects in list
      End If
      Object = Next_object                                  ' continue iterating
   Wend
End Sub



' iterates through the list and prints out information about the stored objects
Sub List_print()
   Local Object As Stringlist_item

   Object = List_head                                       ' begin iterating
   While Object <> 0                                        ' as long as there is an object available
      Print_info Object                                     ' do something with the object
      Object = Object.next_item                             ' continue with next list entry
   Wend
End Sub



' reference to the first object in the list
Dim List_head As Stringlist_item

Dim Text As String * 50

Do
   ' collect strings from the console and add to list
   Do
      Input "Enter text (or {034}exit{034}): " , Text
      If Text = "exit" Then Exit Do
      List_add Text
   Loop

   ' print out list of strings
   Print "----------------------------------"
   List_print

   ' modify list and print it out again
   Print "----------------------------------"
   List_remove_every_second
   List_print
   Print "----------------------------------"
Loop

Real world example: Semaphore implementation from Chronos

'(*****h* /Semaphore ***********************************************************
 * DESCRIPTION
 *    A Semaphore is an object dedicated to task communication.
 *    It has a defined count of tokens, a task can aquire one as long as there
 *    is one left. If there are no more tokens left, the queue mode action
 *    takes place. Every task can release a token.
 * SEE ALSO
 *    /Messagequeue, /Mutex, /Pipe, /Signal, /Syncpipe
')
'******** **********************************************************************


$nocompile


'(*****O* Semaphore/Os_Semaphore_header ****************************************
 * DESCRIPTION
 *    Header structure of the semaphore object
 * DECLARATION
')
Const Os_semaphore_hdr_taskqueue = 0                        ' task waiting queue
Const Os_semaphore_hdr_tokencount = Os_taskqueue_hdr_size + 0       ' available tokens
Const Os_semaphore_hdr_tokensize = Os_taskqueue_hdr_size + 1       ' configured token count
Const Os_semaphore_hdr_ownertask = Os_taskqueue_hdr_size + 2       ' task that aquired the last token owns the semaphore
Const Os_semaphore_hdr_size = Os_taskqueue_hdr_size + 4
'******** **********************************************************************



Sub Os_semaphore_create_at(memptr As Word , Byval Tokens As Byte) As Word
   Os_mem_clear Memptr , Os_semaphore_hdr_size

   Setbyte Memptr , Os_semaphore_hdr_tokensize , Tokens
   Setbyte Memptr , Os_semaphore_hdr_tokencount , Tokens
End Sub

'(*****f* Semaphore/Os_semaphore_create ****************************************
 * DESCRIPTION
 *    Creates a new semaphore object.
 * SEE ALSO
 *    Semaphore/Os_semaphore_kill
 * DECLARATION
')
Function Os_semaphore_create(byval Tokens As Byte) As Word
'(
 * SOURCE
')
   Local Semaphore As Word

   Semaphore = Malloc(os_semaphore_hdr_size)
   If Semaphore = 0 Then
      Os_semaphore_create = 0
      Exit Function
   End If
   Os_semaphore_create_at Semaphore , Tokens

   Os_semaphore_create = Semaphore
End Function
'******** **********************************************************************



'(*****f* Semaphore/Os_semaphore_kill ******************************************
 * DESCRIPTION
 *    Kills a semaphore object
 * SEE ALSO
 *    Semaphore/Os_semaphore_create
 * DECLARATION
')
Sub Os_semaphore_kill(byref Semaphore As Word)
'(
 * SOURCE
')
   If Semaphore <> 0 Then
      Os_semaphore_flush Semaphore
      Free Semaphore
   End If
End Sub
'******** **********************************************************************



'(*****f* Semaphore/Os_semaphore_aquire ****************************************
 * DESCRIPTION
 *    Tries to aquire a semaphore token. If there are no tokens left, the queue
 *    mode action takes place.
 * SEE ALSO
 *    Semaphore/Os_semaphore_release, Semaphore/Os_semaphore_flush
 * DECLARATION
')
Function Os_semaphore_aquire(byref Semaphore As Word , Byval Queuemode As Word) As Byte
'(
 * SOURCE
')
   Local Tokencount As Byte
'cli
   Os_enter_critical
   Tokencount = Getbyte(semaphore , Os_semaphore_hdr_tokencount)
   If Tokencount = 0 Then
      ' no tokens left, put in waiting list and suspend
'      Os_sched_priority_inheritance(os_task_active)
      Select Case Queuemode
      Case Os_queuemode_noblock:
         ' return error
         Os_exit_critical
         Os_semaphore_aquire = False
         Exit Function
      Case Os_queuemode_block:
         ' suspend and wait to send a message
         Os_task_suspendmode Os_task_active , Os_task_suspend_nowakeup , 0
      Case Else
         ' suspend and wait to send a message or timeout
         Os_task_suspendmode Os_task_active , Os_task_suspend_timersingleshot , Queuemode
      End Select
      Os_sched_taskqueue_insert Semaphore , Os_task_active
      'Os_exit_critical
      Os_task_suspend Os_task_active

      Os_enter_critical
      Tokencount = Getbyte(semaphore , Os_semaphore_hdr_tokencount)
      If Tokencount = 0 Then
         Os_exit_critical
         Os_semaphore_aquire = False
         Exit Function
      End If
   End If

   Decr Tokencount
   Setbyte Semaphore , Os_semaphore_hdr_tokencount , Tokencount
   Os_exit_critical
   Os_semaphore_aquire = True
End Function
'******** **********************************************************************



'(*****f* Semaphore/Os_semaphore_release ***************************************
 * DESCRIPTION
 *    Releases a semaphore token. The releasing task must not have aquired it
 *    before.
 * SEE ALSO
 *    Semaphore/Os_semaphore_aquire, Semaphore/Os_semaphore_flush
 * DECLARATION
')
Sub Os_semaphore_release(byref Semaphore As Word)
'(
 * SOURCE
')
   Local Tokencount As Byte
   Local Tokensize As Byte
   Local Task As Word
   Os_enter_critical
   Tokencount = Getbyte(semaphore , Os_semaphore_hdr_tokencount)
   Tokensize = Getbyte(semaphore , Os_semaphore_hdr_tokensize)

   If Tokencount < Tokensize Then
      ' release a token
      Incr Tokencount
      Setbyte Semaphore , Os_semaphore_hdr_tokencount , Tokencount
      ' let any waiting task aquire the released token
      Task = Os_sched_taskqueue_remove(semaphore)
      Os_exit_critical
      If Task <> 0 Then
         Os_task_event Task
      End If
   Else
      Os_exit_critical
   End If
End Sub
'******** **********************************************************************



'(*****f* Semaphore/Os_semaphore_flush *****************************************
 * DESCRIPTION
 *    Releases all semaphore tokens. The releasing task must not have aquired it
 *    before. All tasks from the waiting list are put to ready state.
 * SEE ALSO
 *    Semaphore/Os_semaphore_aquire, Semaphore/Os_semaphore_release
 * DECLARATION
')
Sub Os_semaphore_flush(byref Semaphore As Word)
'(
 * SOURCE
')
   Local Tokensize As Byte
   Local Task As Word

   ' reset tokens
   Os_enter_critical
   Tokensize = Getbyte(semaphore , Os_semaphore_hdr_tokensize)
   Setbyte Semaphore , Os_semaphore_hdr_tokencount , Tokensize
   Os_exit_critical

   ' resume all tasks waiting in the list
   Do
      Os_enter_critical
      Task = Os_sched_taskqueue_remove(semaphore)
      Os_exit_critical
      If Task = 0 Then Exit Do
      Os_task_event Task
   Loop
End Sub
'******** **********************************************************************

Download

• Memory Allocators & Precompiler Package 1.0