Object Oriented Programming

[Edwin Knoppert]

Just a remark..

One can always write a preprocessor by renaming the current compiler's name and handle classes by parsing the code.
This could be done by copying code to a temp include and pass a new main.bas to the compiler.

I did this once in one of my tools and used a PB's dispatch object.
But than.. this syntax is not making it any easier at this time.

You may consider an ordinary vtable and find some way for destruction of data when getting out of scope.
Not easy..

[Charles Pegge]

I've tried the preprocessior approach as well, but it is not satisfactory for debugging since there is an extra layer of code to deal with.

For higher level language expresive capability, ultimately, I think you have to take the scripting approach. C++ has proven to be extremely messy for handling complex objects, (as Microsoft knows!)

[Kent Sarikaya]

@Jose Your descrition of COM is so much easier to understand than the pages at MSDN, thanks so much.  From reading your reply it sounds like we can make our own COM object. In reading powerBasic's help on COM it sounded like we can only use existing COM objects but not make any?

@Charles Thanks your examples really show the power in powerbasic that as new user can't see. All of your examples are really opening my eyes to what can be done and also shows me so much about c++ that is like magic to me, that is hidden. Now I can see how this all sort of works behind the scenes and how we can tap into it. It is like learning to program again, very exciting new frontiers for me!

Comment First a brief history to put my comments into perspective: I took a class of Fortran in College (1978), got hooked on computers and programming, but because I was not a computer major would not touch or have a computer till the early 1980's and I was able to buy a VIC 20. With that and later the Commodore 64 I was into BASIC and really enjoyed it.
Also in those years I also bought numerous other computers but all were with BASIC languages and fun. I then stepped up to the Macintosh Plus and got into graphic publishing as a business ad came upon HyperCard and HyperTalk, this was the world of object oriented programming that was so logical and magical. Things worked like you would imagine them to work.

Then I bought a PC in the early 1990's and bought Turbo C, was having fun with it, but it was so much work compared to what i could do with hypertalk. It seemed like a real step back in programming and I sort of stopped programming till Visual Basic came on the scene. Then I got back into it and used Visual Basic all the way up to version 5.

By then my inner urge to write a truly difficult game came to forefront and I decided to buckle down and learn c++ and object oriented programming. Well again, compared to how things in hypercard and hypertalk worked c++ was too much work and not enough reward to seem logical to me. I just couldn't understand how in almost 10 years the world of OOP actually seemed to go backwards instead of forwards.

Ok now the comment/opinion: It just seems that object oriented programming should be that. You make an object, this self contained black box. This black box should be able to talk to other black boxes without us having to tell it how to. Since each black box knows totally what it is, what it can do and how it needs to be interfaced, it should be able to tell other black boxes or the compiler how to work with it.

It is funny, when I first heard of XML and all the praise for it and descriptions of what it was, it sounded like a text version of this magic black box. I was all excited. But it turns out it is nothing more than a glorified ini file in the end. It is nice and all but it fell way short of my expectations of it.

I think COM comes close to the way things should be, other than the fact that the interface is not totally automatic and the coder still has to write so much to interface with it to use it.

It just seems that the compiler should do one pass through the code to see what is in there. Build a table of calls to outside functions, com objects etc and free the programmer from ever having to include header files, declarations etc. On this first pass the compiler could see what is in the code and then see if it is an internal component or external and then do the necessary look ups to know what to include and declare. It could easily build an index file of all include files and com objects and even dll procedures ahead of time and reference that during the build in this first step. Then it could go about in subsequent passes working as it does now.

I agree the way c++ does classes is not good at all. Too much almost duplicate work has to be done before you can even begin to start using a class.

I hope that powerBasic when it does go to OOP, tries to go with a very clean solution and newer approach, which is actually not that new as it existed in the 1980's with hypertalk and I am assuming in SmallTalk.

Again thanks for all of this help and code examples. I am in heaven studying and thinking about this stuff!

