Object without interface or structure with functions

[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

[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

[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

[uweb]

Yes, it is a greate trick.
I forgot to say : Thank you!

[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()

[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()

[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")

[skywalk]

Cool code mk-soft. Very similar to OOP without interfaces.