; Listing11-4.asm
;
; A program that demonstrates using coroutines
; to create generators.

            option     casemap:none
            .nolist

            include    aoalib.inc
            include    aoaMacros.inc
            include    aoaExcepts.inc
            include    aoaProcs.inc
            include    aoaTypes.inc
            include    aoaClasses.inc
            includelib aoalib.lib
            
            include    c:\masm32\include64\win64.inc
            include    c:\masm32\include64\kernel32.inc
            includelib c:\masm32\lib64\kernel32.lib  
            
            .list
            
            
; Program title:

            .const
             align  word
ttlStr       byte   "Listing 11-4", 0

; Class names:

range_tName  byte   "range_t", 0

    
    
; Define the generator_t class.
; This is an abstract base class from which
; other generator classes will be defined.
                    
            class   generator_t

; className- pointer to zString containing class name.
            
className   qword   ?

; returnValue- result from generator is returned here

returnValue qword   2 dup (?)       ;Up to 128 bits.

; fbrStart, fbrHasData, fbrGenerate-
;           fiber object/pointers for the methods
;           associated with this object.

fbrStart    qword   ?
fbrHasData  qword   ?
fbrGenerate qword   ?

; returnTo- fiber object that is calling the generator
;           (used as a return address)

returnTo    qword   ?


; onHeap- True if generator object was allocated on the heap.

onHeap      byte    ?

; errorCode- non-zero if there was an error during execution
;            of generator.

errorCode   byte    ?


; Methods:
; All methods except create expect RSI to contain the THIS
; pointer and RDI to contain the address of the VMT.

            ;static create
            
; start parameters will vary by derived class.

            virtual start
            
; Generate returns the generator result in:
;           128-bit: RDX:RAX
;           64-bit:  RAX
;           32-bit:  EAX
;           16-bit:  AX
;           8-bit:   AL
;
; HO accumulator bits are undefined. Generator will
; not modify RDX if the generator returns 64 bits or
; less.

            virtual generate
            
; hasData will return true/false (1/0) in AL

            virtual hasData
            
; Delete returns nothing.

            virtual delete
            
            
; "class" procedure that corresponds to
; the fiber code for the generator:

            ;static fiberProc
            
            endc    generator_t

; Still in .const section, emit the VMT:

            emitVMT generator_t

; The "this" pointer for generator_t:

generator_t@   textequ <(generator_t ptr [rsi])>


;--------
;
; Simple demonstration generator class: range_t
;
; Passed a pair of integers (startingVal and endingVal).
; Generates the starting integers from startingVal to 
; endingVal.

            enum    range_t$startOp,        \
                    range_t$noData
                    
            class   range_t, inherits( generator_t )

; Storage to hold parameters to pass to the
; fiber procedure:
            
startParm   dword   ?       ;Starting value parameter
endingParm  dword   ?       ;Ending value parameter
            
; Private data:

startingVal dword   ?       ;Store generator parameters
endingVal   dword   ?       ; in these two locations

            override start,         range_t$start
            override generate,      range_t$generate
            override hasData,       range_t$hasData
            override delete,        range_t$delete
            endc    range_t


; Still in .const section, emit the VMT:

            emitVMT range_t

; The "this" pointer for generator_t:

range_t@    textequ <(range_t ptr [rsi])>
            
            
;-------------------------------------------------------------
; Class methods and procedures



            .code

; Useful routines created by looking at MSVC compiler output:

GetCurrentFiber     proc
                    mov     rax, 20h
                    mov     rax, gs:[rax]
                    ret
GetCurrentFiber     endp

GetFiberData        proc
                    call    GetCurrentFiber
                    mov     rax, [rax]
                    ret
GetFiberData        endp


;------
;
; Constructor and methods for the abstract generator_t class:
;
; Normally, there would be a generic constructor.
; However, this abstract base class is going to
; push all the constructor work into the derived
; classes because there is nothing this constructor
; would do that wouldn't be immediately overwritten
; by the derived class' constructor.

generator_t$create  proc
                    int     3
generator_t$create  endp

generator_t$start    textequ        <generator_t$create>                    
generator_t$generate textequ        <generator_t$create>
generator_t$hasData  textequ        <generator_t$create>
generator_t$delete   textequ        <generator_t$create>





;**********************************************************
;
; Constructor and methods for the range_t class.
;
; On entry, RSI contains the address of the range_t
; object to initialize, or NULL if this function
; is supposed to allocate storage for a new object.
;
; On return, RSI points at the object and RDI
; points at the VMT. This construction returns
; NULL in RSI if there was an error allocating or
; initializing the object.