[José Roca]

 
Don't put your hopes too high. Many of us have chosen PB fleeing from OOP languages. COM is not OOP, although you can use COM classes to do some limited OOP programming. Personally, I'm interested in low-level COM programming. Native support for direct interface calls will allow me to do it without having to write wrappers.

[Kent Sarikaya]

Thanks again guys for the examples and explanations. I will enjoy going over these and referring to these for some time to come.

[Charles Pegge]

Using OOP techniques with Strings and Inline Assembler

Doing OOP in assembler is really easy - the coding is much simpler than struggling
with BASIC syntax.

I have used the ECX register to hold the object's pointer at all times. Note how the indirect calls with the virtual table are handled.

Code Select Expand



' some Assembler OOP using Powerbasic ver 8
' using dynamic objects made with strings
' Charles E V Pegge
' 23 July 2007


#COMPILE EXE
#DIM ALL


' DEFINE THE STRUCTURE OF THE GENERIC CLASS
TYPE GenericClass
constructor AS LONG PTR
destructor  AS LONG PTR
' make 4 additional methods available
m1          AS LONG PTR
m2          AS LONG PTR
m3          AS LONG PTR
m4          AS LONG PTR
ObjectSize  AS LONG
' make 4 static class members for general use eg tallying objects created
p1          AS LONG
p2          AS LONG
p3          AS LONG
p4          AS LONG
' etc ....
END TYPE

' DEFINE THE STRUCTURE OF THE GENERIC OBJECTS
TYPE GenericObject
vtable AS LONG PTR ' points to table of methods (in class structure)
' static members
sa AS LONG
sb AS LONG
sc AS LONG
sd AS LONG
se AS LONG
sf AS LONG
' .... etc
END TYPE

'-------------------------'
                          '  PROTOCOL USED:
' SOME METHODS            '  assume ecx holds THIS pointer
                          '  parameters in eax and ebx
                          '  result in eax
SUB creates()             '
#REGISTER NONE            '
! xor eax,eax             ' zero eax
! mov [ecx+04],eax        ' copy zero into the four static members
! mov [ecx+08],eax        '
! mov [ecx+12],eax        '
! mov [ecx+16],eax        '
END SUB                   '
                          '
SUB destroys()            ' anything you need to do before nylling the object
#REGISTER NONE            '
END SUB                   '
                          '
SUB adds()                '
#REGISTER NONE            '
! add eax,ebx            '
! mov [ecx+4],eax        ' store in MyObject.sa
END SUB                   '
                          '
SUB subtracts()           '
#REGISTER NONE            '
! sub eax,ebx            '
! mov [ecx+4],eax        ' store in MyObject.sa
END SUB                   '
                          '
SUB multiplies()          ' assumes long result
#REGISTER NONE            '
! mul ebx                '
! mov [ecx+4],eax        ' store in MyObject.sa
END SUB                   '
                          '
SUB divides()             '
#REGISTER NONE            '
! xor edx,edx            ' null the upper long
! div ebx                '
! mov [ecx+4],eax        ' store in MyObject.sa
END SUB                   '
                          '
                          '
FUNCTION PBMAIN()         '
                          '
#REGISTER NONE            ' avoid clash with compiler
                          '
'-------------------------'
'BASIC INTEGER VARIABLES  '
DIM pt AS BYTE PTR        ' general pointer
DIM cp AS BYTE PTR        ' class pointer
DIM ans AS LONG           ' result to display
DIM stm AS LONG           ' static member result to display
                          '
