; aoaClasses.inc
; A set of macros for defining class
; and protocol types.

            ifndef  aoaClasses_inc
aoaClasses_inc = 1

; Here are the generic constructors for the class library:

            externdef generic$ClassArray$Constructor:proc
            externdef generic$Class$Constructor:proc
            

;*****************************************************
;
; Macros for implementing classes in MASM.
;
;
; Some global constants that the
; class/protocol macros use:

proto$active?  =       0
class$active?  =       0
class$vmCnt    =       0
class$Name     textequ <>
class$Base     textequ <>





;---------------------------
;
; inherits-
;
; Just some syntactical sugar for the
; class macro:

inherits    macro   baseClass
            exitm   <&baseClass>
            endm
;
;---------------------------
;
; class-
;
; This macro defines class types for MASM.
;
; Usage:
;
; Typical base class-
;
;   class  className
;
; Derived class (inheriting baseClass)-
;
;   class className, inherits(baseClass)
;
; This macro automatically generates a qword
; field named "VMT" for base classes (VMT is
; inherited from the base class when creating
; derived classes).

class       macro   className:req, baseName
            local   saveBaseName, castName

; Disallow nested classes:

            if      class$active? or proto$active?
            echo    *********************************
            echo    Error! Nested classes/protocols
            echo    are illegal. Currently open class
%           echo    is class$Name.
            echo    *********************************
            .err
            exitm   
            endif   