; locals maps rbxSave, rsiSave, and rdiSave to the same offsets
; that xproc uses to preserve their values. Need to so this
; so we can change the return values of RSI and RDI later.

                    locals  range_t$create, \
                            rbxSave:qword,  \
                            rsiSave:qword,  \
                            rdiSave:qword

range_t$create      xproc   (frame, <rbx, rsi, rdi>)

; Note: this function makes Windows API calls. Would really
; like to preserve all registers except RSI and RDI across
; this call, so we must save the volatile registers ourselves.
;
; Note that volatile registers don't get restored if an
; exception occurs.

                    local   raxSave:qword, rcxSave:qword,   \
                            rdxSave:qword, r8Save:qword,    \
                            r9Save:qword, r10Save:qword,    \
                            r11Save:qword, thisPtr:qword,   \
                            shadowStorage[128]:byte

; Preserve the volatile registers:
                            
                    mov     raxSave, rax
                    mov     rcxSave, rcx
                    mov     rdxSave, rdx
                    mov     r8Save, r8
                    mov     r9Save, r9
                    mov     r10Save, r10
                    mov     r11Save, r11
                    
; Save THIS so we can check for NULL later.

                    mov     thisPtr, rsi
                    
                    mov     ecx, sizeof range_t
                    lea     rdi, vmtAdrs(range_t)
                    call    generic$Class$Constructor
                    mov     rcx, thisPtr    ;Original RSI value
                    test    rsi, rsi        ;Did allocation fail?
                    jz      failure
                    
; Check to see if object was allocated on heap. Set the
; onHeap field to true if it was:

                    test    rcx, rcx
                    setz    cl
                    mov     range_t@.onHeap, cl
                    
; Initialize pointer to field name:

                    lea     rcx, range_tName
                    mov     range_t@.className, rcx
                    
; Initialize the errorCode field (to no error):

                    mov     range_t@.errorCode, 0
                    
; Set up fiber return address so when we call the
; range_t$fiberProc procedure, it knows how to
; return control back to us:

                    call    GetCurrentFiber
                    mov     range_t@.returnTo, rax
                    
; Create a set of three fibers to use by this generator:

                    mov     ecx, 64*1024            ;stack space
                    lea     rdx, range$start$cor    ;Fiber procedure
                    mov     r8, rsi                 ;Fiber parm is THIS
                    call    CreateFiber
                    mov     range_t@.fbrStart, rax

                    mov     ecx, 64*1024            ;stack space
                    lea     rdx, range$hasData$cor  ;Fiber procedure
                    mov     r8, rsi                 ;Fiber parm is THIS
                    call    CreateFiber
                    mov     range_t@.fbrHasData, rax

                    mov     ecx, 64*1024            ;stack space
                    lea     rdx, range$gen$cor      ;Fiber procedure
                    mov     r8, rsi                 ;Fiber parm is THIS
                    call    CreateFiber
                    mov     range_t@.fbrGenerate, rax
                    
; Call each of these fibers, in succession, so they can
; do their own initialization:

                    mov     rcx, range_t@.fbrStart
                    call    SwitchToFiber
                    
                    mov     rcx, range_t@.fbrHasData
                    call    SwitchToFiber
                    
                    mov     rcx, range_t@.fbrGenerate
                    call    SwitchToFiber

; endxp is going to restore RSI and RDI as per the
; Windows' ABI. However, we really need to return
; THIS and VMT in them. Overwrite data on the stack:

                    mov     range_t$create$rsiSave, rsi
                    mov     range_t$create$rdiSave, rdi

; Need to return THIS in RAX:
                    
failure:            mov     rax, raxSave
                    mov     rcx, rcxSave
                    mov     rdx, rdxSave
                    mov     r8, r8Save
                    mov     r9, r9Save
                    mov     r10, r10Save
                    mov     r11, r11Save
range_t$create      endxp()
                    

; The following class methods for range_t override
; the abstract methods from the generator_t class.
;
;
; start( startingValue, endingValue );
;
; (Re)Sets the object's starting and ending values.
;
; No return value(s).
                    
range_t$start       xproc   (frame,<rax,rcx,rdx,r8,r9,r10,r11>)
                    local   thisPtr:qword,  \
                            shadowStorage[64]:byte

; Marshall the parameters passed to this method into
; the startParm and endingParm locations where the
; coroutine expects them.

                    mov     range_t@.startParm, ecx
                    mov     range_t@.endingParm, edx
                    
; Set the return address

                    call    GetCurrentFiber
                    mov     range_t@.returnTo, rax

; Activate the fiber:

                    mov     rcx, range_t@.fbrStart
                    call    SwitchToFiber
                    