'-------------------------'
'CREATE CLASS             '
DIM MyClass AS STRING    ' to hold the class
MyClass=NUL$(SIZEOF(GenericClass))
cp=STRPTR(MyClass)       ' address of the class
! mov edx,cp             ' fill class with function adresses
pt=CODEPTR(creates)      ' constructor procedure
! mov eax,pt             '
! mov [edx],eax          '
pt=CODEPTR(destroys)     ' destructor procedure
! mov eax,pt             '
! mov [edx+04],eax       '
pt=CODEPTR(adds)         ' adds
! mov eax,pt             '
! mov [edx+08],eax       '
pt=CODEPTR(subtracts)    ' subtracts
! mov eax,pt             '
! mov [edx+12],eax       '
pt=CODEPTR(multiplies)   ' multiplies
! mov eax,pt             '
! mov [edx+16],eax       '
pt=CODEPTR(divides)      ' divides
! mov eax,pt             '
! mov [edx+20],eax       '
pt=SIZEOF(GenericObject) ' this is used when allocting string space for an object
! mov eax,pt             '
! mov [edx+24],eax       ' store it here after all the function addresses
                          '
                          '
'-------------------------'
'CREATE OBJECT            '
cp=STRPTR(MyClass)        '
DIM MyObject AS STRING    '
MyObject=NUL$(@cp[24])    ' create object string with size specified in class @24
pt=STRPTR(MyObject)       ' get address of object
! mov ecx,pt              ' and keep it in ecx whenever call a method
! mov eax,cp              ' get the class address
! mov [ecx],eax           ' store it at the start of the object
! mov esi,[ecx]           ' setup the class table location in esi
! call dword ptr [esi]    ' call at the first address in the table
                          '
'-------------------------'
'CALL OBJECT METHOD       '
! mov eax,7               ' first parameter
! mov ebx,3               ' second parameter
! mov ecx,pt              ' THIS object pointer
! mov esi,[ecx]           ' get address of class vtable
! call dword ptr [esi+16] ' call at the fifth address in the table for multiplies
! mov ans,eax             ' store result for the message box
                          '
'-------------------------'
'ACCESS STATIC MEMBER     ' to display it in the message box:
! mov ecx,pt              ' pointer to object
! mov eax,[ecx+04]        ' MyObject.sa
! mov stm,eax             ' store it here for the message box
                          '
MSGBOX STR$(ans)+"    "+STR$(stm)
                          '
'-------------------------'
'DESTROY OBJECT           '
! mov ecx,pt              '
! mov esi,[ecx]           '
! call dword ptr [esi+04] ' address for the destroys procedure
pt=0:MyObject=""          ' null the pointer and the string
                          '
'-------------------------'
'DESTROY CLASS            '
cp=0:MyClass=""           ' null the pointer and the string

END FUNCTION



[Kent Sarikaya]

Thanks Charles for another incredible example. I will really look into this today and see if I can understand it. Just glancing through it, it sure doesn't look too scary.

[Donald Darden]

I think one of the benefits of this thread is that it shows that there is nothing
really magical about OOP or COM, and that efforts to learn to approach the subject in the primitive manner currently necessary with PowerBasic is actually good, because you really get a handle on what is going on behind the scenes.  Now whether that will actually translate into better code is another question, but this type of knowledge and insight is hard to come by, so the discussion really makes for time well spent.

[José Roca]

 
Neither .NET, whose runtime is just a low-level COM server. Here is a test that I wrote some time ago. It hosts the .NET runtime, creates an instance of the System.Collections.Stack class and calls its Push and Pop methods using COM Automation. It needs the .NET Framework 1.1. Eventually, I will do more tests using the .NET Framework 2.0, that has more complete hosting interfaces.

Code Select Expand


' ========================================================================================
' Demonstrates how to host the .NET Framework runtime, create an instance of an assembly
' and call its methods and properties using PB Automation.
' Note: Do not use it with the .NET Framework 2.0 because this version uses the
' ICLRRuntimeHost interface instead of ICorRuntimeHost.
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"

$CLSID_AppDomain = GUID$("{5FE0A145-A82B-3D96-94E3-FD214C9D6EB9}")
$IID__AppDomain = GUID$("{05F696DC-2B29-3663-AD8B-C4389CF2A713}")