; class$active? is a global value that is true (non-zero)
; when a class declaration is active (meaning we've 
; seen the "class" directive but have yet to see the 
; corresponding "endc" directive.

class$active? =     1

; class$vmCnt is a global value that counts the number
; of virtual methods in a class. This will provide the
; size of the VMT for the class.

class$vmCnt =       0

; class$Name holds the name of this class for use
; inside other class-related macros.
; class$Base holds the base class name (if any).

class$Name    textequ <&className>
class$Base    textequ <&baseName>
saveBaseName  catstr  <&className>, <$Base>
              ifnb    <&baseName>
%saveBaseName textequ <&baseName>
              else
%saveBaseName textequ <>
              endif



; Create a symbol we can use to identify this as
; a class (verus a prototype):

typeName      catstr  <&className>, <$Type>
typeName      =       0  ;Zero is a class type.

; Create an equate that type casts "[rsi]" to
; the class type:

castName    catstr  <&className&@ textequ !<(&className ptr [rsi])!>>
            castName


; Okay, open up the structure that will receive
; the class' data members:

className   struct

; If the caller does not supply a base class
; name, then emit the VMT field:

            ifb     <&baseName>
VMT         qword   ?

            else    ;baseName is not blank.

; Probably going to add some virtual methods
; that have been inherited from a base class
; or protocol. Initialize the index to 0
; before doing that:

class$vmCnt =       0
                    
; Include all the fields from the base class
; into this class (this does the inheritance).

            baseName {}

; Copy all the virtual methods from the base
; class into this class:

numInhTxt   catstr  <&baseName>, <$vmCnt>
numInh      =       numInhTxt
            while   class$vmCnt lt numInh
            local   refIndex, curIndex, curFunc

; Copy the base$mthd$n value to class$mthd$n:

refIndex    catstr  <&baseName>, <$mthd$>, %class$vmCnt
curIndex    catstr  class$Name, <$mthd$>, %class$vmCnt, \
                       < textequ >, <!<>, refIndex, <!>>
            curIndex
curFunc     catstr  <&className>, <$mthd$>, refIndex
&curFunc    =       class$vmCnt

            
; Copy the base$mngl$n value to class$mngl$n:

refIndex    catstr  <&baseName>, <$mngl$>, %class$vmCnt
curIndex    catstr  class$Name, <$mngl$>, %class$vmCnt, \
                       < textequ >, <!<>, refIndex, <!>>
            curIndex

; Create the class$mthd$func symbol:

curFunc     catstr  <&className>, <$mthd$>, refIndex
curFunc     =       class$vmCnt
  
class$vmCnt =       class$vmCnt + 1
            endm
            endif   ;ifb <&baseName>
            

            endm    ;Class macro
 
 
;---------------------------
;
; tstDup-
;
; A little helper function that checks for
; a duplicate symbol.
 
tstDup      macro   symbol, shortSym
            ifdef   symbol
            echo    **************************
            echo    Error! Duplicate virtual
            echo    method declaration:
%           echo    shortSym
            echo    **************************
            .err
            endif
            endm
            

;---------------------------
;
; virtual-
; 
; This macro declares a virtual method for this class.
;
; Usage:
;
;     virtual   methodName {, mangledName}
;
; The mangledName operand is optional. If it
; is not present, then this macro will substitute
; <class$Name>$methodName for the mangled name.

            
virtual     macro   methodName:req, mangledName
            local   index, vmName, id
            local   vmIndex, mngld

; If the mangled name is absent, generate a mangled
; name as <class$Name>$<methodName>

            ifb     <&mangledName>
mngld       catstr  class$Name, <$>, <&methodName>
            else
mngld       textequ <&mangledName>
            endif
            
; Create the class$mthd$n identifier and assign it
; the text for the method name.

vmIndex     catstr  class$Name, <$mthd$>, %class$vmCnt, < textequ !<>, <&methodName>, <!>>
            vmIndex

; Create the class$mngl$n identifier and assign it
; the text for the method name.

vmIndex     catstr  class$Name, <$mngl$>, %class$vmCnt, < textequ !<>, mngld, <!>>
            vmIndex

; Create the class$mthd$method identifier and assign
; it the index into the VMT:

vmName      catstr  class$Name, <$mthd$>, <&methodName>

; Before generating the symbol, check for a duplicate
; virtual method declaration (including repeating the
; name of an inherited method name):
            
            tstDup  %vmName, <&methodName>
            
vmName      =       class$vmCnt


; Create the class$mngl$method identifier and assign
; it the index into the VMT:

vmName      catstr  class$Name, <$mngl$>, mngld

; Before generating the symbol, check for a duplicate
; virtual method declaration (including repeating the
; name of an inherited method name):
            
            tstDup  %vmName, <&mngld>
            
vmName      =       class$vmCnt


; Bump up for next entry in VMT:

class$vmCnt =       class$vmCnt + 1
            endm    

            
 
;---------------------------
;
; mkTE-
; (make text equate)
;
; A little helper macro for override
; to control text expansion when
; redefining a text equate.

mkTE        macro   a,b,c,d
&a&&b&c&    textequ <&d>
            endm
            
;---------------------------
;
; override-
; 
; This macro overrides a virtual method for a class.
;
; Usage:
;
;     override   baseMethodName, overrideName       


override    macro   baseName:req, overrideName:req
            local   baseID, ovrrdID
            local   index

baseID      catstr  class$Name, <$mthd$>, <&baseName>

; Replace the entry of the form class$Name$mngl$index
; that contains the base method name with one that
; contains the overridden name. Had to create
; a special macro (mkTE) to control expansion of the
; label on the textequ.

index       =       baseID
            mkTE    %class$Name, <$mngl$>, \
                            %index, overrideName
                        
; Set the constant for the overriding name to the
; same value as the overriddend (base) name.

ovrrdID     catstr  class$Name, <$mngl$>, <&overrideName>
ovrrdID     =       baseID


            endm    

            
            
;---------------------------
;
; endc macro-
;
; Terminates a class defintion.
; For the most part, this just maps to an "ends"
; directive.
;
; Usage:
;
;  className  endc ()
            
            
endc        macro   className
            local   cnt

; Check the global symbol class$active? to ensure
; that we're currently processing class fields.
; If not, report an error.

            if      class$active? eq 0
            echo    *****************************
            echo    Error! Encountered "endc"
            echo    with no active class.
            echo    *****************************
            .err
            exitm 
            endif

            ifdif   class$Name, <&className>
            echo    *****************************
            echo    Error! "endc" class name:
%           echo    (className)
            echo    does not match active class:
%           echo    (class$Name)
            echo    *****************************
            .err
            exitm 
            endif
            

; Create a global symbol (that will exist after this
; macro completes) that specifies the number of virtual
; methods this class possesses:

cnt         catstr  class$Name, <$vmCnt>
cnt         =       class$vmCnt

; We're done processing class fields, so set the
; global class$active? value to false and class$vmCnt
; to zero:

class$active? =       0
class$vmCnt   =       0

; Also, clear class$Name

class$Name  textequ <>

className   ends
            endm


 

;---------------------------
;
; protocol-
;
; This macro defines protocol types for MASM.
;
; Usage:
;
;   protocol protoName {, inherits(baseName)}
;
; This macro automatically generates a qword
; field named "VMT" for base classes (VMT is
; inherited from the base class when creating
; derived classes).
;
; If the optional "inherits(baseName)" is present,
; this protocol inherits all the fields from the
; base protocol.

protocol    macro   protoName:req, baseName
            local   numInh, numInhTxt, saveBaseName

; Disallow nested classes:

            if      class$active? or proto$active?
            echo    *********************************
            echo    Error! Nested classes/protocols
            echo    are illegal. Currently open class
            echo    or protocol is
%           echo    class$Name.
            echo    *********************************
            .err
            exitm   
            endif   

; proto$active? is a global value that is true (non-zero)
; when a protocol declaration is active (meaning we've 
; seen the "protocol" directive but have yet to see the 
; corresponding "endpr" directive.

proto$active? =     1

; class$vmCnt is a global value that counts the number
; of virtual methods in a class. This will provide the
; size of the VMT for the class.

class$vmCnt =       0

; class$Name holds the name of this protocol for use
; inside other class/protocol-related macros.

class$Name    textequ <&protoName>
class$Base    textequ <>
saveBaseName  catstr  <&protoName>, <$Base>
%saveBaseName textequ <>



; Create a symbol we can use to identify this as
; a protocol (verus a class):

typeName      catstr  <&protoName>, <$Type>
typeName      =       1  ;One is a protocol type.



; Now let's create the actual typedef for
; the protocol type.

protoName   typedef qword

; Open up a "no-name" segment declaration to
; capture any data fields the programmer
; inadvertently inserts into a protocol.
; In the "endpr" macro we'll check to see
; if they inserted any data into this segment.

illegal$segment   segment readonly
                  org     0
&protoName&$Start equ    this byte
            
; If the caller supplied a base protocol
; name, then copy all the virtual methods 
; from the base protocol into this protocol:

            ifnb     <&baseName>

class$vmCnt =       0

; Just as a quick test, verify that the argument
; passed to us is actually a protocol symbol:

tstProt     catstr  <&baseName>, <$Type>

            ifndef  tstProt
            echo    ***************************
%           echo    Error! Undefined symbol,
            echo    must be a protocol type.
            echo    ***************************
            .err
            exitm
            endif
            
            if      tstProt ne 1
            echo    ***************************
%           echo    Error! Argument must be a
            echo    protocol type.
            echo    ***************************
            .err
            exitm
            endif

numInhTxt   catstr  <&baseName>, <$vmCnt>
numInh      =       numInhTxt

; For each virtual method in this protocol, 
; create the symbols:
;
;      <&baseName>$mthd$n
; and
;       <class$Name$>mthd$<method name>
;
; Note that class$Name holds the current class
; or protocol name.

            while   class$vmCnt lt numInh
            local   refIndex, curIndex, curFunc

; Copy the <&baseName>$mthd$n value to proto$mthd$n:
            
refIndex    catstr  <&baseName>, <$mthd$>, %class$vmCnt
curIndex    catstr  class$Name, <$mthd$>, %class$vmCnt, \
                       < textequ >, <!<>, refIndex, <!>>
            curIndex

; Create the class$Name$mthd$func symbol as assign it
; the current VMT index:

curFunc     catstr  class$Name, <$mthd$>, refIndex
curFunc     =       class$vmCnt


; Copy the <&baseName>$mngl$n value to proto$mngl$n:
            
refIndex    catstr  <&baseName>, <$mngl$>, %class$vmCnt
curIndex    catstr  class$Name, <$mngl$>, %class$vmCnt, \
                       < textequ >, <!<>, refIndex, <!>>
            curIndex
            
; Create the class$Name$mngl$func symbol as assign it
; the current VMT index:

curFunc     catstr  class$Name, <$mngl$>, refIndex
curFunc     =       class$vmCnt


  
class$vmCnt =       class$vmCnt + 1
            endm
                                
            endif   ;ifnb <&baseName>

            endm    ;protocol macro
  
           
;---------------------------
;
; endpr macro-
;
; Terminates a protocol defintion.
;
; Usage:
;
;  endpr protoName
            
            
endpr           macro   protoName
                local   cnt,segName

; Check the global symbol class$active? to ensure
; that we're currently processing class fields.
; If not, report an error.

                if      proto$active? eq 0
                echo    *****************************
                echo    Error! Encountered "endpr"
                echo    with no active protocol.
                echo    *****************************
                .err
                exitm
                endif

                ifdif   class$Name, <&protoName>
                echo    *******************************
                echo    Error! "endpr" protocol name:
%               echo    (protoName)
                echo    does not match active protocol:
%               echo    (class$Name)
                echo    *******************************
                .err
                exitm 
                endif

; Determine if there have been any (illegal)
; data declarations inbetween protocol and endpr:


segName         catstr  class$Name, <$Start>
                if      ($-segName) ne 0
                echo    *****************************
                echo    Error! Declarations seemed
                echo    to have appeared within a
                echo    protocol/endpr sequence.
                echo    *****************************
                .err
                endif
                

; Create a global symbol (that will exist after this
; macro completes) that specifies the number of virtual
; methods this class possesses:

cnt         catstr  class$Name, <$vmCnt>
cnt         =       class$vmCnt

; We're done processing class fields, so set the
; global class$active? value to false and class$vmCnt
; to zero:

proto$active?  =       0
class$vmCnt    =       0

; Also, clear class$Name

class$Name  textequ <>


illegal$segment ends


            endm


 


            
;---------------------------
;
; supports macro includes the virtual methods
; from a protocol into a class defintion and
; emits an VMT pointer for that particular
; protocol item:
;
; Usage:
;
;    supports  protoName
;
; Must appear in a class..endc sequence.


supports    macro   proto:req
            local   numInh, numInhTxt, i
            local   vmtName
            
; Need to emit a qword to hold the VMT for
; the protocol:

vmtName     catstr  <&proto>,<$>,<VMTptr>
vmtName     qword   ?

; For each virtual method in this protocol, 
; create the symbols:
;
;      <&baseName>$mthd$n
; and
;       <class$Name$>mthd$<method name>
;
; Note that class$Name holds the current class
; or protocol name.

numInhTxt   catstr  <&proto>, <$vmCnt>
numInh      =       numInhTxt
i           =       0
            while   i lt numInh
            local   refIndex, curIndex, curFunc

; Copy the <&proto>$mthd$n value to class$Name$mthd$n:
            
refIndex    catstr  <&proto>, <$mthd$>, %i
curIndex    catstr  class$Name, <$mthd$>, %class$vmCnt, \
                       < textequ >, <!<>, refIndex, <!>>
            curIndex

; Create the class$Name$mthd$func symbol as assign it
; the current VMT index:

curFunc     catstr  class$Name, <$mthd$>, refIndex
curFunc     =       class$vmCnt


; Copy the <&proto>$mngl$n value to proto$mngl$n:
            
curIndex    catstr  class$Name, <$mngl$>, %class$vmCnt, \
                       < textequ >, <!<>, class$Name, <$>, refIndex, <!>>
            curIndex
            
; Create the class$Name$mngl$func symbol as assign it
; the current VMT index:

curFunc     catstr  class$Name, <$mngl$>, class$Name, <$>, refIndex
curFunc     =       class$vmCnt


i           =       i + 1  
class$vmCnt =       class$vmCnt + 1
            endm    ;while
            endm    ;supports macro

;---------------------------
;
; emitVMT macro generates a virtual method table for
; the specified class:

emitVMT     macro   theClass
            local   vmCntTxt, vmCntTmp, vmCnt
            local   vmtName, curID, index

vmtName     catstr  <&theClass>, <$VMT>

; If the class passed as an argument is defined,
; then we can generate a VMT for it.
            
            ifdef   theClass
            
; Generate the symbol "theclass$vmCnt" (substituting
; the expansion of "theClass") and then convert this
; to an integer string that holds the number of
; virtual methods for this class:

vmCntTmp    catstr  <&theClass>, <$vmCnt>

; Determine if we have a proper class declaration.
; A proper class definition will have defined
; "theclass$vmCnt".

            ifdef   vmCntTmp

; Convert "theclass$vmCnt" to an integer:
            
vmCntTxt    textequ %vmCntTmp
vmCnt       =       vmCntTxt

; If vmCnt is greater than zero, we can
; generate a VMT. If it is zero, generate
; a fake VMT with a single NULL entry so
; the constructor can still initialize the
; VMT pointer in an object.

            if      vmCnt gt 0

; Generate n entries, where "n" is the value
; held in vmCnt. Handle the first entry
; specially, as we must attach a label to it.
;
; Note that the virtual method has created an
; array of names that take the form:
;
;   <mthdID>$mngl$n
;
; where <mthdID> is the class name (using
; the defered name created in the class
; macro), "$mngl$" is just a string to make
; the method ID unique, and "n" is the
; index into the VMT. These symbols are
; all text equates and the text value is
; the actual name of the method whose address
; is to be inserted into the VMT at the specified
; index.
; 
; Before the label for the VMT (at offset VMT-8)
; emit a pointer to the parent (super) VMT.
; (If this is a base class, emit NULL):

curID       catstr  <&theClass>, <$Base>
curID       catstr  curID, <$VMT>
            ifidn   curID, <$VMT>
            qword   0
            else
            qword   curID
            endif

; Here's the label for the VMT:

            externdef vmtName:qword

&vmtName&   label   qword

; Emit all the qword entries in the VMT:

index       =       0
            while   index lt vmCnt
            local   cmnt
            
curID       catstr  <&theClass>, <$mngl$>, %index
            qword   curID
            
index       =       index + 1
            endm    ;while

            else    ; vmCnt is not gt 0
            
&vmtName&   qword   0

            endif   ;vmCnt gt 0

            else    ;vmCnt is not defined
            
            echo    *****************************
            echo    Error! There doesn't seem to
            echo    be a properly-defined class
%           echo    associated with theClass
            echo    *****************************
            .err
            exitm
            endif   ;ifdef vmCnt
            
            
            else    ;theClass was not defined.
            
            echo    *****************************
%           echo    theClass is not defined
            echo    *****************************
            endif
            endm    ;emitVMT
            
;---------------------------
;
; vmtAdrs(className)-
;
; This macro returns the name of the VMT
; associated with the specific class:

vmtAdrs     macro   className
            local   vmtName
vmtName     catstr  <&className>, <$VMT>
            exitm   <&vmtName>
            endm
                    
;---------------------------
;
; vmtPtr(protocolName)-
;
; This macro returns the name of the VMT
; field associated with the specified
; protocol inherited by a class:

vmtPtr      macro   protoName
            local   vmtName
vmtName     catstr  <&protoName>, <$VMTptr>
            exitm   <&vmtName>
            endm
                    
;---------------------------
; 
; methodOfs( class, method )
;
; Returns a byte index into the VMT for the
; specified method in the specified class.
;
; Typical use:
;
;       mov  rsi, objectPtr
;       mov  rdi, [rsi]     ;rdi=VMT ptr
;       call [rdi+methodOfs( className, methodName )]
;
; This calls the specified method via the VMT.

methodOfs   macro   theClass, method
            local   vmCntTxt, vmCntTmp, vmCnt
            local   foundIt

vmCntTmp    catstr  <&theClass>, <$vmCnt>
            ifndef  vmCntTmp
            echo    *****************************
            echo    Error! There doesn't seem to
            echo    be a properly-defined class
%           echo    associated with 'theClass'
            echo    *****************************
            .err
            exitm   <0>
            endif

; Convert "theclass$vmCnt" to an integer:
            
vmCntTxt    textequ %vmCntTmp
vmCnt       =       vmCntTxt

; Search for the specified method. There
; will be an identifier of the form
; theClass"$mthd$"method
; if the method exists.

curID       catstr  <&theClass>, <$mthd$>, <&method>
            ifndef  curID
            echo    *****************************
%           echo    Error! method doesn't seem
            echo    to be defined virtual in
            echo    the class.
            echo    *****************************
            .err
            exitm   <0>
            endif
            exitm   %curID*8
            endm    ; methodOfs

;---------------------------
;
; inv-
;
; A "helper" macro for calling class methods.
;
; Usage:
;
;           inv className, MethodName, optThis, optVMT
;
; Class name is the name of the class containing the 
; method to call. This is the *class* name, not the
; object name.
;
; MethodName is the name of the method within the class
; (or some underlying base class) to call.
;
; optThis is the name of the variable or register that
; contains a *pointer* to the object of type "className".
; If this is blank, the macro will assume that the
; object pointer ("this") is already sitting in the
; RSI register. If this operand is "rsi", the macro
; will also assume that the pointer is sitting in the
; RSI register (and won't generate any extra code).
; If this operand is anything else, the macro will load
; that value (memory or constant) into RSI. If this
; operand begins with the '@' character, the macro
; will strip the '@' and then use the LEA instruction
; to load the address of whatever follows into RSI.
;
; optVMT specifies where the macro gets the VMT
; pointer. If this is blank, the macro loads RDI
; from [RSI] (RSI points at the object, the VMT
; is at offset zero in the object). If it is non-blank
; and contains "RDI", then this macro assumes the
; VMT pointer is already in RDI and emits no extra code.
; Otherwise, the macro loads RDI from the specified 
; operand. optVMT can also be the word "super", in 
; which case this macro loads RDI with the address of
; the specified class' base class VMT.
       
       
inv         macro   theClass:req, theMethod:req, thisPtr, vmtPtr
            local   hasAt, this2, vmt2
            
            ifnb    <&thisPtr>
            
; See if the "thisPtr" argument begins with an "@":

hasAt       instr   1, <&thisPtr>, <@>
            if      hasAt eq 1
            
this2       substr  <&thisPtr>, 2
            lea     rsi, this2
            
            else    ;No '@' prefix
            
            ifdifi  <&thisPtr>, <rsi>
            mov     rsi, thisPtr
            endif   ;if not RSI
            
            endif   ;hasAt eq 1
            endif   ;ifb <&thisPtr>



; Deal with the VMT argument here:
            
            ifnb    <&vmtPtr>
            
            ifidni  <&vmtPtr>, <super>
            
; If the word "super" was specied, load
; RDI with the address of the base class'
; VMT:

superName   catstr  <&theClass>, <$Base>
            ifnb    superName
superName   catstr  superName, <$VMT>
            else    ;It's a base class.
            echo    **************************
            echo    Error! Super can only be
            echo    applied to a derived class
            echo    **************************
            .err
            exitm
            endif
            lea     rdi, superName 

            else    ;not super
            
hasAt       instr   1, <&vmtPtr>, <@>
            if      hasAt eq 1
            
vmt2        substr  <&vmtPtr>, 2
            lea     rdi, vmt2
            
            else    ;No '@' prefix
            
            ifdifi  <&vmtPtr>, <rdi>
            mov     rdi, vmtPtr
            endif
            endif   ;hasAT eq 1
            endif   ;ifidni <&vmtPtr>, <super> 
            
            else    ;vmtPtr is blank
            
            mov     rdi, [rsi]
            
            endif   ;ifb <&vmtPtr>   
            
            call    qword ptr [rdi+methodOfs(theClass, theMethod)]
            endm

            
            
            endif   ;aoaClasses_inc