Runtime error 4 (out of memory) on Redim?

New to FreeBASIC? Post your questions here.
Post Reply
Iczer
Posts: 99
Joined: Jul 04, 2017 18:09

Runtime error 4 (out of memory) on Redim?

Post by Iczer »

I got strange error - Aborting due to runtime error 4 (out of memory) at line ...
It's x64, not mach of size, function is not recursive, same code works...

I just do not understand why it crush... what I should do to make it work?
line in question:

Code: Select all

ReDim Preserve wszaFolders(1 To (folderCount Shl 1)) As WString Ptr
output:

Code: Select all

x-> GetFolderSize :: folder Count > UBound(wszaFolders) : Redim : 65 -> 130
x-> GetFolderSize :: folder Count > UBound(wszaFolders) : Redim : 131 -> 262
x-> GetFolderSize :: folder Count > UBound(wszaFolders) : Redim : 263 -> 526
x-> GetFolderSize :: folder Count > UBound(wszaFolders) : Redim : 527 -> 1054
x-> GetFolderSize :: folder Count > UBound(wszaFolders) : Redim : 1055 -> 2110
x-> GetFolderSize :: folder Count > UBound(wszaFolders) : Redim : 2111 -> 4222

Aborting due to runtime error 4 (out of memory) at line ...
fxm
Moderator
Posts: 12132
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Runtime error 4 (out of memory) on Redim?

Post by fxm »

Can you compile your code with the -exx option, and then execute it ?
Iczer
Posts: 99
Joined: Jul 04, 2017 18:09

Re: Runtime error 4 (out of memory) on Redim?

Post by Iczer »

Yes - it was compiled with:

Code: Select all

fbc -gen gcc -asm intel -s gui -dll -export -mt -fpu SSE -vec 2 -exx -t 16386
fxm
Moderator
Posts: 12132
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Runtime error 4 (out of memory) on Redim?

Post by fxm »

The over-consumption of memory is perhaps elsewhere and this line is perhaps only the last small step which causes memory to overflow.
To better help you, we should have access to the full code, or better, to a reduced code that causes this same "out of memory".
Iczer
Posts: 99
Joined: Jul 04, 2017 18:09

Re: Runtime error 4 (out of memory) on Redim?

Post by Iczer »

I added memory usage test before redims and got:

Code: Select all

x-> IndexSSDB_GetFolderSize :: folder Count > UBound(wszaFolders) : Redim : 65 -> 520
----------------------------------------------------------------
> GetProcessMemoryInfo RetVal :: true
................................................................
> 28.667      [0] - The number of page faults.
> 78.446.592  [1] - The peak working set size, in bytes.
> 78.004.224  [2] - The current working set size, in bytes.
> 243.024     [3] - The peak paged pool usage, in bytes.
> 240.832     [4] - The current paged pool usage, in bytes.
> 16.320      [5] - The peak nonpaged pool usage, in bytes.
> 15.968      [6] - The current nonpaged pool usage, in bytes.
> 86.274.048  [7] - The current space allocated for the pagefile, in bytes.
> 86.827.008  [8] - The peak space allocated for the pagefile, in bytes.
----------------------------------------------------------------
x-> IndexSSDB_GetFolderSize :: folder Count > UBound(wszaFolders) : Redim : 521 -> 4168
----------------------------------------------------------------
> GetProcessMemoryInfo RetVal :: true
................................................................
> 28.692      [0] - The number of page faults.
> 78.446.592  [1] - The peak working set size, in bytes.
> 78.106.624  [2] - The current working set size, in bytes.
> 243.024     [3] - The peak paged pool usage, in bytes.
> 240.832     [4] - The current paged pool usage, in bytes.
> 16.336      [5] - The peak nonpaged pool usage, in bytes.
> 15.968      [6] - The current nonpaged pool usage, in bytes.
> 86.274.048  [7] - The current space allocated for the pagefile, in bytes.
> 86.827.008  [8] - The peak space allocated for the pagefile, in bytes.
----------------------------------------------------------------
x-> IndexSSDB_GetFolderSize :: folder Count > UBound(wszaFolders) : Redim : 4169 -> 33352
----------------------------------------------------------------
> GetProcessMemoryInfo RetVal :: true
................................................................
> 28.888      [0] - The number of page faults.
> 78.786.560  [1] - The peak working set size, in bytes.
> 78.786.560  [2] - The current working set size, in bytes.
> 243.024     [3] - The peak paged pool usage, in bytes.
> 240.928     [4] - The current paged pool usage, in bytes.
> 16.480      [5] - The peak nonpaged pool usage, in bytes.
> 16.048      [6] - The current nonpaged pool usage, in bytes.
> 86.708.224  [7] - The current space allocated for the pagefile, in bytes.
> 86.827.008  [8] - The peak space allocated for the pagefile, in bytes.
----------------------------------------------------------------
- Engine unloaded.