; When the coroutine is done, return to this method's caller.
                    
range_t$start       endxp()




; generate- Activates the generate coroutine and then fetches
;           the result from the returned data area.
;
; Returns:
;
;           EAX:    Generator result
;           CL:     Non-zero if error, 0 if no error.

                            
range_t$generate    xproc   (frame, <rdx, r8, r9, r10, r11>)
                    local   shadowStorage[64]:byte
                    
; Set the return address

                    call    GetCurrentFiber
                    mov     range_t@.returnTo, rax

; Activate the fiber:

                    mov     rcx, range_t@.fbrGenerate
                    call    SwitchToFiber
                    
; On return, test for error (return in carry flag) and
; return generated result (if no error) in EAX:
                    
                    xor     eax, eax        ;Return 0 if error.
                    movzx   ecx, range_t@.errorCode
                    
                    cmp     cl, 0
                    jnz     error
                    mov     eax, dword ptr range_t@.returnValue
error:              
range_t$generate    endxp()


; hasData returns (in AL) true/false depending on
; whether the generator can generate additional
; data.

range_t$hasData     xproc   (frame, <>)
                    local   shadowStorage[64]:byte
                    
; Set the return address

                    call    GetCurrentFiber
                    mov     range_t@.returnTo, rax

; Activate the fiber:

                    mov     rcx, range_t@.fbrHasData
                    call    SwitchToFiber
                    
; On return, grab the byte in returnValue and return that
; as the function result:

                    movzx   eax, byte ptr range_t@.returnValue
                    
range_t$hasData     endxp()


; range_t$delete:
;
; The delete method shuts down the generator and
; deletes the fiber.  Note that this does not
; switch to a different fiber; all the work occurs
; in this method.

range_t$delete      xproc   (frame,<>)
                    local   shadowStorage[128]:byte

; Before freeing any storage, shut down the fiber:

                    mov     rcx, range_t@.fbrStart
                    call    DeleteFiber
                    mov     rcx, range_t@.fbrHasData
                    call    DeleteFiber
                    mov     rcx, range_t@.fbrGenerate
                    call    DeleteFiber
                    
; If object was allocated on the heap, delete it here:

                    cmp     range_t@.onHeap, 0
                    je      noFree
                    
                    mov     rax, rsi        ;Free object storage
                    call    mem$free
noFree:             
range_t$delete      endxp()



;---------------------------------
; Procedures the fiber proc calls:
;
; range$fiberProc calls each of these individual procedures
; based on the operation code passed in the method data field.
; These are turned into procedures (rather than encoding the
; activities directly in range$fiberProc) because that makes
; them easier to expand.


; start coroutine-
;
;  Copies the startParm and endingParm parameters
; into the private startingVal and endingVal data
; fields (respectively).

                    locals  range$start$cor,        \
                            rsiSave:qword,          \
                            rdiSave:qword
                    
range$start$cor     xproc   (frame, <rsi, rdi>)
                    local   thisPtr:qword,  \
                            shadowStorage[128]:byte
 
; On the very first entry (called from the constructor), 
; we initialize thisPtr using the fiber parameter passed 
; in RCX and then immediately return back to the constructor.

                    mov     thisPtr, rcx
                    mov     rcx, (range_t ptr [rcx]).returnTo
                    call    SwitchToFiber
                    
; On all invocations of this coroutine/fiber after the first,
; this code is being called to set/reset the starting values
; for the generator. Extract the parameters to start (marshalled
; by the range_t$start method) and copy them to the startingVal
; and endingVal data fields:
                    
resetValues:        mov     range$start$cor$rsiSave, rsi
                    mov     range$start$cor$rdiSave, rdi
                    mov     rsi, thisPtr 
                    mov     eax, range_t@.startParm
                    mov     range_t@.startingVal, eax
                    mov     eax, range_t@.endingParm
                    mov     range_t@.endingVal, eax
                    
; We're done, return to the caller:

                    mov     rcx, range_t@.returnTo
                    mov     rsi, range$start$cor$rsiSave
                    mov     rdi, range$start$cor$rdiSave
                    call    SwitchToFiber
                    
; When this function is called again, loop back and repeat
; the "start" operation:

                    jmp     resetValues
                    
; This "procedure" never returns. The fiber will be
; destroyed when the range_t destructor gets called
; for this object.

range$start$cor     endxp()



; Generate coroutine-
;
; If startingVal > endingValue, returns zero and the noData
; error code,
;
; Else:
;  Returns startingVal and increments startingVal.

                    locals  range$gen$cor,   \
                            rsiSave:qword
                            
