; types.inc
; A set of macros for specifying type
; information about MASM variables.

            ifndef  traditionalClasses_asm
traditionalClasses_asm = 1

            


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

proto$actv  =       0
class$actv  =       0
class$vmCnt =       0
class$Name  textequ <>
class$Base  textequ <>



;-----------------------------------------------------
;
; addProt-
;
; Add a protocol's methods to the current
; class or protocol:

addProt	macro	theProtocol
	local	numInhTxt, numInh
	local	refIndex, curIndex, curFunc
	local	tstProt
	
; Just as a quick test, verify that the argument
; passed to us is actually a protocol symbol:

tstProt	catstr	theProtocol, <$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  theProtocol, <$vmCnt>
numInh      =       numInhTxt

; For each virtual method in this protocol, 
; create the symbols:
;
;      <&theProtocol>$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 <&theProtocol>$mthd$n value to class$mthd$n:
            
refIndex    catstr  theProtocol, <$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

  
class$vmCnt =       class$vmCnt + 1
            endm
	endm

;---------------------------
;
; class-
;
; This macro defines class types for MASM.
;
; Usage:
;
; Typical base class-
;
;   className   class  ()
;
; Derived class (inheriting baseClass)-
;
;   className   class  (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   baseName, protoNames:vararg
            local   deferName, txtequ, vmCnt
            local   saveBaseName, typeName, baseType
	local	protoNameStrs, numInhTxt, numInh
	local	vmtName

; Disallow nested classes:

            if      class$actv or proto$actv
            echo    *******************************
            echo    Error! Nested classes/protocols
            echo    are illegal.
            echo    *****************************
            .err
            exitm   <>
            endif   

; class$actv 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$actv  =       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$Mthds holds the list of methods for this class.
; <deferName>$Base holds the name of the base class
;     (empty string if this is a base class).

class$Name    textequ <&deferName>
class$Base    textequ <&baseName>
baseType	  catstr  baseName, <$Type>
saveBaseName  catstr  <&deferName>, <$base>

; If the base type is an actual class type (and
; not a protocol type), then we need to
; create a global symbol for the base name.
; Otherwise, set the global base name to the
; empty string (because we don't have a base type).


	if	baseType eq 0	; It's a class type

%saveBaseName textequ <&baseName>
	
	else			;It's a protocol
	
%saveBaseName textequ <>

	endif


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

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

; We have to capture the symbol at the beginning
; of the line and attach "struct" to it. Unfortunately,
; we can't obtain that symbol until this macro finishes
; execution. So we're going to cheat and defer grabbing
; that symbol by creating a textequ that will
; (eventually) map that symbol to the local "deferName"
; symbol. This macro will return (as its function 
; result) the following text:
 
txtequ      catstr  <textequ >, <!<&deferName!>>

; Now let's create the actual structure that will
; hold the class fields. Note that "deferName"
; expands to something like "??1234" (typical MASM
; macro local name). This will be the *actual* name
; of the structure (i.e., the name that appears in
; the symbol table listing). In order to reference
; the structure using the caller-supplied name,
; we create a textequ that maps the caller's name
; to this one (see txtequ, above).

deferName   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
	
; baseName could be a protocol rather than
; a base class name (in which case, this is
; a base class rather than a derived class.
; If that's the case, combine baseName and
; protoNames and skip the emission of the
; base class type and copying the virtual
; methods from the base class:

baseType	catstr	baseName, <$Type>

	if	baseType ne 0
	
; The first argument to <<class>> is a prototype name.
; Process all the prototype names here
;
; Copy all the virtual methods from each of the
; protocols into this class:

	addProt	baseName	
vmtName	catstr	baseName, <$VMTptr>
vmtName	qword	?

	for 	pName, <protoNames>
	addProt	pName

; Okay, we need to emit a VMT entry for this protocol.
; The symbol will have the name <&pName>$VMTptr.
; Note that it is the responsibility of the constructor
; to actually initialize this field with the address
; of the virtual method table for this protocol.

vmtName	catstr	pName, <$VMTptr>
vmtName	qword	?
	endm

	
	


; This is not a derived class, so we need
; to emit the VMT here:

VMT         qword   ?

	else	;Deal with an actual derived class.
	

; If the caller did supply a base name, then
; emit that name here to insert all of that
; class' fields into this structure. Note that
; the baseName class will provide the VMT
; field for us.

            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

; Create the class$mthd$func symbol:

curFunc     catstr  class$Name, <$mthd$>, refIndex
curFunc     =       class$vmCnt
  
class$vmCnt =       class$vmCnt + 1
            endm
                 
; If there are more than one arguments to this macro,
; process the remaining arguments as inherited
; prototypes:

	for 	pName, <protoNames>
	addProt	pName
vmtName	catstr	pName, <$VMTptr>
vmtName	qword	?
	endm
   
            endif	;baseType ne 0
	endif	;ifb <&baseName>
            

; Return the text equate created earlier so that
; the user's class name will get mapped to (the
; expansion of) "deferName":

            exitm   txtequ

            endm    ;Class macro
 
 
            

;---------------------------
;
; virtual-
; 
; This macro declares a virtual method for this class.
;
; Usage:
;
;     virtual   methodName

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

; 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$mthd$method identifier and assign
; it the index into the VMT:

vmName      catstr  class$Name, <$mthd$>, <&methodName>
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$Base, <$mthd$>, <&baseName>

; Replace the entry of the form class$Name$mthd$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, <$mthd$>, \
                            %index, overrideName
                        
; Set the constant for the overriding name to the
; same value as the overriddend (base) name.

ovrrdID     catstr  class$Name, <$mthd$>, <&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
            local   cnt

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

            if      class$actv eq 0
            echo    *****************************
            echo    Error! Encountered "endc"
            echo    with no active class.
            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$actv value to false and class$vmCnt
; to zero:

class$actv  =       0
class$vmCnt =       0

; Also, clear class$Name

class$Name  textequ <>


; Return an "ends" directive to mark the end of
; the structure we've created.

            exitm   <ends>
            endm


 
;---------------------------
;
; protocol-
;
; This macro defines protocol types for MASM.
;
; Usage:
;
; Typical base protocol-
;
;   protoName   protocol  ()
;
; Derived protocol (inheriting baseProto)-
;
;   protoName   class  (protoClass)

protocol    macro   baseName
            local   deferName, txtequ, vmCnt
            local   saveBaseName, typeName

; Disallow nested classes/protocols:

            if      class$actv or proto$actv
            echo    *******************************
            echo    Error! Nested classes/protocols
            echo    are illegal.
            echo    *****************************
            .err
            exitm   <>
            endif   

; proto$actv 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$actv  =       1

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

class$vmCnt =       0

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

class$Name    textequ <&deferName>
class$Base    textequ <&baseName>

; We don't save the base name for use beyond
; this macro.

saveBaseName  catstr  <&deferName>, <$base>
%saveBaseName textequ <>

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

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


; We have to capture the symbol at the beginning
; of the line and attach "typedef" to it. See
; the comments in the class macro for details.
 
txtequ      catstr  <textequ >, <!<&deferName!>>

; Now let's create the actual typedef.

deferName   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
&deferName&$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

	addProt	baseName
	                    
            endif   ;ifnb <&baseName>
            
; Return the text equate created earlier so that
; the user's class name will get mapped to (the
; expansion of) "deferName":

            exitm   txtequ

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

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

                if      proto$actv eq 0
                echo    *****************************
                echo    Error! Encountered "endpr"
                echo    with no active protocol.
                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$actv value to false and class$vmCnt
; to zero:

proto$actv  =       0
class$vmCnt =       0

; Also, clear class$Name

class$Name  textequ <>


illegal$segment ends


            endm


 


            
;---------------------------
;
; 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>$mthd$n
;
; where <mthdID> is the class name (using
; the defered name created in the class
; macro), "$mthd$" 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>
            ifb     curID
            qword   0
            else
curID       catstr  curID, <$VMT>
            qword   curID
            endif

; Here's the label for the VMT:

&vmtName&   label   qword

; Emit all the qword entries in the VMT:

index       =       0
            while   index lt vmCnt
            local   cmnt
            
curID       catstr  theClass, <$mthd$>, %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   ;traditionalClasses_asm