Hi guys,
I know powerbasic doesn't support OOP. But from readings on other forums(aurora, freebasic and others), and in articles on the web. I know that object oriented programming in the end comes down into code that is procedural and that procedural languages could mimic OOP features.
Has anyone done an example in powerbasic. For example I guess the methods in a class are just procedures with a pointer look up table in the structure of the members. I read that but I don't understand how using the pointer from that table in the structure that you can actually call the procedure and pass it the parameters using the dot notation as you can with c++.
So if anyone has a nice simple example maybe showing the c++ version and the powerbasic oop emulation, I sure would love to study it.
Thanks.
Kent
Hi Kent,
I hope this will answer at least half of your question. There is no attempt to diguise the clunkiness of this technique, but I am sure you can make it more palatable with macros etc. This is OOP in the raw.
I defer to José's expertise on this subject because he has translated so much C++ stuff and of course COM is a particular form of OOP.
' some ver basic OOP for Powerbasic ver 8
' Charles E V Pegge
' 21 July 2007
#COMPILE EXE
#DIM ALL
' define a class
TYPE MyClass
vtable AS LONG PTR ' pointer to the virtual table of methods for this class
a AS LONG ' static members of objects in this class
b AS LONG '
c AS LONG '
END TYPE
' Create some virtual methods including a creator if reuired.
FUNCTION MyMethod0(BYREF this AS MyClass, BYVAL x AS LONG , BYVAL y AS LONG) AS LONG
'creator method
' sets initial property values
this.a=10
this.b=x
this.c=y
FUNCTION=0
END FUNCTION
FUNCTION MyMethod1(BYREF this AS MyClass, BYVAL x AS LONG , BYVAL y AS LONG) AS LONG
this.a=x+y
FUNCTION=this.a
END FUNCTION
FUNCTION MyMethod2(BYREF this AS MyClass, BYVAL x AS LONG , BYVAL y AS LONG) AS LONG
this.a=x-y
FUNCTION=this.a
END FUNCTION
FUNCTION MyMethod3(BYREF this AS MyClass, BYVAL x AS LONG , BYVAL y AS LONG) AS LONG
this.a=x*y
FUNCTION=this.a
END FUNCTION
FUNCTION MyMethod4(BYREF this AS MyClass, BYVAL x AS LONG , BYVAL y AS LONG) AS LONG
this.a=x/y
FUNCTION=this.a
END FUNCTION
FUNCTION PBMAIN () AS LONG
' Set up the methods virtual table for MyClass
DIM MyMethods(10) AS LONG PTR
MyMethods(0)=CODEPTR(MyMethod0)
MyMethods(1)=CODEPTR(MyMethod1)
MyMethods(2)=CODEPTR(MyMethod2)
MyMethods(3)=CODEPTR(MyMethod3)
MyMethods(4)=CODEPTR(MyMethod4)
'create an object
DIM MyObject AS MyClass
DIM pt AS LONG PTR
MyObject.vtable=VARPTR(MyMethods(0))
' call the creator method to set initial values
pt=MyObject.@vtable[0]: CALL DWORD pt USING MyMethod0(MyObject,2,3)
'call a method
DIM ans AS LONG
pt=MyObject.@vtable[3]: CALL DWORD pt USING MyMethod3(MyObject,2,3) TO ans
'display results which should be the same
MSGBOX STR$(ans)+" "+STR$(MyObject.a)
END FUNCTION
A COM class that inherits directly from IUnknown isn't much different, excepting
that COM uses double indirection. A COM Automation class is more involved. The attached file includes one that wraps the Open/Save File Dialog API functions and an small example that uses it.
The combrowser for the lcc compiler creates defines like:
#define ICalendar_get_Day(ip, p1) (ip)->lpVtbl->get_Day(ip, p1)
I am not sure if PB can use this for a macro such as:
macro ICalendar_get_Day(ip, p1) = ip.pVtbl.get_Day(ip, p1)
But i don't think so.
In my example, the double indirection has been disguised :)
Indirection is such a brain-teaser.
These lines are equivalent:
pt=MyObject.@vtable[3]: CALL DWORD pt USING MyMethod3(MyObject,2,3) TO ans
pt=VARPTR(MyObject):f=@@pt[3]:CALL DWORD f USING MyMethod3(MyObject,2,3) TO ans
>pt=VARPTR(MyObject):f=@@pt[3]:CALL DWORD f USING MyMethod3(MyObject,2,3) TO ans
I guess this one can be put in a macro(?)
Usually the syntax: If 'the macro here' = 1 then .. fails.
Sorry but i think PB does not show much effort to implement classes and at least update the annoying com syntax..
Oh well, why should i be concerned with this language at all..
Pffft..
Quote
Sorry but i think PB does not show much effort to implement classes and at least update the annoying com syntax..
You already know that PB doesn't talk about which features will be incorporated in the new versions of the compilers. So you don't know...
I think this is the best we can do with PB macros:
MACRO multiply(MyObject,a,b,ans)
pt=MyObject.@vtable[3]: CALL DWORD pt USING MyMethod3(MyObject,a,b) TO ans
END MACRO
....
multiply(MyObject,2,3,ans)
The problem is such macros have global scope which limits their usefulness
in oop programming.
Guys thank you so much for the examples and discussion. I am in the mood to study tonight, so I am very happy. Thanks for all the material. I hope it all makes sense in my mind so I get a clear picture of how all of this works behind the scenes.
Thanks so much!!
Quote from: Charles Pegge on July 21, 2007, 11:02:26 PM
Hi Kent,
I hope this will answer at least half of your question. There is no attempt to diguise the clunkiness of this technique, but I am sure you can make it more palatable with macros etc. This is OOP in the raw.
I defer to José's expertise on this subject because he has translated so much C++ stuff and of course COM is a particular form of OOP.
' some ver basic OOP for Powerbasic ver 8
' Charles E V Pegge
' 21 July 2007
#COMPILE EXE
#DIM ALL
' define a class
TYPE MyClass
vtable AS LONG PTR ' pointer to the virtual table of methods for this class
a AS LONG ' static members of objects in this class
b AS LONG '
c AS LONG '
END TYPE
' Create some virtual methods including a creator if reuired.
FUNCTION MyMethod0(BYREF this AS MyClass, BYVAL x AS LONG , BYVAL y AS LONG) AS LONG
'creator method
' sets initial property values
this.a=10
this.b=x
this.c=y
FUNCTION=0
END FUNCTION
FUNCTION MyMethod1(BYREF this AS MyClass, BYVAL x AS LONG , BYVAL y AS LONG) AS LONG
this.a=x+y
FUNCTION=this.a
END FUNCTION
FUNCTION MyMethod2(BYREF this AS MyClass, BYVAL x AS LONG , BYVAL y AS LONG) AS LONG
this.a=x-y
FUNCTION=this.a
END FUNCTION
FUNCTION MyMethod3(BYREF this AS MyClass, BYVAL x AS LONG , BYVAL y AS LONG) AS LONG
this.a=x*y
FUNCTION=this.a
END FUNCTION
FUNCTION MyMethod4(BYREF this AS MyClass, BYVAL x AS LONG , BYVAL y AS LONG) AS LONG
this.a=x/y
FUNCTION=this.a
END FUNCTION
FUNCTION PBMAIN () AS LONG
' Set up the methods virtual table for MyClass
DIM MyMethods(10) AS LONG PTR
MyMethods(0)=CODEPTR(MyMethod0)
MyMethods(1)=CODEPTR(MyMethod1)
MyMethods(2)=CODEPTR(MyMethod2)
MyMethods(3)=CODEPTR(MyMethod3)
MyMethods(4)=CODEPTR(MyMethod4)
'create an object
DIM MyObject AS MyClass
DIM pt AS LONG PTR
MyObject.vtable=VARPTR(MyMethods(0))
' call the creator method to set initial values
pt=MyObject.@vtable[0]: CALL DWORD pt USING MyMethod0(MyObject,2,3)
'call a method
DIM ans AS LONG
pt=MyObject.@vtable[3]: CALL DWORD pt USING MyMethod3(MyObject,2,3) TO ans
'display results which should be the same
MSGBOX STR$(ans)+" "+STR$(MyObject.a)
END FUNCTION
Charles your example is awesome. So far, it is the one I started to study first. I can follow everything and it really does help in putting all of this OOP stuff into perspective.
I am just confused with this part at the moment, as I am trying to see how the compiler would do all of this on its own in terms of the logic.
I will label this PART A:
DIM MyMethods(10) AS LONG PTR
MyMethods(0)=CODEPTR(MyMethod0)
MyMethods(1)=CODEPTR(MyMethod1)
MyMethods(2)=CODEPTR(MyMethod2)
MyMethods(3)=CODEPTR(MyMethod3)
MyMethods(4)=CODEPTR(MyMethod4)
This part above does not tie the information to the myclass structure.
It seems to me like somehow the above could be in:
This will be PART B
TYPE MyClass
vtable AS LONG PTR ' pointer to the virtual table of methods for this class
a AS LONG ' static members of objects in this class
b AS LONG '
c AS LONG '
END TYPE
In the vtable member of PART B, Is there a more direct way that you can think of to write it as an array member with long ptrs or as codeptrs?
I guess my confusion is in how would the compiler know to make PART A on its own and to tie it into PART B as in your great example? It just seems to keep track of everything it would be more direct, this all from guessing and a sense of intuition, not from anything I read so I could be just way off in my feelings about it.
But your example has taken my out of the darkness I was in, in even beginning to even see a glimpse of the picture. Now I see the picture and appreciate it, just asking about details now :)
Thanks again!!
Now onto study the other examples.
Now I see that the latter posts sort of cleared what my confusion was. The indirection mind melting code actually is what I was looking for but couldn't phrase it.
When you see it, it makes more sense to me. So if we went that route, then there would be no need for PART A, is this correct?
Also I know this is code was for a variable after it is declared, but couldn't the code be in PART B of the example above?
pt=VARPTR(MyObject):f=@@pt[3]:CALL DWORD f USING MyMethod3(MyObject,2,3) TO ans
That is the methods would be pointed to within the structure and when a variable is instanced, it would know to assign that method as classes do in oop languages?
How is that part handled behind the scenes, I guess is another way to ask it?
This is really awesome if you ask me. After I just purchased powerBasic, I was sort of dismayed by its age and way of doing things. But knowing that things like this can be done. I can see putting the time to really work with it.
Now to study Jose's COM code sample!
Jose, I can ask too many questions about your example, but I won't do that. I will read up on COM and how powerbasic interfaces to it before I get back to you.
The little I have read about COM, it sounds good to me. Perhaps the way all objects should be written and then used, but this is just from brief readings about it and not in depth study.
I will read into it more tonight, just wanted to comment back so you know why I am not asking about your example more. Thanks so much for that example, lots to look at and to help figure out things as I read up on it!
I just read through MSDN about COM and came back to look at Jose's example. If this statement is correct I would assume I am heading the right direction in understanding, otherwise I am still lost in the woods :)
In looking at TB_OpenSaveDlg.inc, it seems that this code would be sort of the readable step that a compiler would do behind the scenes when it ran across a Class in c++ and started to do its work, is this correct?
Well, my example just shows a way to do it, but the implementation is free. COM specifies that you have to build a virtual table, that is an array of pointers to the methods and properties of the object, and that you have to return the address of a pointer, i.e. a pointer to a pointer, to this table. For a dispatch interface, it also specifies that the first seven methods must be the three IUnknown methods (QueryInterface, AddRef and Release) and the four IDIspatch methods (GetTypeInfoCount, GetTypeInfo, GetIDsOfNames and Invoke), and also specifies what these methods must do, but not how to do it: this is your business.
A dual interface allows both to call the methods and properties (procedures and functions) directly, in the same way as shown in Charles example or in my libraries of wrapper functions, or through the Invoke method (Automation). When you use OBJECT CALL oOsfn.ShowSave TO vRes, it is not the TB_OpenSaveFileName_ShowSave function which is called, but TB_OpenSaveFileName_Invoke, and this function will call TB_OpenSaveFileName_ShowSave. To call the function directly with PB, you will have to use CALL DWORD.
Automation only languages such Visual Basic don't implement Invoke in the same way as I have done, but built a sort of internal type library and delegate to the standard implementation of Invoke built in the Microsoft COM library. I know how to do it, but it is too cumbersome to be done by hand, it is a task for the compiler.
In short, COM specifies a set of rules, but every compiler implements them in his own way. As PB currently doesn't have support for classes, we have to write all the code needed to implement the virtual table, the seven standard methods of a dispatch interface, code to allocate and free the memory used by the object, etc. Otherwise, we could write something like:
CLASS MyClass : IDispatch
METHOD Somemethod (list of parameters) AS LONG
--- some code
END METHOD
--- more methods and properties
END CLASS
And the compiler will do the rest.
A COM class can inherit directly from IUnknown and not implement the IDispatch interface. This produces much more compact and efficient code and is the way in which all the standard COM interfaces, and also components like DirectX, have been implemented. The methods of these low-level interfaces can only be called directly and can be used by languages able to call a function through a pointer, such PB or C. Visual Basic and scripting languages can't use them.
Some future version of PB will have to implement classes and native support for direct interface calls. It seems unavoidable because it is the way to access many Microsoft technologies and also the way to interface with the .NET framework. It is possible to host the .NET runtime, that is nothing else but a COM server, in a PB application and call the methods of the .NET classes. I have done it. It will be also possible to do the same with .NET assemblies, without having to build COM callable wrappers.
Dynamic OOP in PowerBasic
This shows how to create classes and objects in dynamic strings. And by using macros, the syntax is also made much simpler.
For the sake of brevity, this code assumes Classes and objects each have a standard generic structure, and only the methods will vary, but more advanced orders of flexibility are poosible using similar techniques.
The advantage of holding objects in strings is that they can be generated in arrays, cloned, stuffed into other structures and manipulated like any other kind of string. They are completely relocatable as long as their class string exists and remains in the same place as when the objects were created from it. The vtable pointer in each object must always point to the start of their class string.
' some OOP for Powerbasic ver 8
' using dynamic objects made with strings
' making use of macros to simplify the syntax.
' Charles E V Pegge
' 22 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 methods available
m1 AS LONG PTR
m2 AS LONG PTR
m3 AS LONG PTR
m4 AS LONG PTR
ObjectSize AS LONG
' make 4 static 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)
' statc members
sa AS LONG
sb AS LONG
sc AS LONG
sd AS LONG
se AS LONG
sf AS LONG
' .... etc
END TYPE
' OOP GENERIC MACROS
MACRO CreateClass(MyClass,cre,des,f1,f2,f3,f4)
DIM MyClass AS STRING
MyClass=NUL$(SIZEOF(GenericClass))
cp=STRPTR(MyClass)
@cp.constructor=CODEPTR(cre)
@cp.destructor =CODEPTR(des)
@cp.m1=CODEPTR(f1)
@cp.m2=CODEPTR(f2)
@cp.m3=CODEPTR(f3)
@cp.m4=CODEPTR(f4)
@cp.ObjectSize=SIZEOF(GenericObject)
END MACRO
MACRO CreateObject(MyClass,MyObject,a,b,c,d,ans)
cp=STRPTR(MyClass)
DIM MyObject AS STRING
MyObject=NUL$(@cp.ObjectSize) ' fix size of object
op=STRPTR(MyObject)
@op.vtable=cp ' pointer to the classes method table
CallObject(MyObject,%CREATEme,a,b,c,d,ans)
END MACRO
MACRO CallObject(MyObject,MyMethod,a,b,c,d,ans)
op=STRPTR(MyObject): pt=op: vt=@@pt[MyMethod]
CALL DWORD vt USING MyGenericMethod(op,a,b,c,d) TO ans
END MACRO
MACRO DestroyObject(MyObject)
CallObject(MyObject,%DESTROYme,0,0,0,0,ans)
MyObject=""
END MACRO
MACRO GenericParameters=BYVAL pthis AS GenericObject PTR, BYVAL a AS LONG, BYVAL b AS LONG, BYVAL c AS LONG, BYVAL d AS LONG
DECLARE FUNCTION MyGenericMethod (GenericParameters) AS LONG
' SOME METHODS
%CREATEme = 0
%DESTROYme = 1
%ADDme = 2
%SUBTRACTme = 3
%MULTIPLYme = 4
%DIVIDEme = 5
FUNCTION Creates (GenericParameters) AS LONG
' initialise static members
@pthis.sa=a
@pthis.sb=b
@pthis.sc=c
@pthis.sd=d
FUNCTION =0
END FUNCTION
FUNCTION Destroys (GenericParameters) AS LONG
' anything that needs to be done before nulling the object
FUNCTION =0
END FUNCTION
FUNCTION adds (GenericParameters) AS LONG
@pthis.sa=a+b
FUNCTION =@pthis.sa
END FUNCTION
FUNCTION subtracts(GenericParameters) AS LONG
@pthis.sa=a-b
FUNCTION =@pthis.sa
END FUNCTION
FUNCTION multiplies(GenericParameters) AS LONG
@pthis.sa=a*b
FUNCTION =@pthis.sa
END FUNCTION
FUNCTION Divides(GenericParameters) AS LONG
@pthis.sa=a/b
FUNCTION =@pthis.sa
END FUNCTION
FUNCTION PBMAIN()
DIM cp AS GenericClass PTR
DIM op AS GenericObject PTR
DIM pt AS LONG PTR ' pointer to virtual table
DIM vt AS LONG PTR ' pointer to virtual table
DIM ans AS LONG
CreateClass(MyClass,Creates,Destroys,Adds,Subtracts,Multiplies,Divides)
CreateObject(MyClass,MyObject,0,0,0,0,ans)
CallObject(MyObject,%MULTIPLYme,2,3,0,0,ans)
MSGBOX STR$(ans)+" "+STR$(@op.sa)
DestroyObject(MyObject)
END FUNCTION
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..
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!)
@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!
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.
Thanks again guys for the examples and explanations. I will enjoy going over these and referring to these for some time to come.
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.
' 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
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.
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.
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.
' ========================================================================================
' 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
' ========================================================================================
I am interested in v2 support.
Would be nice to evt. enhance my PwrDev!
:)
Awesome!
Would be nice to have an object browser for this fella :)
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.
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)
FYI, webmatrix has a classbrowser GUI:
http://www.asp.net/webmatrix/
Quote
Would like to know how you used/find out about .unwrap ??
http://msdn2.microsoft.com/en-us/library/system.runtime.remoting.objecthandle.unwrap.aspx
Quote
How about creating such classes where the constructor has overloads?
I don't have information about that.
Seeing how virtual tables are the key to setting up classes, would adding inheritance be another virtual table with pointers to the parent?
I have no idea how polymorphism would be handled and how the code would be to handle it. Or would that be automatic?
For example:
Parent Class
First Child Class
First Grand Child Class
when a method is called, it looks here, if it finds it, it uses it. If not, go up to First Child and if not there, then on to the Parent Class.
So is polymorphism then a bonus for having inheritance?
Here is an interesting article on oop simulation with freeBasic.
This is not that far from being as easy to use as in other OOP languages. If you just want to see the whole program, just scroll to the end of the article.
As you can see it is very clean.
http://www.shnetworks2.net/~asciiwor/pcopy/issue40/#ext_type