In multi-threaded mode, the program is supposed to check for when threads end, then de-allocate the memory used.
In single thread mode, the program works fine. In multi-thread mode, I am getting strange memory errors. There is something I am just not understanding.
Some help would be greatly appreciated!
Rich
Code: Select all
; ------------------------------------------------------------
; Program name: con_srv.pb
; ------------------------------------------------------------
EnableExplicit
#ServerPort = 12000
#BaseDirectory = "d:\webroot"
#DefaultPage = "index.html"
#backSlash = "\"
Define *MemoryID.i
Define *MemLoc.i
Define SEvent.i
Define ClientID.i
Define ClientIP.i
Define Thread.i
Define Result.i
Define llIndex.i
Define ListCt.i
Define ListNdx.i
Define rightNow.i
Define KeyPressed.s
Define mode.s
Define modeNumber
Define lastCheck.i = ElapsedMilliseconds()
Declare ProcessRequest(*MemoryID)
Declare ErrorHandler()
OpenConsole()
; make sure we can initialize the network
If InitNetwork() = 0
PrintN("Can't initialize the network!")
Input()
End
EndIf
If CreateNetworkServer(0, #ServerPort) = 0
PrintN("Can't create the Server on port " + Str(#ServerPort))
Input()
End
EndIf
; define the lists needed to keep track of the threads used
NewList MemoryList.i()
NewList ThreadList.i()
NewList TimedList.i()
OnErrorCall(@ErrorHandler())
PrintN("Press Escape to exit")
PrintN("")
PrintN("Run as multi-threaded or single-threaded")
PrintN("")
PrintN("1. Multi-threaded")
PrintN("2. Single-threaded")
PrintN("Enter 1 or 2:")
mode = Input()
If mode = "1" Or mode = "2"
modeNumber = Val(mode)
If modeNumber = 1
PrintN("Multi-threaded mode selected")
Else
PrintN("Single-threaded mode selected")
EndIf
Else
End
EndIf
; **********************************************************************************
; main loop here
; **********************************************************************************
Repeat
SEvent = NetworkServerEvent() ; if we receive data, it will be indicated here
Select SEvent
Case #PB_NetworkEvent_Data ; raw data has been received
ClientID = EventClient()
ClientIP = GetClientIP(ClientID)
*MemoryID = AllocateMemory(SizeOf(ClientID))
PokeI(*MemoryID, ClientID)
If modeNumber = 1
Thread = CreateThread(@ProcessRequest(), *MemoryID)
Gosub AddToLists
Else
ProcessRequest(*MemoryID)
FreeMemory(*MemoryID)
EndIf
Default; nothing of importance to us has happened, go around again
Delay(50); sleep 1/20th of a second so we don't take all of the processor
EndSelect
; now see if any threads have completed, so that we can deallocate the memory
If modeNumber = 1
Gosub CheckThreads
EndIf
KeyPressed = Inkey()
Until KeyPressed = #ESC$
If modeNumber = 1
PrintN("")
PrintN("Checking thread for completion...")
Repeat
Delay(1000)
lastCheck = lastCheck - 10000
Gosub CheckThreads
Until ListSize(MemoryList()) = 0
EndIf
CloseNetworkServer(0)
; **********************************************************************************
; End of main loop, procedures below process the web requests
; **********************************************************************************
; **********************************************************************************
; procedure below serves the web request
; **********************************************************************************
Procedure ProcessRequest(*MemoryLoc.i)
Protected *memLocID.i
Protected fileBuffer.s
Protected connectNumber.i
Protected RequestStr.s = Space(1000)
Protected ContentType.s
Protected RequestedFile.s
Protected fileLength.i = 0
Protected htmlHeader.s
Protected fileName.s
Protected Suffix.s
Protected fileHandle.i
Protected Result.i = 0
Protected lenHeader.l
Protected firstLine.s
connectNumber = PeekI(*MemoryLoc)
Result = ReceiveNetworkData(connectNumber, @RequestStr, 1000)
If Result <= 0
RequestStr = ""
EndIf
If Left(RequestStr, 3) = "GET"
firstLine = StringField(RequestStr, 1, #CR$)
RequestedFile = StringField(firstLine, 2, " ")
RequestedFile = ReplaceString(RequestedFile, "/", #backSlash)
If Left(RequestedFile, 1) <> #backSlash
RequestedFile = #backSlash + RequestedFile
EndIf
; now determine the directory for the file needed
RequestedFile = LCase(RequestedFile)
fileName = StringField(RequestedFile, 1, ".")
Suffix = StringField(RequestedFile, 2, ".")
RequestedFile = #BaseDirectory + RequestedFile
fileHandle = ReadFile(#PB_Any, RequestedFile)
If fileHandle
fileLength = Lof(fileHandle)
EndIf
; now see if the file exists and if so, read it, if not just close the socket
If fileLength
fileBuffer = Space(fileLength)
Result = ReadData(fileHandle, @fileBuffer, fileLength)
CloseFile(fileHandle)
EndIf
If fileLength = 0
Suffix = "htm"
fileBuffer = "<html>" + #CRLF$
fileBuffer = fileBuffer + "<head>" + #CRLF$
fileBuffer = fileBuffer + "<title>Page Not Found</title>" + #CRLF$
fileBuffer = fileBuffer + "</head>" + #CRLF$
fileBuffer = fileBuffer + "<body>" + #CRLF$
fileBuffer = fileBuffer + "<h2 align=" + #DQUOTE$ + "center" + #DQUOTE$ + ">Page Not Found</h2>" + #CRLF$
fileBuffer = fileBuffer + "</body>" + #CRLF$
fileBuffer = fileBuffer + "</html>" + #CRLF$
fileBuffer = fileBuffer + #CRLF$
fileLength = Len(fileBuffer)
EndIf
PrintN("Requested file: " + RequestedFile)
; check the file type requested
Select Suffix
Case "ico"
ContentType = "image/ico" + #CRLF$ + "Cache-Control: max-age=172800, public, must-revalidate"
Case "png"
ContentType = "image/png" + #CRLF$ + "Cache-Control: max-age=172800, public, must-revalidate"
Case "gif"
ContentType = "image/gif" + #CRLF$ + "Cache-Control: max-age=172800, public, must-revalidate"
Case "jpg"
ContentType = "image/jpeg" + #CRLF$ + "Cache-Control: max-age=172800, public, must-revalidate"
Case "txt"
ContentType = "text/plain" + #CRLF$ + "Cache-Control: max-age=172800, public, must-revalidate"
Case "wav"
ContentType = "audio/x-wav" + #CRLF$ + "Cache-Control: max-age=172800, public, must-revalidate"
Case "css"
ContentType = "text/css" + #CRLF$ + "Cache-Control: max-age=86400, public, must-revalidate"
Case "xml"
ContentType = "text/xml" + #CRLF$ + "Cache-Control: no-cache, must-revalidate" + #CRLF$ + "Pragma: no-cache"
Case "js"
ContentType = "application/javascript" + #CRLF$ + "Cache-Control: max-age=86400, public, must-revalidate"
Case "zip"
ContentType = "application/zip" + #CRLF$ + "Cache-Control: no-cache, must-revalidate" + #CRLF$ + "Pragma: no-cache"
Case "csv", "xls", "xlsm", "xlsx"
ContentType = "application/vnd.ms-excel" + #CRLF$ + "filename=" + RequestedFile
ContentType = ContentType + #CRLF$ + "Cache-Control: private, max-age=15"
Default
ContentType = "text/html" + #CRLF$ + "Cache-Control: no-cache, must-revalidate" + #CRLF$ + "Pragma: no-cache"
EndSelect
; create the html header
htmlHeader = "HTTP/1.1 200 OK" + #CRLF$
htmlHeader = htmlHeader + "Date: Wed, 07 May 2011 11:15:43 GMT" + #CRLF$
htmlHeader = htmlHeader + "Content-Length: " + Str(fileLength) + #CRLF$
htmlHeader = htmlHeader + "Content-Type: " + ContentType + #CRLF$ + #CRLF$
lenHeader = Len(htmlHeader)
; now send the data
SendNetworkString(connectNumber, htmlHeader)
SendNetworkData(connectNumber, @fileBuffer, fileLength)
EndIf
CloseNetworkConnection(connectNumber)
EndProcedure
; **********************************************************************************
; error handler
; **********************************************************************************
Procedure ErrorHandler()
PrintN("A program error was detected:")
PrintN("")
PrintN("Error Message: " + ErrorMessage())
PrintN("Error Code: " + Str(ErrorCode()))
PrintN("Code Address: " + Str(ErrorAddress()))
If ErrorCode() = #PB_OnError_InvalidMemory
PrintN("Target Address: " + Str(ErrorTargetAddress()))
EndIf
PrintN("Sourcecode line: " + Str(ErrorLine()))
PrintN("Sourcecode file: " + ErrorFile())
PrintN("Register content:")
CompilerSelect #PB_Compiler_Processor
CompilerCase #PB_Processor_x86
PrintN("EAX = " + Str(ErrorRegister(#PB_OnError_EAX)))
PrintN("EBX = " + Str(ErrorRegister(#PB_OnError_EBX)))
PrintN("ECX = " + Str(ErrorRegister(#PB_OnError_ECX)))
PrintN("EDX = " + Str(ErrorRegister(#PB_OnError_EDX)))
PrintN("EBP = " + Str(ErrorRegister(#PB_OnError_EBP)))
PrintN("ESI = " + Str(ErrorRegister(#PB_OnError_ESI)))
PrintN("EDI = " + Str(ErrorRegister(#PB_OnError_EDI)))
PrintN("ESP = " + Str(ErrorRegister(#PB_OnError_ESP)))
CompilerCase #PB_Processor_x64
PrintN("RAX = " + Str(ErrorRegister(#PB_OnError_RAX)))
PrintN("RBX = " + Str(ErrorRegister(#PB_OnError_RBX)))
PrintN("RCX = " + Str(ErrorRegister(#PB_OnError_RCX)))
PrintN("RDX = " + Str(ErrorRegister(#PB_OnError_RDX)))
PrintN("RBP = " + Str(ErrorRegister(#PB_OnError_RBP)))
PrintN("RSI = " + Str(ErrorRegister(#PB_OnError_RSI)))
PrintN("RDI = " + Str(ErrorRegister(#PB_OnError_RDI)))
PrintN("RSP = " + Str(ErrorRegister(#PB_OnError_RSP)))
PrintN("Display of registers R8-R15 skipped.")
CompilerEndSelect
Input()
End
EndProcedure
; **********************************************************************************
; end of procedures
; **********************************************************************************
End
; **********************************************************************************
; add to the lists so we can deallocate memmory as needed
; **********************************************************************************
AddToLists:
AddElement(MemoryList())
MemoryList() = *MemoryID
AddElement(ThreadList())
ThreadList() = Thread
AddElement(TimedList())
TimedList() = ElapsedMilliseconds()
Return
; **********************************************************************************
; check the threads, so we can deallocate memmory as needed
; **********************************************************************************
CheckThreads:
rightNow = ElapsedMilliseconds()
If rightNow - lastCheck > 9999; only check once every 10 seconds
lastCheck = rightNow
ListCt = ListSize(ThreadList())
For ListNdx=ListCt To 1 Step -1
llIndex = ListNdx - 1; offset is 0
SelectElement(MemoryList(), llIndex)
SelectElement(ThreadList(), llIndex)
SelectElement(TimedList(), llIndex)
If IsThread(ThreadList()) = 0
*MemLoc = MemoryList()
FreeMemory(*MemLoc)
DeleteElement(MemoryList())
DeleteElement(ThreadList())
DeleteElement(TimedList())
Else
If rightNow - TimedList() > 59999; kill the thread after 60 seconds
KillThread(ThreadList())
*MemLoc = MemoryList()
FreeMemory(*MemLoc)
DeleteElement(MemoryList())
DeleteElement(ThreadList())
DeleteElement(TimedList())
EndIf
EndIf
Next
; re-initialize the lists if they are empty
If ListSize(MemoryList()) = 0
ClearList(MemoryList())
ClearList(ThreadList())
ClearList(TimedList())
PrintN("Lists are cleared, remember to press Escape to exit")
EndIf
EndIf
Return
; IDE Options = PureBasic 4.51 (Windows - x64)
; CursorPosition = 68
; FirstLine = 54
; Folding = -
; EnableThread
; EnableXP
; EnableOnError
; Executable = con_srv.exe
; HideErrorLog
; CurrentDirectory = D:\dev\PureBasic\temp\
; CompileSourceDirectory
; Compiler = PureBasic 4.51 (Windows - x64)
; EnablePurifier