Aborting due to runtime error 4 (out of memory) at line 1647 of 
it seems memory usage is not issue - it less than 80Mb

function code:

Code: Select all

Function IndexSSDB_GetFolderSize(ByVal wszPath As WString Ptr, ByVal norecur As Long = 0, ByRef iERR As Long = 0, ByRef fileCount As LongInt = 0) As ULongInt

	Dim hSearch as HANDLE = 0
	Dim WFD AS WIN32_FIND_DATAW
	Dim As ULARGE_INTEGER ull

	Dim AS WString Ptr wszStringPrefix, wszStringSuffix, wszStringSlashAndSuffix, pwzFilePath, pwzFolderName, pwzFileName' wszaFolders(Any), 
	Dim As Long folderCurrent = 1, folderCount = 1, iLen, iLenPoint = 0' iaFoldersLen(Any),
	Dim As ULongInt iFolderSize
	
	iERR = 0
	fileCount = 0
	iFolderSize = 0
	
	pwzFilePath		= Callocate(2048,2)
	pwzFolderName	= Callocate(2048,2)
	pwzFileName		= Callocate(2048,2)
	
	wszStringPrefix = Callocate(8,2) : *wszStringPrefix = WStr("\\?\")
	wszStringSuffix = Callocate(8,2) : *wszStringSuffix = WStr("*.*")
	wszStringSlashAndSuffix = Callocate(8,2) : *wszStringSlashAndSuffix = WStr("\*.*")
	
	ReDim wszaFolders(1 To IIf(norecur = 0,64,1)) AS WString Ptr
	ReDim iaFoldersLen(1 To IIf(norecur = 0,64,1)) As Long
	
	iaFoldersLen(folderCurrent) = wcslen(wszPath)
	wszaFolders(folderCurrent)  = Callocate(iaFoldersLen(folderCurrent)+16,2)
	
	If iaFoldersLen(folderCurrent) = 1 AndAlso wszPath[0] = WStr("*") Then
		wcsncpy(wszaFolders(folderCurrent), wszPath, iaFoldersLen(folderCurrent))	:	Clear(wszaFolders(folderCurrent)[iaFoldersLen(folderCurrent)],0,8)
	Else
		iLenPoint = 0
		wcsncpy(@wszaFolders(folderCurrent)[iLenPoint], wszStringPrefix, 4)										:	iLenPoint += 4
		wcsncpy(@wszaFolders(folderCurrent)[iLenPoint], wszPath,			  iaFoldersLen(folderCurrent))	:	iLenPoint += iaFoldersLen(folderCurrent)
		
		If wszPath[iaFoldersLen(folderCurrent)-1] = WStr("\") Then
			wcsncpy(@wszaFolders(folderCurrent)[iLenPoint], wszStringSuffix, 3)			:	iaFoldersLen(folderCurrent) -= 1
		Else
			wcsncpy(@wszaFolders(folderCurrent)[iLenPoint], wszStringSlashAndSuffix, 4)
		End If
	End If
	
	Do
		hSearch = FindFirstFileW(wszaFolders(folderCurrent), @WFD)
		
		If hSearch = INVALID_HANDLE_VALUE Then
			
			Dim As Integer iErrCurrent
			Dim As ZString Ptr lpMsgBuf, pszTMP
			
			WinAPI_GetLastErrorMSGAndCode(iErrCurrent, lpMsgBuf)
			
			WinAPI_WideCharToMultiByteEX(CP_UTF8, wszaFolders(folderCurrent),	pszTMP)
			
			Print "x-> IndexSSDB_GetFileListEX :: FindFirstFileW Error : {function failed with Error : {" & Str(iErrCurrent) & "} -> " & Str(*lpMsgBuf)
			Print "x-> IndexSSDB_GetFileListEX :: FindFirstFileW Error : {folder of Error : {" & Str(*pszTMP) & "}"
			
			CleanUp_StringPTR(lpMsgBuf)
			CleanUp_StringPTR(pszTMP)
			
			iERR = - iErrCurrent : iFolderSize = 0
			
			Exit Do
		Else
			Do
				If (WFD.dwFileAttributes AND FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then' found a folder
					'.................................................................................
					If norecur = 0 Then
						'..............................................................................
						If WFD.cFileName = WStr(".") OrElse WFD.cFileName = WStr("..") OrElse WFD.cFileName = WStr("RECYCLER") OrElse WFD.cFileName = WStr("System Volume Information") Then
							Continue Do
						EndIf
						'..............................................................................
						folderCount += 1
						'..............................................................................
						If folderCount > UBound(wszaFolders) Then
							Print "x-> IndexSSDB_GetFolderSize :: folder Count > UBound(wszaFolders) : Redim : " & Str(folderCount) & " -> " & Str(folderCount Shl 3)
							
							Print_GetProcessMemoryInfo()
							
							ReDim Preserve wszaFolders(1 To (folderCount Shl 3)) As WString Ptr
							ReDim Preserve iaFoldersLen(1 To (folderCount Shl 3)) As Long
						EndIf
						'..............................................................................
						iLen = wcslen(@WFD.cFileName)	:	iaFoldersLen(folderCount) = iaFoldersLen(folderCurrent)+1+iLen	:	wszaFolders(folderCount) = Callocate(iaFoldersLen(folderCount)+16,2)
						iLenPoint = 0
						wcsncpy(@wszaFolders(folderCount)[iLenPoint], wszaFolders(folderCurrent),	iaFoldersLen(folderCurrent)+5):	iLenPoint += iaFoldersLen(folderCurrent)+5
						wcsncpy(@wszaFolders(folderCount)[iLenPoint], @WFD.cFileName, 					iLen)									:	iLenPoint += iLen
						wcsncpy(@wszaFolders(folderCount)[iLenPoint], wszStringSlashAndSuffix,		4)
						'..............................................................................
					EndIf
					'.................................................................................
				Else
					'.................................................................................
					fileCount += 1
					'.................................................................................
					ull.LowPart = WFD.nFileSizeLow
					ull.HighPart = WFD.nFileSizeHigh
					
					iFolderSize += ull.QuadPart
					'.................................................................................
				End If
				
				If IndexSSDB_DropCurrentIndexing <> 0 Then
					FindClose(hSearch) : iERR = -12345678 : fileCount = 0 : iFolderSize = 0
					Exit Do, Do
				EndIf
				
			Loop While FindNextFileW(hSearch, @WFD)
			FindClose(hSearch)
		End If
		folderCurrent += 1
	Loop Until folderCurrent > folderCount
	' ............................................................................................
	' ............................................................................................
	CleanUp_StringPTRArray(wszaFolders) : CleanUp_StringPTR(wszStringPrefix) : CleanUp_StringPTR(wszStringSuffix) : CleanUp_StringPTR(wszStringSlashAndSuffix)'	:	CleanUp_StringPTR(pszTMP)
	CleanUp_StringPTR(pwzFilePath) : CleanUp_StringPTR(pwzFolderName) : CleanUp_StringPTR(pwzFileName)
	
	Erase iaFoldersLen
	Erase wszaFolders
	' ............................................................................................
	Return iFolderSize
End Function
fxm
Moderator
Posts: 12132
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Runtime error 4 (out of memory) on Redim?

Post by fxm »

Could we also have the body of procedures 'CleanUp_StringPTR', 'CleanUp_StringPTRArray' and 'wcsncpy' ?
adeyblue
Posts: 300
Joined: Nov 07, 2019 20:08

Re: Runtime error 4 (out of memory) on Redim?

Post by adeyblue »

This has a problem when you pass in * for wszPath
You're not putting a prefix on it but
iLenPoint += iaFoldersLen(folderCurrent)+5
assumes its there.

That copies the asterisk and some nulls (then the rest, which is ignored by FindFirstFile) to foldercount so it will continuously enumerate the same directory over and over again without end.
Iczer
Posts: 99
Joined: Jul 04, 2017 18:09

Re: Runtime error 4 (out of memory) on Redim?

Post by Iczer »

Function 'wcsncpy' is from standart include '\inc\crt\string.bi' other is macros:

Code: Select all

#Macro CleanUp_StringPTR(sPTR)
	
	Scope
		If sPTR <> 0 Then
			
			*sPTR = ""
			DeAllocate(sPTR)
			sPTR = 0
			
		EndIf
		
	End Scope
	
#EndMacro

#Macro CleanUp_StringPTRArray(asPTR)
	
	Scope
	
		If Not (LBound(asPTR) = 0 And Ubound(asPTR) = -1) Then 
			
			For i As Integer = LBound(asPTR) To UBound(asPTR)
				If asPTR(i) <> 0 Then
					*asPTR(i) = ""
					DeAllocate(asPTR(i))
					asPTR(i) = 0
				EndIf
			Next
		EndIf
		
	End Scope
	
#EndMacro
adeyblue wrote: Oct 31, 2023 20:53 This has a problem when you pass in * for wszPath...
thanks, i will address this
Post Reply