Check for heap space max vs. used?

General FreeBASIC programming questions.
Post Reply
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Check for heap space max vs. used?

Post by rolliebollocks »

If (as fxm said) my program was segfaulting because the heap had been exhausted, is there some way to catch that error and halt execution before the program segfaults? Would help if it worked under both linux and windows.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Re: Check for heap space max vs. used?

Post by rolliebollocks »

It should also be noted that the program segfaults on redundant calls to the same function, even with proper destructors in place.

Code: Select all

#ifndef NULL
#define NULL 0
#endif

#DEFINE DBLQUOTE ascii(34)

dim shared as string*1 ASCII(255)

    for i as integer = 0 to 255
        ASCII(i) = chr(i)
    next
    
    function IsWhite(c as ubyte) as integer
  if c=32 then return 1
  if c= 9 then return 1
  if c=10 then return 1
  if c=13 then return 1
  return 0
end function

function unEscape( byval s as string ) as string
    dim as string res = ""
    dim as integer i = 0
    dim as integer l = len( s ) - 1
    
    Do
        if s[i] = asc("\") andalso i < l then
            select case s[i+1]
            case 34  : res += ascii( 34 ) : i += 1
            case asc("/") : res += "/" : i += 1
            case asc("\") : res += "\" : i += 1
            case asc("b") : res += ascii( 8 ) : i += 1
            case asc("f") : res += ascii( 12 ) : i += 1
            case asc("n") : res += !"\n" : i += 1
            case asc("r") : res += !"\r" : i += 1
            case asc("t") : res += !"\t" : i += 1
            case asc("u") : res += ascii( s[i] ) : i += 2
            case else : res += ascii( s[i] ) : i += 1
            end select
        else
            res += ascii( s[i] )
        endif
        
        i += 1
        if i > l then exit do
    loop
    return res
end function

function IsNumberJson(c as ubyte) as integer
  select case as const c
  case asc("0") to asc("9") : return 1
  case asc("-"), asc(".") : return 1
  end select
  return 0
end function


enum varType
  _MALFORMED_ = 0
  _NUMBER_    = 1
  _STRING_    = 2
  _BOOL_      = 3
  _ARRAY_     = 4
  _OBJECT_    = 5
  _NULL_      = 6
end enum

enum JSON_BOOL
    _FALSE_ = 0
    _TRUE_  = 1
end enum

type variable_ as variable

type varArray
    
    Public: 
        declare Destructor()
        declare sub add( byval item as variable_ ptr )
        declare function get( byval index as integer ) as variable_ ptr
        declare function getLength() as integer
        declare sub push( byval idx as integer, byval item as variable_ ptr )
        declare sub push( byval idx as integer, byref item as variable_ )
        declare sub pop( byval item as integer )
        declare sub push_back( byval item as variable_ ptr )
        declare sub clear()
            
        as integer size
        as variable_ ptr items(any)
        
end type

type varObjectField
    Public:
        declare Destructor()
        as string           key 
        as variable_ ptr    value
end type

type varObject

    Public:
    
        declare Destructor()
        declare sub add( byval key as string, byval item as variable_ ptr )
        declare function get( byval key as string ) as variable_ ptr
        declare function getKey( byval index as integer ) as string
        declare function getValue( byval index as integer ) as variable_ ptr
        declare function getSize() as integer
        declare sub pop( byval idx as integer )
           
        as integer              size
        as varObjectField ptr   fields(any)

end type

type variable extends Object

    Public:
        declare Constructor()
        declare Constructor( byref rhs as variable )
        declare Constructor( byval json as string, byval n as string = "" )
        declare Constructor( byval n as double )
        declare Destructor()
        declare Operator Let( byref rhs as variable )
        declare Operator Let( byval json as string )
        declare Operator Let( byval n as double )
        
        declare sub         init( byval s as string, byval n as string = "" )
        
        declare function    getType() as string
        declare function    getTypeNum() as vartype
        declare function    toString() as string
      
        declare function    getNumber() as double
        declare function    getString() as string
        declare function    getBoolean() as integer
        declare function    getArray() as vararray ptr
        declare function    getObject() as varobject ptr

        as string           lbl
        as varType          typ
        as double           number
        as string           strng
        as integer          bool
        as varArray ptr     array
        as varObject ptr    object

end type

Destructor varArray()
    for i as integer = 0 to this.size-1
        delete items(i)
    next
    erase items
End Destructor

sub varArray.add( byval item as variable_ ptr )
    size += 1
    redim preserve items(size-1)
    items(size-1) = new variable_
    *items(size-1) = *item
end sub

sub varArray.push( byval idx as integer, byval item as variable_ ptr )
    if idx < 0 then exit sub
    if idx > size-1 then exit sub
    
    redim preserve items( size )
    items( size ) = new variable_
    
    for i as integer = size-1 to idx step -1
        swap items(i), items(i+1)
    next i
    
    *items( idx ) = *item
    
    size += 1
end sub

sub varArray.push( byval idx as integer, byref item as variable_ )
    if idx < 0 then exit sub
    if idx > size-1 then exit sub
    
    redim preserve items( size )
    
    for i as integer = size-1 to idx step -1
        swap items(i), items(i+1)
    next i
    
    *items( idx ) = item
    
    size += 1
end sub

sub varArray.push_back( byval item as variable_ ptr )    
    redim preserve items( size )
    items( size ) = new variable
    *items( size ) = *item
    size += 1
end sub

sub varArray.pop( byval idx as integer )
    if idx < 0 then exit sub
    if idx > size-1 then exit sub
    if size = 1 then 
        erase( items )
        size = 0
        exit sub
    endif
    
    for i as integer = idx+1 to size-1
        items(i-1) = items(i)
    next
   
    size -= 1
    redim preserve items( 0 to size-1 )        
end sub

sub varArray.clear()
    for i as integer = 0 to size-1
        delete items(i)
    next i
    erase items
    size = 0
end sub

function varArray.get( byval index as integer ) as variable_ ptr
    if index >= size or index < 0 then return NULL
    return items(index)
end function

function varArray.getLength() as integer
    return size
end function

Destructor varObjectField()
    delete value
end Destructor

Destructor varObject
    for i as integer = 0 to this.size-1
        delete fields(i)
    next i
    erase fields
end Destructor

sub varObject.add( byval key as string, byval item as variable_ ptr )
    size += 1
    redim preserve fields(size-1)
    fields(size-1) = new varObjectField
    fields(size-1)->key = key
    fields(size-1)->value = new variable_
    *fields(size-1)->value = *item
end sub

function varObject.get( byval key as string ) as variable_ ptr
    key = chr(34)+key+chr(34)
    for i as integer = 0 to size-1
        if fields(i)->key = key then return fields(i)->value
    next i
    return 0
end function

function varObject.getKey( byval index as integer ) as string
    return fields(index)->key
end function

function varObject.getValue( byval index as integer ) as variable_ ptr
    return fields(index)->value
end function

function varObject.getSize() as integer
    return size
end function

sub varObject.pop( byval idx as integer )
    if idx < 0 then exit sub
    if idx > size-1 then exit sub
    if size = 1 then 
        erase( fields )
        size = 0
        exit sub
    endif
    
    for i as integer = idx+1 to size-1
        fields(i-1) = fields(i)
    next
   
    size -= 1
    redim preserve fields( 0 to size-1 )  
end sub

declare Operator = ( byref lhs as variable, byref rhs as variable ) as integer

Constructor variable()
end Constructor

Constructor variable( byref rhs as variable )
    this.lbl = rhs.lbl
    this.typ = rhs.typ
    
    select case rhs.typ
        case varType._BOOL_
            this.bool = rhs.bool
        case varType._NUMBER_ 
            this.number = rhs.number
        case varType._STRING_
            this.strng = rhs.strng
        case varType._OBJECT_
            this.object = new varObject
            redim this.object->fields( rhs.object->size - 1 )
            this.object->size = rhs.object->size
            if rhs.object->size then
                for i as integer = 0 to rhs.object->size - 1
                    this.object->fields(i) = new varObjectField
                    this.object->fields(i)->key = rhs.object->fields(i)->key
                    this.object->fields(i)->value = new variable
                    *this.object->fields(i)->value = *rhs.object->fields(i)->value
                next i
            end if
        case varType._ARRAY_
            this.array = new varArray
            if rhs.array->size then 
                redim this.array->items( rhs.array->size - 1 )
                this.array->size = rhs.array->size
                for i as integer = 0 to rhs.array->size - 1
                    this.array->items(i) = new variable
                    *this.array->items(i) = *rhs.array->items(i)
                next i
            end if
    end select
End Constructor

Operator variable.Let( byref rhs as variable )
    if @this <> @rhs then
        this.lbl = rhs.lbl
        this.typ = rhs.typ
        
        select case rhs.typ
            case varType._BOOL_
                this.bool = rhs.bool
            case varType._NUMBER_ 
                this.number = rhs.number
            case varType._STRING_
                this.strng = rhs.strng
            case varType._OBJECT_
                this.object = new varObject
                redim this.object->fields( rhs.object->size - 1 )
                this.object->size = rhs.object->size
                if rhs.object->size then
                    for i as integer = 0 to rhs.object->size - 1
                        this.object->fields(i) = new varObjectField
                        this.object->fields(i)->key = rhs.object->fields(i)->key
                        this.object->fields(i)->value = new variable
                        *this.object->fields(i)->value = *rhs.object->fields(i)->value
                    next i
                end if
            case varType._ARRAY_
                this.array = new varArray
                if rhs.array->size then
                    this.array->size = rhs.array->size
                    redim this.array->items( rhs.array->size - 1 )
                    for i as integer = 0 to rhs.array->size - 1
                        this.array->items(i) = new variable
                        *this.array->items(i) = *rhs.array->items(i)
                    next i
                end if
             case else
				'? "Something is #%$@"
        end select
    end if
end Operator

sub copy_variable( byref var1 as variable, byref var2 as variable )
    var1.lbl = var2.lbl
    var1.typ = var2.typ
    
    select case var2.typ
        case _BOOL_
            var1.bool = var2.bool
        case _NUMBER_ 
            var1.number = var2.number
        case _STRING_
            var1.strng = var2.strng
        case _OBJECT_
            var1.object = new varObject
            redim var1.object->fields( var2.object->size - 1 )
            for i as integer = 0 to var2.object->size - 1
                var1.object->fields(i) = new varObjectField
                var1.object->fields(i)->key = var2.object->fields(i)->key
                *var1.object->fields(i)->value = *var2.object->fields(i)->value
            next i
        case _ARRAY_
            var1.array = new varArray
            redim var1.array->items( var2.array->size - 1 )
            var1.array->size = var2.array->size
            
            for i as integer = 0 to var2.array->size - 1
                var1.array->items(i) = new variable
                *var1.array->items(i) = *var2.array->items(i)
            next i
    end select
end sub

Constructor variable( byval json as string, byval n as string = "" )
    init( json, n )
end Constructor

Constructor variable( byval num as double )
    this.typ = _NUMBER_
    this.number = num
end Constructor

Operator variable.Let( byval json as string )
	init( json )
end Operator

Operator variable.Let( byval num as double )
    this.typ = _NUMBER_
    this.number = num
end Operator

Operator = ( byref lhs as varObjectField, byref rhs as varObjectField ) as integer
    if lhs.key <> rhs.key then return 0
    if ( *lhs.value = *rhs.value ) = 0 then return 0
    return -1
end Operator

Operator = ( byref lhs as variable, byref rhs as variable ) as integer
    if lhs.typ <> rhs.typ then return 0
    select case lhs.typ
    case varType._NUMBER_
        if lhs.number <> rhs.number then return 0
    case varType._STRING_
        if lhs.strng <> rhs.strng then return 0
    case varType._BOOL_
        if lhs.bool <> rhs.bool then return 0
    case varType._ARRAY_
        if lhs.array->size <> rhs.array->size then return 0
        for i as integer = 0 to lhs.array->size-1
            if ( *lhs.array->items(i) = *rhs.array->items(i) ) = 0 then return 0
        next i
    case varType._OBJECT_
        if lhs.object->size <> rhs.object->size then return 0
        for i as integer = 0 to lhs.object->size-1
            if ( *lhs.object->fields(i) = *rhs.object->fields(i) ) = 0 then return 0
        next i
    end select
    
    return -1
end Operator

function array_has overload ( byref arr as variable, byref v as variable ) as integer
	dim as integer res = 0
	if arr.array = 0 then return 0
	for i as integer = 0 to arr.array->size - 1
		if *arr.array->items(i) = v then return i+1
		if arr.array->items(i)->typ = _ARRAY_ then
			res = array_has( *arr.array->items(i), v )
			if res then return res
		end if
	next i
	return res
end function

function array_has overload ( byref arr as variable, byval v as string ) as integer
	dim as integer res = 0
	if arr.array = 0 then return 0
	for i as integer = 0 to arr.array->size - 1
		if arr.array->items(i)->strng = v then return i+1
		if arr.array->items(i)->typ = _ARRAY_ then
			res = array_has( *arr.array->items(i), v )
			if res then return res
		end if
	next i
	return res
end function

function array_has_malformed( byref arr as variable ) as integer
    dim as integer res = 0
    if arr.array = 0 then return 0
    for i as integer = 0 to arr.array->size - 1
        if arr.array->items(i)->typ = _MALFORMED_ then return -1
        if arr.array->items(i)->typ = _ARRAY_ then 
            res = array_has_malformed( *arr.array->items(i) )
            if res then return res
        end if
    next i
    return res
end function

Destructor variable()
    delete object
    delete array
end Destructor

sub variable.init( byval s as string, byval n as string = "" )
    dim as integer l = len(s)
    dim as integer arrayIsOpen = 0
    dim as integer objectIsOpen = 0
    dim as integer inQuotes = 0
    
    this.lbl = n

    for i as integer = 0 to l-1
        dim as ubyte c = s[i]

        if isWhite( c ) then continue for
        
        if isNumberJson( c ) then
            if arrayIsOpen or objectIsOpen then
                this.typ = _MALFORMED_
                this.strng = s
                exit sub
            endif

            this.typ = _NUMBER_
            dim as string inNum = ""
            
            Do while IsNumberJson( s[i] )
                inNum += ascii( s[i] )
                if i > l then
                    this.typ = _MALFORMED_
                    this.strng = s 
                    ? "Error: i > l"
                    exit sub
                endif
                i+=1
            loop
            
            this.number = val(inNum)
        endif

        if c = 34 then
            if arrayIsOpen or objectIsOpen then
                this.typ = _MALFORMED_
                this.strng = s
                ? "Array / Object is open"
                exit sub
            endif
            
            i+=1
            this.typ = _STRING_
            dim as string inString = ""
            dim as integer done = 0
            Do 
                if s[i-1] <> asc("\") then
                    if s[i] <> 34 then
                        inString += ascii( s[i] )
                        i+=1
                    else
                        done = 1
                    endif
                else
                    inString += ascii( s[i] )
                    i+=1
                endif

                if i >= l then
                    this.typ = _MALFORMED_
                    this.strng = s
                    ? "Error: i > l"
                    done = 1
                endif
            loop until done = 1
            
            if inString <> "" then this.strng = unEscape( inString )            
         
            if i <> l-1 then
                this.typ = _MALFORMED_
                this.strng = s
                ? "Error: i <> l-1", i, l-1 
                ? instring
            endif
        endif
        
        select case c
            case asc("t"),asc("T"),asc("f"),asc("F"),asc("n"), asc("N")
                if mid(s,i+1,4) = "true" then
                    this.typ = _BOOL_
                    this.bool = _TRUE_
                    i += 3
                elseif mid(s,i+1,4) = "null" then
                    this.typ = _NULL_
                    i += 3
                elseif mid(s,i+1,5) = "false" then
                    this.typ = _BOOL_
                    this.bool = _FALSE_
                    i += 4
                endif
        
            case asc("[")
                arrayIsOpen = 1
                this.typ = _ARRAY_
                this.array = new varArray
                dim as integer level = 1
                dim as string instring = ""
                
                i+=1
                Do 
                    dim as ubyte char2 = s[i]
                    dim as variable tmp
                                        
                    select case char2
                        
                        case 34
                            if inQuotes = 0 then inQuotes = 1 else inQuotes = 0
                            instring += ascii( char2 )
                            
                        case asc("[")
                            level += 1 
                            instring += "["
                            Do
                                i+=1
                                if s[i] = asc("[") then level += 1
                                if s[i] = asc("]") then level -= 1
                                instring += ascii( s[i] )
                            loop until level = 1
                            if instring <> "" then
                                tmp.init( instring )
                                array->add( @tmp )
                                instring = ""
                            endif
                        case asc("]") 
                            if instring <> "" then
                                if isWhite( instring[0] ) = 0 then
                                    tmp.init( instring )
                                    array->add( @tmp )
                                endif
                            endif
                            instring = ""
                            level -= 1
                        case asc(",") 
                            if inQuotes = 0 then
                                if instring <> "" then
                                    tmp.init( instring )
                                    array->add( @tmp )
                                    instring = ""
                                endif
                            else
                                instring += ascii( char2 )
                            endif
                        case asc("{")
                            dim as integer olevel = 1
                            instring += "{"
                
                            Do 
                                i+=1
                                if s[i] = asc("{") then olevel += 1
                                if s[i] = asc("}") then olevel -= 1
                                instring += ascii( s[i] )
                            loop until olevel = 0
                            
                            if instring <> "" then
                                tmp.init( instring )
                                array->add( @tmp )
                                instring = ""
                            endif
                        case else
                            instring += ascii( char2 )
                            
                    end select
                    i+=1
                loop until level = 0
                arrayIsOpen = 0
            
            case asc("{")
                objectIsOpen = 1 
                this.typ = _OBJECT_
                this.object = new varObject
                dim as integer olevel = 1, alevel, inQuotes = 0
                dim as string instring = "", key = ""
                dim as variable tmp
                
                Do
                    i+=1
                    dim as ubyte char2 = s[i]                    
                    
                    if isWhite( char2 ) AND inQuotes = 0 then continue do

                    if inQuotes = 1 then
                        if char2 <> 34 then 
                            instring += ascii( char2 )
                            continue do
                        endif
                    endif
                    
                    select case char2                            
                        case asc(":")
                           key = instring
                           instring = ""
                        case asc("[")
                            alevel += 1
                            instring += ascii( char2 )
                        case asc("]")
                            alevel -= 1
                            instring += ascii( char2 )
                        case asc("{")
                            olevel += 1
                            instring += ascii( char2 )
                            
                            Do
                                i+=1
                                char2 = s[i]
                                if char2 = 34 then
                                    if inQuotes = 1 then inQuotes = 0 else inQuotes = 1 
                                endif

                                if isWhite( char2 ) and inQuotes = 0 then Continue do                                
                                if char2 = asc("{") then olevel += 1
                                if char2 = asc("}") then olevel -= 1
                                if char2 = asc("[") then alevel += 1
                                if char2 = asc("]") then alevel -= 1
                                instring += ascii( char2 )
                            loop until olevel = 1 and alevel = 0
                            
                            if instring <> "" then
                                tmp.init( instring )
                                object->add( key, @tmp )
                                instring = ""
                            endif                            
                        case asc("}")
                            olevel -= 1
                            if olevel = 0 then
                                if instring <> "" then
                                    tmp.init( instring )
                                    object->add( key, @tmp )
                                    instring = ""
                                endif
                            endif
                        case asc(",")
                            if alevel = 0 then
                                if instring <> "" then
                                    tmp.init( instring )
                                    object->add( key, @tmp )
                                    instring = ""
                                endif
                            else
                                instring += ascii( char2 )
                            endif
                        case 34
                            instring += ascii( char2 )
                            if inQuotes = 1 then inQuotes = 0 else inQuotes = 1

                        case else                        
                            instring += ascii( char2 )
                    end select
                loop until olevel = 0
                objectIsOpen = 0
                
        end select
    next i
    
end sub

function variable.getType() as string
    select case typ
    case _NUMBER_:
        return "Number"
    case _STRING_:
        return "String"
    case _BOOL_:
        return "Boolean"
    case _ARRAY_:
        return "Array"
    case _OBJECT_:
        return "Object"
    case _NULL_:
        return "null"
    case _MALFORMED_:
        return "[MALFORMED]"
    end select
end function

function variable.getTypeNum() as vartype
    return typ
end function

function variable.toString() as string
    select case typ
    case _NUMBER_:
        return number & ""
    case _STRING_:
        return strng
    case _BOOL_:
        if bool then return "true"
        return "false"
    case _ARRAY_:
        return "ARRAY"
    case _OBJECT_:
        return "OBJECT"
    case _NULL_:
        return "null"
    case _MALFORMED_:
        return "[MALFORMED]"
  end select
end function

function variable.getNumber() as double
    if typ <> _NUMBER_ then return 0
    return number
end function

function variable.getString() as string
    if typ <> _STRING_ then return ""
    return strng
end function

function variable.getBoolean() as integer
    if typ <> _BOOL_ then return _FALSE_
    return bool
end function

function variable.getArray() as vararray ptr
    if typ <> _ARRAY_ then return NULL
    return array
end function

function variable.getObject() as varobject ptr
    if typ <> _OBJECT_ then return NULL
    return object
end function

declare function stringize_object( byref v as variable, byval l as integer = 0 ) as string 
declare function stringize_array( byref v as variable ) as string 

'dim shared as string stringize_string

function stringize_array( byref v as variable ) as string 
	if v.typ <> varType._ARRAY_ then return ""
	if v.array = 0 then return ""
	dim as integer length = v.array->size
	
	if length = 0 then return "[]"
	
	var s = "["	
	
	for i as integer = 0 to length - 1
		if v.array->items(i) <> 0 then
			dim as variable tmp = *v.array->items(i)
			select case tmp.typ
                case _ARRAY_ 	: 
                    s += stringize_array( tmp )
				case _STRING_ 	: 
					s += DBLQUOTE
					s += tmp.strng
					s += DBLQUOTE
				case _BOOL_		: 
                    s += tmp.toString
				case _NULL_		: 
                    s += "null"
				case _NUMBER_	: 
                    s &= tmp.number
				case _OBJECT_   : 
                    s += stringize_object( tmp )
			end select
		else
			s &= 0
		end if
		if i <> length-1 then s += "," else s += "]"
	next i 
	
	return s	
end function

function stringize_object( byref v as variable, byval l as integer = 0 ) as string 
	if v.typ <> varType._OBJECT_ then return ""
	if v.object = 0 then return ""
	dim as integer length = v.object->size 
	if length = 0 then return ""
	dim as string s 
    s += !"\n"
    for i2 as integer = 0 to l : s += !"\t" : next i2
    s += "{"
	
	for i as integer = 0 to length - 1
		var tkey = v.object->fields(i)->key
		s += !"\n\t"
        for i2 as integer = 0 to l : s += !"\t" : next i2
		s += tkey
		if len(tkey) > 6 then s += !":\t" else s+= !":\t\t"
		if v.object->fields(i)->value then
			var tmp = *v.object->fields(i)->value
			select case tmp.typ
				case _ARRAY_ 	: s += stringize_array( tmp )
				case _BOOL_  	: s += tmp.toString
				case _NULL_	 	: s += "NULL"
				case _NUMBER_	: s &= tmp.number
				case _OBJECT_	: s += stringize_object( tmp, l+1 )
				case _STRING_	: 
					s += DBLQUOTE
					s += tmp.strng
					s += DBLQUOTE
			end select
			if i <> length-1 then 
				s += "," 
			else 
				s += !"\n"
				for i2 as integer = 0 to l : s += !"\t" : next i2
				s += "}"
			endif
		end if
	next i
	
	return s
end function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'dim as variable dic = loadFileAsString( "Data/Dictionaries/master.dictionary.json" )
'dim as double t
't = timer
'? stringize_array2( dic )
'? timer-t
'sleep
''dim as variable dic2
'dic2.typ = _ARRAY_
'dic2.array = new varArray
'dic2.array->add( @dic )
'? dic2.array->items(0)->array->size
'sleep

'? dic2.array->size
'sleep
marcov
Posts: 3455
Joined: Jun 16, 2005 9:45
Location: Netherlands
Contact:

Re: Check for heap space max vs. used?

Post by marcov »

No. Just check every allocation for success.

There is no max, since the limit is that the sum of all processes must <= (memory +swap).

But if you query the max (for your program), that is dependent on all other applications, so that won't work. Thinking of maximum memory is dos era thinking.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Re: Check for heap space max vs. used?

Post by rolliebollocks »

Well I could do that. But I'm not sure how fxm arrived at the conclusion that I was exhausting the heap space so I need some way to test that theory.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Check for heap space max vs. used?

Post by fxm »

@dkl,

If the requested memory could not be allocated, (C)Allocate returns a null pointer:

Code: Select all

Dim As Integer n = 128*1024*1024

Do
  Dim As Byte Ptr p = Callocate(n*Sizeof(Byte))
  Print p
  If p = 0 Then Exit Do
Loop

Print "heap overflow"
Sleep
30867488
165150752
299434016
433717280
568000544
702283808
836567072
970850336
1105133600
1239416864
1373700128
1507983392
1642266656
1776549920
0
heap overflow
But it is not the case for New (a non null pointer is always returned):

Code: Select all

Dim As Integer n = 128*1024*1024

Do
  Dim As Byte Ptr p = New Byte[n]
  Print p
  If p = 0 Then Exit Do
Loop

Print "heap overflow"
Sleep
29163552
163446816
297730080
432013344
566296608
700579872
834863136
969146400
1103429664
1237712928
1371996192
1506279456
1640562720
1774845984

Aborting due to runtime error 12 ("segmentation violation" signal) in D:\Users\T
0003830\Documents\Mes Outils Personnels\FBIde0.4.6r4_fbc1.06.0\FBIDETEMP.bas::()
Why?

In order to test memory allocations for objects with constructor, a workaround could be:

Code: Select all

Type UDT
  Dim As Byte b
End Type

Dim As Integer n = 128*1024*1024

Do
  Dim As UDT Ptr p = Allocate(n*Sizeof(UDT))
  Print p
  If p = 0 Then Exit Do
  p = New(p) UDT[n]
Loop

Print "heap overflow"
Sleep
30933024
165216288
299499552
433782816
568066080
702349344
836632608
970915872
1105199136
1239482400
1373765664
1508048928
1642332192
1776615456
0
heap overflow
Last edited by fxm on Apr 12, 2016 11:05, edited 4 times in total.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Check for heap space max vs. used?

Post by fxm »

rolliebollocks wrote:But I'm not sure how fxm arrived at the conclusion that I was exhausting the heap space so I need some way to test that theory.
By looking at the task manager.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Re: Check for heap space max vs. used?

Post by rolliebollocks »

Does this explain why redundant calls to the same function cause a heap overflow regardless of whether the string is large enough to overflow the heap?
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Re: Check for heap space max vs. used?

Post by rolliebollocks »

I think I understand what is happening here. You're right. It's exhausting the heap.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Check for heap space max vs. used?

Post by fxm »

fxm wrote:@dkl,

If the requested memory could not be allocated, (C)Allocate returns a null pointer:
.....
But it is not the case for New (a non null pointer is always returned):
.....
In order to test memory allocations for objects with constructor, a workaround could be:

Code: Select all

Type UDT
  Dim As Byte b
End Type

Dim As Integer n = 128*1024*1024

Do
  Dim As UDT Ptr p = Allocate(n*Sizeof(UDT))
  Print p
  If p = 0 Then Exit Do
  p = New(p) UDT[n]
Loop

Print "heap overflow"
Sleep
30933024
165216288
299499552
433782816
568066080
702349344
836632608
970915872
1105199136
1239482400
1373765664
1508048928
1642332192
1776615456
0
heap overflow
For memory allocations of UDT objects, I defined in the UDT the two operators New[] / Delete[] and the default constructor as following:

Code: Select all

Type UDT
  Dim As Byte b
  Declare Constructor ()
  Declare Operator New[] (ByVal size As UInteger) As Any Ptr
  Declare Operator Delete[] (ByVal buffer As Any Ptr)
End Type

Operator UDT.New[] (ByVal size As UInteger) As Any Ptr
  Dim As Any Ptr p = Allocate(size)
  If p = 0 Then Print "null pointer in operator New[]"
  Return p
End Operator

Operator UDT.Delete[] (ByVal buffer As Any Ptr)
  Deallocate(buffer)
End Operator

Constructor UDT ()
  If @This = 0 Then Print "null pointer in constructor"
End Constructor


Dim As Integer n = 128*1024*1024

Do
  Dim As UDT Ptr p = New UDT[n]
  Print p
  If p = 0 Then Exit Do
Loop

Print "heap overflow"
Sleep
30474272
164757536
299040800
433324064
567607328
701890592
836173856
970457120
1104740384
1239023648
1373306912
1507590176
1641873440
1776156704
null pointer in operator New[]

Aborting due to runtime error 12 ("segmentation violation" signal) in D:\Users\T
0003830\Documents\Mes Outils Personnels\FBIde0.4.6r4_fbc1.06.0\FBIDETEMP.bas::()
A null pointer is well detected in the operator New[], but not in the constructor.
It seems that the program hangs in the internal construction, because by modifying the member field as 'Dim As Byte b = Any', a null pointer is well detected in the user constructor.

dkl,
Is it possible to include a null pointer test in the internal construction of object(s)?
(the coding for the test case corresponding to null pointer remaining to be defined)
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Check for heap space max vs. used?

Post by fxm »

If the requested memory could not be allocated, a String assignment returns a null descriptor (null address of string's character data):

Code: Select all

Dim As Integer n = 128*1024*1024
Dim As String s()

Do
  Redim Preserve s(Ubound(s)+1)
  s(Ubound(s)) = String(n, 0)
  Print Strptr(s(Ubound(s)))
  If Strptr(s(Ubound(s))) = 0 Then Exit Do
Loop

Print "heap overflow"

Sleep
31129632
182190112
333250592
484311072
635371552
786432032
937492512
1088552992
1239613472
1390673952
1541734432
1692794912
0
heap overflow
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Check for heap space max vs. used?

Post by fxm »

If the requested memory could not be allocated, a resizing of dynamic array does not return a blank descriptor (not null address of first element, ...):

Code: Select all

Type UDT
  Dim As Byte b(0 To 128*1024*1024-1)
End Type

Dim As UDT u()

Do
  Redim u(Ubound(u)+1)
  Print @u(Ubound(u))
  If @u(Ubound(u)) = 0 Then Exit Do
Loop

Print "heap overflow"

Sleep
30670880
164888608
299106336
433324064
567541792
701759520
835977248
970194976
1104412704
1238630432
1372848160
1507065888
1641283616
1775501344

Aborting due to runtime error 4 (out of memory) at line 8 of D:\Users\T0003830\D
ocuments\Mes Outils Personnels\FBIde0.4.6r4_fbc1.06.0\FBIDETEMP.bas::()
StringEpsilon
Posts: 42
Joined: Apr 09, 2015 20:49

Re: Check for heap space max vs. used?

Post by StringEpsilon »

If you can run your code on linux, I HIGHLY recommend using valgrind for any memory related debugging.

It does not explicitly state that you ran out of heap-space, but it shows you where in the code (compile with -g) you made an error and what kind of error it was. It also gives you a stacktrace along the way.

Last but not least, it tells you how many bytes you allocated in total and how many bytes where lost (not properly de-allocated).

Here is the output from one of FXMs testcodes:

Code: Select all

==7540== Invalid write of size 8
==7540==    at 0x4C3117F: memset (in /usr/lib/valgrind/vgpreload_memcheck-amd64-linux.so)
==7540==    by 0x40192C: main (test2.bas:4)
==7540==  Address 0x0 is not stack'd, malloc'd or (recently) free'd
==7540== 

Aborting due to runtime error 12 ("segmentation violation" signal) in test2.bas::()

==7540== 
==7540== HEAP SUMMARY:
==7540==     in use at exit: 11,274,302,533 bytes in 100 blocks
==7540==   total heap usage: 131 allocs, 31 frees, 11,274,316,510 bytes allocated
==7540== 
==7540== LEAK SUMMARY:
==7540==    definitely lost: 8,992,587,776 bytes in 67 blocks
==7540==    indirectly lost: 0 bytes in 0 blocks
==7540==      possibly lost: 2,147,483,648 bytes in 16 blocks
==7540==    still reachable: 134,231,109 bytes in 17 blocks
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Re: Check for heap space max vs. used?

Post by rolliebollocks »

Thanks for the tip. Looks like a useful tool.

I found a workaround which should work. Instead of returning a string, it writes directly to a file, discarding the strings as soon as they're generated. That should preserve the memory space, hopefully. I'm running tests on it now.
Post Reply