' ========================================================================================
' Enables unmanaged hosts to load the common language runtime (CLR) into a process.
' ========================================================================================
DECLARE FUNCTION CorBindToRuntimeEx LIB "mscoree.dll" ALIAS "CorBindToRuntimeEx" ( _
   BYVAL pwszVersion AS DWORD _       ' [in] A string describing the version of the CLR you want to load.
, BYVAL pwszBuildFlavor AS DWORD _   ' [in] A string that specifies whether to load the server or the workstation build of the CLR. Valid values are svr and wks.
, BYVAL flags AS DWORD _             ' [in] A combination of values of the STARTUP_FLAGS enumeration.
, BYREF rclsid AS GUID _             ' [in] The CLSID of the coclass that implements the ICorRuntimeHost interface.
, BYREF riid AS GUID _               ' [in] The IID of the requested interface from rclsid.
, BYREF ppv AS DWORD _               ' [out] The returned interface pointer to riid.
) AS LONG
' ========================================================================================

' ========================================================================================
' The IUnknown interface lets clients get pointers to other interfaces on a given object
' through the QueryInterface method, and manage the existence of the object through the
' AddRef and Release methods. All other COM interfaces are inherited, directly or
' indirectly, from IUnknown. Therefore, the three methods in IUnknown are the first
' entries in the VTable for every interface.
' ========================================================================================

' ========================================================================================
' QueryInterface method
' Returns a pointer to a specified interface on an object to which a client currently
' holds an interface pointer. You must release the returned interface, when no longer
' needed, with a call to the Release method.
' ========================================================================================
FUNCTION IUnknown_QueryInterface (BYVAL pthis AS DWORD PTR, BYREF riid AS GUID, BYREF ppvObj AS DWORD) AS LONG
   LOCAL HRESULT AS LONG
   IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
   CALL DWORD @@pthis[0] USING IUnknown_QueryInterface (pthis, riid, ppvObj) TO HRESULT
   FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' AddRef method
' Increments the reference count for an interface on an object. It should be called for
' every new copy of a pointer to an interface on a given object.
' ========================================================================================
FUNCTION IUnknown_AddRef (BYVAL pthis AS DWORD PTR) AS DWORD
   LOCAL DWRESULT AS LONG
   IF pthis = %NULL THEN EXIT FUNCTION
   CALL DWORD @@pthis[1] USING IUnknown_AddRef (pthis) TO DWRESULT
   FUNCTION = DWRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Release method
' Decrements the reference count for the calling interface on a object. If the reference
' count on the object falls to 0, the object is freed from memory.
' ========================================================================================
FUNCTION IUnknown_Release (BYVAL pthis AS DWORD PTR) AS DWORD
   LOCAL DWRESULT AS DWORD
   IF pthis = %NULL THEN EXIT FUNCTION
   CALL DWORD @@pthis[2] USING IUnknown_Release (pthis) TO DWRESULT
   FUNCTION = DWRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Puts the address of an object in a variant and marks it as containing a dispatch variable
' ========================================================================================
SUB TB_MakeDispatchVariant (BYVAL lpObj AS DWORD, BYREF vObj AS VARIANT)
  LOCAL lpvObj AS VARIANTAPI PTR                 ' Pointer to a VARIANTAPI structure
  vObj = EMPTY                                   ' Make sure is empty to avoid memory leaks
  lpvObj = VARPTR(vObj)                          ' Get the VARIANT address
  @lpvObj.vt = %VT_DISPATCH                      ' Mark it as containing a dispatch variable
  @lpvObj.vd.pdispVal = lpObj                    ' Set the dispatch pointer address
  IF lpObj THEN IUnknown_AddRef lpObj            ' Increase the reference count
END SUB
' ========================================================================================

' ========================================================================================
' ICorRuntimeHost interface
' Provides methods that enable the host to start and stop the common language runtime
' (CLR) explicitly, to create and configure application domains, to access the default
' domain, and to enumerate all domains running in the process.
' ========================================================================================