range$gen$cor       xproc   (frame, <rsi, rdi>)
                    local   thisPtr:qword,  \
                            shadowStorage[128]:byte

; On the very first entry (called from the constructor), 
; we initialize thisPtr using the fiber parameter passed 
; in RCX and then immediately return back to the constructor.

                    mov     thisPtr, rcx
                    mov     rcx, (range_t ptr [rcx]).returnTo
                    call    SwitchToFiber
                    
                    
; On successive entries to this coroutine, generate values
; in the appropriate range if we haven't yet exceeded the
; range:

reEntry:            mov     range$gen$cor$rsiSave, rsi
                    mov     rsi, thisPtr
                    mov     eax, range_t@.startingVal
                    cmp     eax, range_t@.endingVal
                    ja      badGen
                            
                    inc     range_t@.startingVal    ;Generate next value
                    mov     range_t@.errorCode, 0
                    mov     range_t@.returnValue, rax
                    mov     rcx, range_t@.returnTo
                    mov     rsi, range$gen$cor$rsiSave
                    call    SwitchToFiber
                    jmp     reEntry
                    
badGen:             mov     range_t@.errorCode, range_t$noData
                    xor     rcx, rcx
                    mov     range_t@.returnValue, rcx
                    mov     rcx, range_t@.returnTo
                    mov     rsi, range$gen$cor$rsiSave
                    call    SwitchToFiber
                    jmp     reEntry

; This procedure never returns. The fiber gets deleted
; by the range_t object when it gets destroyed.

range$gen$cor      endxp()



; hasData dispatched routine-
;
;  Returns true if startingVal <= endingVal

                    locals  range$hasData$cor,    \
                            rsiSave:qword
                            
range$hasData$cor   xproc   (frame, <rsi, rdi>)
                    local   thisPtr:qword,  \
                            shadowStorage[128]:byte


; On the very first entry (called from the constructor), 
; we initialize thisPtr using the fiber parameter passed 
; in RCX and then immediately return back to the constructor.

                    mov     thisPtr, rcx
                    mov     rcx, (range_t ptr [rcx]).returnTo
                    call    SwitchToFiber

reEntry:            mov     range$hasData$cor$rsiSave, rsi
                    mov     rsi, thisPtr
                    mov     eax, range_t@.startingVal
                    xor     rcx, rcx
                    cmp     eax, range_t@.endingVal
                    setbe   cl
                    mov     range_t@.returnValue, rcx
                    mov     rcx, range_t@.returnTo
                    mov     rsi, range$hasData$cor$rsiSave
                    call    SwitchToFiber
                    jmp     reEntry
range$hasData$cor   endxp()
                    


;--------------------------------------------------
;
; Here is the main assembly language function.


            
            public  asmMain
asmMain     xproc   (frame, <rbx, rsi, rdi, r15>)
            local   mainFiber:qword,        \
                    rangePtr:qword,         \
                    range2Ptr:qword,        \
                    shadowStorage[80]:byte


            
; Okay, start fibers operating:

            xor     rcx, rcx
            call    ConvertThreadToFiber
            mov     mainFiber, rax
            

; Create a pair of range generator objects

            xor     rsi, rsi        ;Allocate on heap
            call    range_t$create
            mov     rangePtr, rsi   ;Return value in RSI!
            
            xor     rsi, rsi        ;Allocate on heap
            call    range_t$create
            mov     range2Ptr, rsi
            
; Start the outer generator with the values 1..2:


            try
            
            mov     ecx, 1
            mov     edx, 2
            inv     range_t, start, range2Ptr               

; Invoke the generators until they fail:

outerLoop:  inv     range_t, hasData, range2Ptr
            cmp     al, 0
            je      noMoreData

            inv     range_t, generate, range2Ptr
            mov     r15d, eax       ;Save for later
            
; Start the inner generator with the values 1..5:

            mov     ecx, 1
            mov     edx, 5
            inv     range_t, start, rangePtr                

innerLoop:  inv     range_t, hasData, rangePtr
            cmp     al, 0
            je      outerLoop
            
            inv     range_t, generate, rangePtr
            
            mov     edx, eax
            mov     r8d, r15d
            call    print
            byte    "Generated: inner=%d, outer=%d", nl, 0
            jmp     innerLoop
            
noMoreData: 
            call    print
            byte    "Generation done, cleaning up", nl, 0           
            
; Clean up after ourselves:

            inv     range_t, delete, range2Ptr
            inv     range_t, delete, rangePtr
            mov     rcx, mainFiber
            call    ConvertFiberToThread
            
asmMain     endxp()
            end