Tweet
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