$CLSID_CorRuntimeHost = GUID$("{CB2F6723-AB3A-11D2-9C40-00C04FA30A3E}")
$IID_ICorRuntimeHost = GUID$("{CB2F6722-AB3A-11D2-9C40-00C04FA30A3E}")

' ========================================================================================
' Start method
' Starts the CLR.
' ========================================================================================
FUNCTION ICorRuntimeHost_Start (BYVAL pthis AS DWORD PTR) AS LONG
   LOCAL HRESULT AS LONG
   IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
   CALL DWORD @@pthis[10] USING ICorRuntimeHost_Start (pthis) TO HRESULT
   FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Stop method
' Stops the execution of code in the runtime for the current process.
' ========================================================================================
FUNCTION ICorRuntimeHost_Stop (BYVAL pthis AS DWORD PTR) AS LONG
   LOCAL HRESULT AS LONG
   IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
   CALL DWORD @@pthis[11] USING ICorRuntimeHost_Stop (pthis) TO HRESULT
   FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' GetDefaultDomain method
' Gets an interface pointer of type _AppDomain that represents the default domain for the
' current process.
' ========================================================================================
FUNCTION ICorRuntimeHost_GetDefaultDomain (BYVAL pthis AS DWORD PTR, BYREF pAppDomain AS DWORD) AS LONG
   LOCAL HRESULT AS LONG
   IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
   CALL DWORD @@pthis[13] USING ICorRuntimeHost_GetDefaultDomain (pthis, pAppDomain) TO HRESULT
   FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Interface name = _AppDomain
' IID = {05F696DC-2B29-3663-AD8B-C4389CF2A713}
' Attributes = 256 [&H100] [Oleautomation]
' Inherited interface = IUnknown
' ========================================================================================

