Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Asynchronous (overlapped) I-O demo

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Asynchronous (overlapped) I-O demo

    Code:
    ' PROGRAM-ID.  OverlappedTest.bas
    ' PURPOSE.     Test Asnychronous I-O to see what happens
    ' DATE-WRITTEN. 4/7/07
    ' AUTHOR.       Michael Mattias Tal Systems Inc Racine WI
    ' COPYRIGHT.    Placed in public domain by author 4/8/07
    ' COMPILER.     PB/Windows 8.03 but should work with any PB compiler with minimal changes.
    
    #COMPILE  EXE
    #OPTION   VERSION5    ' <<< requires NT-class; Win 9x does not support this type of asynch I-O
    #DEBUG    ERROR ON
    #REGISTER NONE
    #DIM      ALL
    #TOOLS    OFF
    '=====[Windows API Header Files] ============================
    '  If you don't need all of the functionality supported by these APIs
    '  (and who does?), you can selectively turn off various modules by putting
    '  the following constants in your program BEFORE you #include "win32api.inc":
    '
    '  %NOGDI = 1     ' no GDI (Graphics Device Interface) functions
    '  %NOMMIDS = 1   ' no Multimedia ID definitions
    %NODGI   = 1
    %NOMMIDS = 1
    #INCLUDE "WIN32API.INC"   ' Feb 2005
    '==[End Windows API Header Files]============================
    #IF NOT %DEF (%INVALID_HANDLE_VALUE_LONG)
       %INVALID_HANDLE_VALUE_LONG = -1&
    #ENDIF
    
    ' system error messages
    FUNCTION SystemErrorMessageText (BYVAL ECode AS LONG) AS STRING
      LOCAL Buffer AS ASCIIZ * 255
      FormatMessage %FORMAT_MESSAGE_FROM_SYSTEM, BYVAL %NULL, ECode, %NULL, buffer, SIZEOF(buffer), BYVAL %NULL
      FUNCTION = FORMAT$(ECode, "##### ") & Buffer
    END FUNCTION
    
    ' ---------------------
    '  TESTING EQUATES
    ' ---------------------
    %WORKER_THREAD_DELAY_MS   = 2000&       ' milliseconds 'do nothing' time in worker thread
    %NUMBER_OF_WRITES         = 20&
    %RECORD_LENGTH            = 2048 * 2048 ' size of each write.
    ' -------------------------------------------------------------------------------------------
    ' NOTE MINIMUM PROGRAM EXECUTION TIME = %WORKER_THREAD_DELAY_MS * %NUMBER_OF_WRITES \ 1000
    ' -------------------------------------------------------------------------------------------
    $FILENAME_DATA            = "D:\Testdata\Overlapped.dat"          ' write to file
    $FILENAME_REPORT          = "D:\Testdata\Overlapped_report.txt"   ' results file.
    
    ' ------------------------------------------------
    ' GLOBAL ARRAY FOR DATA COLLECTION AND CONTROL
    ' ------------------------------------------------
    TYPE OLControl
         OL             AS Overlapped
         WriteTime      AS SystemTime
         Callbacktime   AS SYSTEMTIME   ' when callback is called
         CompletionTime AS SYSTEMTIME   ' when worker thread completes
         errcode        AS LONG
         bytesCompleted AS LONG
    END TYPE
    
    GLOBAL g_OLC() AS OlControl
    
    ' ---------------------------------------------------------------
    ' difference between two systemtimes in millisconds
    ' ---------------------------------------------------------------
    FUNCTION SystemTimeDiffms (stW AS SYSTEMTIME, stC AS SYSTEMTIME) AS LONG
    
      LOCAL pqW AS QUAD PTR, pqC AS QUAD PTR
      LOCAL diff AS LONG
    
      LOCAL ftw AS FILETIME, ftc AS FILETIME
    
         SystemTimeToFileTime   Stw, ftw
         SystemTimeToFileTime   stc, ftc
    
         pqW   = VARPTR (ftw)
         pqC   = VARPTR (ftc)
         diff  = @pqC - @pQW    ' difference in 100-nanosecond uncrments
         Diff  = diff \ 10000&   ' convert to milliseconds
         FUNCTION = diff
    
    END FUNCTION
    
    ' ---------------------------------------------------------------
    ' Play with Asynch I-O using WriteFileEx with Callback function
    ' ---------------------------------------------------------------
    ' NOTES:
    ' 1. If SleepEx is not called after each write, the callback function is not called and the
    '    g_OLC() control table is not updated.
    ' 2. I am not sure how to handle the close of the file. File is always closing without error
    '    on first try. It "would seem" that the close should fail if I-O is pending, but On
    '    my system this does not seem to happen. Hmm, what if I delay in the callback? Might this
    '    not 'queue up' the actual handling of I-O by the APC functions? Let's try that. Nope,
    '    still closes on first try. Maybe my system is just too fast.
    
    FUNCTION WriteRecordsOverlappedWriteFileEx (szFile AS ASCIIZ, numTowrite AS LONG, recLen AS LONG) AS LONG
    
      LOCAL hfile AS LONG
      LOCAL Z AS LONG
      LOCAL swriteBuffer AS STRING, pBuff AS LONG
      LOCAL szBuffer AS ASCIIZ * %MAX_PATH, offset AS LONG, cbADDR AS DWORD
      LOCAL iRet     AS LONG, E AS LONG, nClosetry AS LONG
      LOCAL dwAccess AS LONG, dwShareMode AS LONG, lpSecurity AS LONG, _
            dwDisposition AS LONG, dwFlags AS LONG, hTemplate AS LONG
    
    
       REDIM g_OLC( numtowrite)     ' make control array big enough
    
       FOR Z = 1 TO numToWrite
            g_olc(Z).OL.hEvent = Z    ' we use hevent of each g_olc().OL  as a 'dwuser' value
       NEXT
    
       ' make our write buffer big enough to support the WriteFileEx call
       sWriteBuffer =  SPACE$(RecLen)
       pBUff        =  STRPTR (sWriteBuffer)
    
       dwAccess      = %GENERIC_READ OR %GENERIC_WRITE
       dwShareMode   = %NULL        ' no sharing might be better test if shared?
       lpSecurity    = %NULL        ' default
       dwDisposition = %OPEN_ALWAYS ' create if not found, open existing if found
       dwFlags       = %FILE_FLAG_OVERLAPPED
       hTEmplate     = %NULL
    
       hFile = CreateFile (szFile, dwAccess, dwShareMode, BYVAL lpSecurity, dwDisposition, dwFlags, hTemplate)
       E     = GetLastError
       IF hFile = %INVALID_HANDLE_VALUE_LONG THEN
           MSGBOX "CreateFile ERROR:" & $CRLF & SystemErrorMessageText(E)
           EXIT FUNCTION
       END IF
    
       Offset    = 0
       cbaddr    = CODEPTR ( WriteFileExCallbackProc)
    
       FOR Z = 1 TO numToWrite
           ' set the write time for this record..
           GetSystemTime           g_olc(Z).writeTime
         ' set the required file offset in OVERLARPPED structure
           g_Olc(Z).OL.Offset  = offset
           ' perform asynchronous write
           iret =  writefileEx (hFile, BYVAL pBUff, RecLen, g_OLC(z).OL, cbaddr)
           ' -------------------------------------------------------------------------------
           ' the Calling thread must enter an alertable wait state
    
           ' to get the results of the write.
           '
           ' Wait until APC operation is queued. This should also release
           ' callbacks. I think we need to do this?. CORRECT.
           ' When SleepEx is commented out, the callback is never called and the
           ' Callback time member is never filled.
           ' -----------------------------------------------------------------------
            SleepEx  0, %TRUE
            Offset = offset + recLen
       NEXT Z
    
       ' wait until ALL pending I-O operations have completed before closing the file (I think?)
       ' will I get some kind of "I-o pending" failure to close?
       ' No, but I doubt there are any pending operations, it's just tooo fast.
    
       iRet = %TRUE
       nCloseTry = 0
       DO
            INCR   nCloseTry
            iRet = CloseHandle (hFile)           ' returns true on success
            E    = GetLastError
            IF ISFALSE iRet THEN                 ' show Closehandle failure only on first failure
                IF ISTRUE (nClosetry=1) THEN
                    MSGBOX SystemErrorMessageText(E),,"CloseHandle Loop"
                END IF
            ELSE
               EXIT DO  ' CLoseHandle Succeeded
            END IF
       WEND
    
       MSGBOX "NClose Try=" & FORMAT$(nClosetry)  ' comes up one every time. I would think it should have
                                                  ' failed if file was still in use.
    
    END FUNCTION
    
    ' uses: g_OLC()
    FUNCTION WriteFileExCallbackProc ( BYVAL errcode AS LONG, BYVAL nBytesWritten AS LONG, OL AS OVERLAPPED) AS LONG
    
        LOCAL hThread AS LONG
    
         ' store the system time of the IO completion in the complete
          GetSystemTime                      g_olc(OL.hEvent).CallbackTime
          g_olc(OL.hEvent).errcode         = errcode
          g_olc(OL.hEvent).bytesCompleted  = nBytesWritten
          ' let's try inducing a delay here. Maybe the APC will get queed up?
          ' Oops, just using SLEEP here is silly... I am blocking the calling thread and proving nothing.
          ' I think I need to create a separate thread here to 'do something time consuming with the knowledge
          ' the I-O has been completed?'
          ' If I launch a thread here, I will end up with one thread per record written...
          ' but I could have that thread function wait on a critical section
          ' somehow I need to
    
          THREAD CREATE WriteFileExCallbackThreadFunction (OL.hEvent) TO hthread
    
          THREAD CLOSE  hThread TO hThread
    
    END FUNCTION
    
    ' uses global g_OLC()
    FUNCTION WriteFileExCallbackThreadFunction (BYVAL subscript AS LONG) AS LONG
    
      STATIC beenhere AS LONG, cs AS CRITICAL_SECTION
    
      IF ISFALSE BeenHere THEN
          InitializeCriticalSection cs
          BeenHere = %TRUE
      END IF
      ' one at a time, please....
      EnterCriticalSection cs
      SLEEP                %WORKER_THREAD_DELAY_MS  '  delay simulating 'some real work that
                                                    '  be done only after I-O is completed.'
      LeaveCriticalSection cs
      ' Update the completion time
      GetSystemTime        g_olc(subscript).CompletionTime
    
    END FUNCTION
    
    
    ' uses global g_OLC()
    FUNCTION ReportResults (szFile AS ASCIIZ ) AS LONG
    
      LOCAL dwDelayms  AS LONG  'delay between write being issued and completion being recorded
      LOCAL mask AS STRING
      LOCAL hFile AS LONG
      LOCAL sBuff AS STRING, Z AS LONG
      LOCAL wSTW AS SYSTEMTIME, wSTC AS SYSTEMTIME, wSTB AS SYSTEMTIME  ' to cut down on typing
    
    
      MASK  = "###,###  ##:##:##_.###      ##:##:##_.###     ##:##:##_.###      ###,###"
    ' SCREWS UP==> MASK  = "###,###  ##:##:##_.000      ##:##:##_.000     ##:##:##_.000      ###,###"
    
      hFile = FREEFILE
      OPEN    szFile FOR OUTPUT AS hfile
    
      sBuff = "Overlapped I-O Results on " & DATE$ & " at " & TIME$
      PRINT   #hfile, sBUff
      sBuff = USING$ ("Writing #, records of size #, with delay #, milliseconds", _
                       %NUMBER_OF_WRITES, %RECORD_LENGTH, %WORKER_THREAD_DELAY_MS)
      PRINT  #hFile, sbuff
      PRINT  #hFile,
    
      PRINT #hFile, "Index    Write Time         Callback Time    Completion time    Write to complete (ms) "
      PRINT #hFile, "------   ----------         --------------   ---------------    ----------------------"
    
      FOR Z = 1 TO UBOUND (g_OLC,1)
    
            wSTW  = g_OLC(Z).writeTime          ' get array members into locals for ease of typing.
            wSTC  = g_OLC(Z).CompletionTime
            wSTB  = g_OLC(Z).CallbackTime
    
          ' get delay between write time and Completion time
            dwdelayms =  SystemTimeDiffms (wSTW, wSTC)
    
            sBuff  = USING$ (Mask, z, wSTW.whour, wStw.wminute, wSTW.wSecond, wStW.wMilliseconds, _
                                      wSTB.whour, wStB.wminute, wSTB.wSecond, wStB.wMilliseconds, _
                                      wSTC.whour, wStC.wminute, wSTC.wSecond, wStC.wMilliseconds, _
                                      dwDelayms)
    
            PRINT #hFile, sBuff
     NEXT Z
    
     PRINT #hFile,
     CLOSE hFile
    
    
    END FUNCTION
    
    
    FUNCTION PBMAIN() AS LONG
    
        LOCAL szFile AS ASCIIZ * %MAX_PATH
        LOCAL nToWrite AS LONG
        LOCAL RecLen AS LONG
        LOCAL iCount AS LONG
        LOCAL hFile AS LONG
        LOCAL s     AS STRING
    
        LOCAL rTime AS STRING, iPendCount AS LONG, Ctime AS STRING
    
        ' ------------------------------------------------------
        ' Asynch I-O Using WriteFileEx with callback procedure
        ' ------------------------------------------------------
        szFile    = $FILENAME_DATA
        nToWrite  = %NUMBER_OF_WRITES
        RecLen    = %RECORD_LENGTH      '  Note program will run minimum of
        '                                 '%NUMBER_OF_WRITES * %WORKER_THREAD_DELAY_MS \ 1000 seconds
    
        CALL WriteRecordsOverlappedWriteFileEx (szFile, nToWrite, REcLen)
    
        iPendCount = THREADCOUNT-1     ' number of worker threads still executing when  write function returns.
        rTime      = TIME$             ' time writing completed.
    
        ' ----------------------------------------------------------------------------------------
        ' ---- terribly lazy and inefficient code to verify all worker threads have completed
        ' ---- but hell, it's just a test anyway so I am excused from doing it the correct way.
        ' ----------------------------------------------------------------------------------------
        DO
           iCount = THREADCOUNT
        LOOP UNTIL iCount = 1   ' when one, only the primary thread of execution is running.
    
        Ctime = TIME$    ' time when all worker threads have completed
    
    
        ' Create Report
        szFile = $FILENAME_REPORT
        CALL     ReportResults (szFile)
    
        ' Append summary to report file and end it
        hFile = FREEFILE
        OPEN    szFile FOR APPEND AS hFile
        s     = USING$("Writing completed at &  with # worker threads still running_. Program completed &", _
                       rTime,iPendCount, CTime)
        PRINT   #hFile,s
        PRINT   #hFile,
        s     = "** END OF REPORT **"
        PRINT   #hFile, s
        CLOSE   hfile
    
        MSGBOX "Done",, "Overlapped I-O Demo Ends"
    
    
    END FUNCTION
    
    ' /// END OF FILE.
    ------------------
    Michael Mattias
    Tal Systems Inc.
    Racine WI USA
    mailto:[email protected][email protected]</A>
    www.talsystems.com
    Michael Mattias
    Tal Systems Inc. (retired)
    Racine WI USA
    [email protected]
    http://www.talsystems.com
Working...
X