Object Oriented Programming in Bascom
Aus ProjectWiki
Inhaltsverzeichnis
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
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:
$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
'******** **********************************************************************
