Page 1 of 1
Object without interface or structure with functions
Posted: Sun Sep 03, 2017 12:38 am
by mk-soft
I have too much time
Code: Select all
;-TOP
; -----------------------------------------------------------------------------
CompilerIf #PB_Compiler_Version > 561
CompilerError "Warning: Check ASM-Compiler for valid RBP-Register!"
CompilerEndIf
Macro GetCaller(self) ; Get frame pointer from caller
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
EnableASM
mov self, ebp
DisableASM
CompilerElse
EnableASM
mov self, rbp
DisableASM
CompilerEndIf
EndMacro
; -----------------------------------------------------------------------------
Prototype protoAdd(Value.i)
Prototype protoSub(Value.i)
Prototype protoResult()
Structure sObject
Add.protoAdd
Sub.protoSub
Result.protoResult
Value.i
EndStructure
Procedure Add(Value.i)
Protected *self.sObject
GetCaller(*self)
;Debug *self
*self\Value + Value
EndProcedure
Procedure Sub(Value.i)
Protected *self.sObject
GetCaller(*self)
;Debug *self
*self\Value - Value
EndProcedure
Procedure Result()
Protected *self.sObject
GetCaller(*self)
;Debug *self
ProcedureReturn *self\Value
EndProcedure
Procedure Init(*self.sObject)
; set procedure address
*self\Add = @Add()
*self\Sub = @Sub()
*self\Result = @Result()
; set default values
*self\Value = 0
EndProcedure
; -----------------------------------------------------------------------------
;-Test
Define a1.sObject
Debug "Init Object"
Init(a1)
;Debug @a1
Debug "Add and Sub"
a1\Add(100)
a1\Sub(20)
Debug "Result = " + a1\Result()
;-Test 2
Debug "Array of object"
Dim args.sObject(1000)
For i = 1 To 1000
Init(args(i))
Next
For i = 1 To 1000
args(i)\Add(Random(100))
;args(i)\Add(1); Random(100))
Next
For i = 1 To 1000
r1 + args(i)\Result()
Next
Debug "Result = " + r1
Re: Object without interface or structure with functions
Posted: Sun Sep 03, 2017 9:52 am
by uweb
It is weekend.
So you are not alone.
Code: Select all
;-TOP
; -----------------------------------------------------------------------------
Macro GetCaller(self) ; Get frame pointer from caller
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
EnableASM
mov self, ebp
DisableASM
CompilerElse
EnableASM
mov self, rbp
DisableASM
CompilerEndIf
EndMacro
; -----------------------------------------------------------------------------
; Simpler Procedures:
Procedure Add(ObjectValue.i, OperationValue.i) : ProcedureReturn ObjectValue + OperationValue : EndProcedure : Add = @Add()
Procedure Sub(ObjectValue.i, OperationValue.i) : ProcedureReturn ObjectValue - OperationValue : EndProcedure : Sub = @Sub()
Procedure Result(ObjectValue.i, OperationValue.i) : ProcedureReturn ObjectValue : EndProcedure : Result = @Result()
; For additional operators there is no need to change anything elsewhere. - e.g:
Procedure Mult(ObjectValue.i, OperationValue.i) : ProcedureReturn ObjectValue * OperationValue : EndProcedure : Mult = @Mult()
; -----------------------------------------------------------------------------
Prototype protoExecute(*Operation, OperationValue.i=0)
; Needs a little less memory:
Structure sObject
Execute.protoExecute
Value.i
EndStructure
Procedure Execute(*Operation, OperationValue.i=0)
Protected *self.sObject
GetCaller(*self)
;Debug *self
*self\Value = CallFunctionFast(*Operation, *self\Value, OperationValue.i)
ProcedureReturn *self\Value
EndProcedure
Procedure Init(*self.sObject)
; set procedure address
*self\Execute = @Execute()
; set default values
*self\Value = 0
EndProcedure
; -----------------------------------------------------------------------------
;-Test
Define a1.sObject
Debug "Init Object"
Init(a1)
;Debug @a1
Debug "Add and Sub"
a1\Execute(Add, 100)
a1\Execute(Sub, 20)
Debug "Result = " + a1\Execute(Result)
a1\Execute(Mult, 42)
Debug "Result * 42 = " + a1\Execute(Result)
;-Test 2
Debug "Array of object"
Dim args.sObject(1000)
For i = 1 To 1000
Init(args(i))
Next
For i = 1 To 1000
args(i)\Execute(Add, Random(100))
;args(i)\Execute(Add, 1); Random(100))
Next
For i = 1 To 1000
r1 + args(i)\Execute(Result)
Next
Debug "Result = " + r1
Re: Object without interface or structure with functions
Posted: Sun Sep 03, 2017 10:55 am
by mk-soft
Information
I have once again occupied with ASM and the call convention.
Because 'Fred' is our great purebasic developer, he keeps himself as a professional programmer, to the call convention and uses the rbp-register as a pointer to the current record (frame pointer).
This allows the pointer to access the current structure (record) from the caller.
Of course, this only works so long if the compiler does not use any other method. For example, a processor-independent compiler (LLVM compiler)
P.S. Added CompilerError (Warning) for future Version of PB-Compiler
Re: Object without interface or structure with functions
Posted: Sun Sep 03, 2017 11:20 am
by uweb
Yes, it is a greate trick.
I forgot to say : Thank you!
Re: Object without interface or structure with functions
Posted: Sun Sep 03, 2017 12:41 pm
by mk-soft
Thanks
New example
Code: Select all
;-TOP
; -----------------------------------------------------------------------------
CompilerIf #PB_Compiler_Version > 561
CompilerError "Warning: Check ASM-Compiler for valid RBP-Register!"
CompilerEndIf
Macro GetCaller(self) ; Get frame pointer from caller
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
EnableASM
mov self, ebp
DisableASM
CompilerElse
EnableASM
mov self, rbp
DisableASM
CompilerEndIf
EndMacro
; -----------------------------------------------------------------------------
Prototype protoInvoke()
Structure sBox
width.i
height.i
depth.i
volume.protoInvoke
sureface.protoInvoke
EndStructure
Procedure Volume()
Protected *self.sBox, result.i
GetCaller(*self)
With *self
result = \width * \height * \depth
EndWith
ProcedureReturn result
EndProcedure
Procedure Sureface()
Protected *self.sBox, result.i
GetCaller(*self)
With *self
result = \width * \height * 2 + \width * \depth * 2 + \height * \depth * 2
EndWith
ProcedureReturn result
EndProcedure
Procedure New()
Protected *self.sbox
*self = AllocateStructure(sBox)
If *self
*self\volume = @Volume()
*self\sureface = @Sureface()
EndIf
ProcedureReturn *self
EndProcedure
*box1.sbox = New()
*box1\width = 20
*box1\height = 40
*box1\depth = 100
Debug "Volume = " + *box1\volume()
Debug "Sureface = " + *box1\sureface()
Re: Object without interface or structure with functions
Posted: Sun Sep 03, 2017 4:37 pm
by wilbert
Nice example
Here a modified version of you example with a clone() procedure and corrected spelling for surface.
Code: Select all
;-TOP
; -----------------------------------------------------------------------------
CompilerIf #PB_Compiler_Version > 561
CompilerError "Warning: Check ASM-Compiler for valid RBP-Register!"
CompilerEndIf
Macro GetCaller(self) ; Get frame pointer from caller
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
!mov [p.p_self], ebp
CompilerElse
!mov [p.p_self], rbp
CompilerEndIf
EndMacro
; -----------------------------------------------------------------------------
Prototype protoInvoke()
Structure sBox
width.i
height.i
depth.i
volume.protoInvoke
surface.protoInvoke
clone.protoInvoke
EndStructure
Procedure Volume()
Protected *self.sBox, result.i
GetCaller(*self)
With *self
result = \width * \height * \depth
EndWith
ProcedureReturn result
EndProcedure
Procedure Surface()
Protected *self.sBox, result.i
GetCaller(*self)
With *self
result = \width * \height * 2 + \width * \depth * 2 + \height * \depth * 2
EndWith
ProcedureReturn result
EndProcedure
Procedure Clone()
Protected *self.sBox, *clone.sBox
GetCaller(*self)
*clone = AllocateStructure(sBox)
If *clone
CopyStructure(*self, *clone, sBox)
EndIf
ProcedureReturn *clone
EndProcedure
Procedure New()
Protected *self.sBox
*self = AllocateStructure(sBox)
If *self
*self\volume = @Volume()
*self\surface = @Surface()
*self\clone = @Clone()
EndIf
ProcedureReturn *self
EndProcedure
*box1.sBox = New()
*box1\width = 20
*box1\height = 40
*box1\depth = 100
Debug "Volume = " + *box1\volume()
Debug "Surface = " + *box1\surface()
*box2.sBox = *box1\clone()
*box2\depth = 30
Debug "Volume = " + *box2\volume()
Debug "Surface = " + *box2\surface()
Re: Object without interface or structure with functions
Posted: Sun Sep 03, 2017 5:23 pm
by Lunasole
Interesting that macro, but looks like I've lost interest to "true POO" after sitting long enough mostly with PB and C ^^
Now it looks simpler and clearer to use things like this
Code: Select all
EnableExplicit
; some pseudocode using map for simplicity
Structure WHATEVER
Data1$
EndStructure
Global NewMap Objects.WHATEVER()
Procedure$ SetData(obj$, value$)
Objects(obj$)\Data1$ = value$
EndProcedure
Procedure$ GetData (obj$)
ProcedureReturn Objects(obj$)\Data1$
EndProcedure
Procedure Destroy(obj$)
DeleteMapElement(Objects(), obj$)
EndProcedure
;;;;;;;;;;;;;;;;;;;;;;;
SetData("objectid1", "123")
SetData("objectid2", "456")
Debug GetData("objectid1") + GetData("objectid2")
Re: Object without interface or structure with functions
Posted: Sun Sep 03, 2017 8:16 pm
by skywalk
Cool code mk-soft. Very similar to
OOP without interfaces.