' ========================================================================================
' CreateInstance method
' Interface name = _AppDomain
' VTable offset = 148 [&H94]
' DispID = 1610678306 [&H60010022]
' ========================================================================================
FUNCTION System_AppDomain_CreateInstance ( _
    BYVAL pthis AS DWORD PTR _                          ' %VT_UNKNOWN <interface>
  , BYVAL AssemblyName AS STRING _                      ' %VT_BSTR <DYNAMIC UNICODE STRING> [in]
  , BYVAL typeName AS STRING _                          ' %VT_BSTR <DYNAMIC UNICODE STRING> [in]
  , BYREF pRetVal AS DWORD _                            ' **_ObjectHandle <dispinterface> [out]
    ) AS LONG                                           ' %VT_HRESULT <LONG>

    LOCAL HRESULT AS LONG
    AssemblyName = UCODE$(AssemblyName)
    typeName = UCODE$(typeName)
    IF pthis = 0 THEN FUNCTION = %E_POINTER : EXIT FUNCTION
    CALL DWORD @@pthis[37] USING System_AppDomain_CreateInstance(pthis, AssemblyName, typeName, pRetVal) TO HRESULT
    FUNCTION = HRESULT

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   LOCAL hr AS LONG
   LOCAL CLSID_CorRuntimeHost AS GUID
   LOCAL IID_ICorRuntimeHost AS GUID
   LOCAL IID__AppDomain AS GUID
   LOCAL wszFlavor AS STRING
   LOCAL pHost AS DWORD
   LOCAL pUnk AS DWORD
   LOCAL pDomain AS DWORD
   LOCAL pObjectHandle AS DWORD
   LOCAL vObjectHandle AS VARIANT
   LOCAL oObjectHandle AS DISPATCH
   LOCAL pStack AS DWORD
   LOCAL vStack AS VARIANT
   LOCAL oStack AS DISPATCH
   LOCAL vRes AS VARIANT
   LOCAL vPrm AS VARIANT
   LOCAL strOutput AS STRING

   wszFlavor = UCODE$("wks" & $NUL)
   CLSID_CorRuntimeHost = $CLSID_CorRuntimeHost
   IID_ICorRuntimeHost = $IID_ICorRuntimeHost
   IID__AppDomain = $IID__AppDomain

   DO
      ' Retrieve a reference to the ICorRuntimeHost interface
      hr = CorBindToRuntimeEx(%NULL, STRPTR(wszFlavor), %NULL, _
           CLSID_CorRuntimeHost, IID_ICorRuntimeHost, pHost)
      IF hr <> %S_OK THEN EXIT DO
      ' Start the runtime (this also creates a default AppDomain)
      hr = ICorRuntimeHost_Start(pHost)
      IF hr <> %S_OK THEN EXIT DO
      ' Get the default AppDomain created when we called Start
      hr = ICorRuntimeHost_GetDefaultDomain(pHost, pUnk)
      IF hr <> %S_OK THEN EXIT DO
      ' Ask for the _IAppDomain interface
      hr = IUnknown_QueryInterface(pUnk, IID__AppDomain, pDomain)
      IF hr <> %S_OK THEN EXIT DO
      ' Create an instance of the Stack collection
      hr = System_AppDomain_CreateInstance(pDomain, "mscorlib", "System.Collections.Stack", pObjectHandle)
      IF hr <> %S_OK THEN EXIT DO
      ' Cast the pObjectHandle pointer to a dispatch object variable
      TB_MakeDispatchVariant pObjectHandle, vObjectHandle
      SET oObjectHandle = vObjectHandle
      vObjectHandle = EMPTY
      IUnknown_Release pObjectHandle
      IF ISFALSE ISOBJECT(oObjectHandle) THEN EXIT DO
      ' Unwrap the object
      OBJECT CALL oObjectHandle.Unwrap TO vStack
      SET oStack = vStack
      vStack = EMPTY
      IF ISFALSE ISOBJECT(oStack) THEN EXIT DO
      ' Push and Pop some strings, just to see if it works
      vPrm = "rocks!"
      OBJECT CALL oStack.Push(vPrm)
      vPrm = "PB"
      OBJECT CALL oStack.Push(vPrm)
      OBJECT CALL oStack.Pop TO vRes
      strOutput = VARIANT$(vRes)
      OBJECT CALL oStack.Pop TO vRes
      strOutput = strOutput & " " & VARIANT$(vRes)
      MSGBOX strOutput
      ' Stops execution of code in the runtime
      ICorRuntimeHost_Stop pHost
      EXIT DO
   LOOP

   IF hr THEN MSGBOX "Error = &H" & HEX$(hr)

   ' Cleanup
   IF ISTRUE ISOBJECT(oStack) THEN SET oStack = NOTHING
   IF ISTRUE ISOBJECT(oObjectHandle) THEN SET oObjectHandle = NOTHING

   IF pDomain THEN IUnknown_Release pDomain
   IF pUnk THEN IUnknown_Release pUnk
   IF pHost THEN IUnknown_Release pHost

END FUNCTION
' ========================================================================================


[Edwin Knoppert]

I am interested in v2 support.
Would be nice to evt. enhance my PwrDev!

[Edwin Knoppert]

Awesome!

[Edwin Knoppert]

Would be nice to have an object browser for this fella

[José Roca]

 
My TypeLib Browser works. However, for the classes you won't see much because they have dispatch interfaces with dynamic properties and can only be called using late binding.

[Edwin Knoppert]

Not a problem if i embed it into PwrDev right?

Would like to know how you used/find out about .unwrap ??

At first i thought:
hr = System_AppDomain_CreateInstance(pDomain, "mscorlib", "System.Collections.Stack", pObjectHandle)

Was similar to:
#using "System.Collections.Stack"

But is in fact:
#using "System.Collections"
Stack is the class..
How about creating such classes where the constructor has overloads?
(We do use them a lot)

[Edwin Knoppert]

FYI, webmatrix has a classbrowser GUI:

http://www.asp.net/webmatrix/