Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
29390 Discussions

Passing Pointer-to-list from CVF 6.6c to VB6

Zernow__Richard
New Contributor I
1,217 Views
My Fortran DLL creates a linked list. Each item is a UDT of 9 reals and a pointer to next (for a total of 40 Bytes). From within the DLL I can traverse the list and have confirmed all of my data is intact.

The VB6 application includes the API declarations for CopyMemoryRead, GetProcessHeap, and HeapFree. The VB Pointer variable is LONG.

The VB routine ReadDataToStructure (called from ReadLinkedListDataAndFreeMemory) uses CopyMemoryRead to transfer 40 bytes to a VB UDT that is defined exactly the same as in the DLL.

In routine ReadLinkedListDataAndFreeMemory there is a block of code to transfer the data to an array and to free memory. Note CCOutList is the UDT.

hHeap = GetProcessHeap()
Do While pLocal <> 0
ReDim Preserve (blah blah blah)
RedDataToStructure pLocal, CCOutList
Copy CCOutList to my array
HeapFree hHeap, 0, pLocal
pLocal = CCOutList.Next
Loop

When I run this from the CVF IDE I get stopped at a user defined breakpoint. When I click OK the following error message is displayed in the CVF Output Window:
Invalid Address specified to RtlFreeHeap( 00140000, 0012DC80 )

It appears to be related to the HeapFree command in the VB. But my internet research has hinted at an OS library problem, but I cannot nail it down.

There appears to be an issue passing the pointer from the DLL to the VB. This is one of several variables that I am passing back and forth. Also, this is an established code. Most of the variables are UDTs, Strings, arrays, etc., that have been working just fine. This new effort creates data sets, the number of which is not known before hand. My intent was to create a linked-list of the data and simply hand back the pointer to the head of the list, then post-process the list in the VB.

Any help would be appreciated.

Richard

0 Kudos
4 Replies
g_f_thomas
Beginner
1,217 Views

Interesting.This would appear to be based on

http://www.codeproject.com/vbscript/how_to_do_pointers_in_visual_basic.asp?df=100&forumid=1232&exp=0&fr=26&select=73614#xx73614xx

where the UDT uses fixed length strings.

Can you display the code in which CVF requests data from VB6?

Gerry

0 Kudos
Zernow__Richard
New Contributor I
1,217 Views
Gerry,

Thanks for replying.

This is actually a case where the list is generated within the CVF and passed out to the VB for post-processing.

At the top of the subroutine where the data is generated is the following code that simply clears any pre-existing data that may be left in the list from before.:

ClearList: do
if (.not. associated (HFCC_Out_Head)) then !Check if there is still a list from previous run)
exit
else
HFCC_Out_Ptr => HFCC_Out_Head !Point to head of list
HFCC_Out_Head => HFCC_Out_Ptr%Next !Point head to next item in list
deallocate (HFCC_Out_Ptr) !Deallocate the node
nullify (HFCC_Out_Ptr)
endif
enddo ClearList

Further down in the subroutine after the data is generated comes the code that fills / builds the list: The first block (BLOCK 1) of code below fills the initial data. Below that is another block of code that is part of a do-loop where the data generation sequence occurs and the list is built completion (BLOCK 2).

My TYPE declaration and variable definitions are shown here:

Finally, the pointer HFCC_Out_Head is passed back to the VB. It's given the attribute !DEC$ATTRIBUTES REFERENCE :: HFCC_Out_Head

After you have a few minutes to chew on this, I have placed the VB code at the bottom of all this.

The problem occurs on the first call to HeapFree. This is all occuring from within the CVF IDE in debug mode. The program stops with a User Defined Break Point. There is also an error message regarding an error refering to an invalid memory location. The actual routine where the error occured was in my original post, rtl something-or-other.

Any light you can shed on this would be greatly appreciated.

Richard

!***** F O R T R A N S T U F F S T A R T S H E R E *************
!*************** Variable and TYPE declarations *******************
type (HFCC_OUT_TYPE), Pointer :: HFCC_Out_Head !Pointers to HFCC output data structure

Type HFCC_OUT_TYPE !Pointer data structure used to hold HFCC data
sequence
integer (kind=4) :: ParticleNum !Particle Counter
real :: RVxEng !X-coord of CC debris trajectory
real :: RVyEng !Y-coord of CC debris trajectory
real :: RVzEng !Z-coord of CC debris trajectory
real :: RVi !X-component of Vr
real :: RVj !Y-component of Vr
real :: RVk !Z-component of Vr
real :: RayVelEng !Magnitude of Vr
real :: RayMassEng !CC debris particle mass
type (HFCC_OUT_TYPE), Pointer :: Next !Pointer to next node
End Type HFCC_OUT_TYPE
!************** End of Variable and TYPE declarations *************

!************** BLOCK 1 Initial Data Placed into List **************
allocate (HFCC_Out_Ptr, STAT=iStat) !Allocate a pointer
HFCC_Out_Ptr%ParticleNum = 1
HFCC_Out_Ptr%RVxEng = RVxEng
HFCC_Out_Ptr%RVyEng = RVyEng
HFCC_Out_Ptr%RVzEng = RVzEng
HFCC_Out_Ptr%RVi = RVi(LoopCount)
HFCC_Out_Ptr%RVj = RVj(LoopCount)
HF CC_Out_Ptr%RVk = RVk(LoopCount)
HFCC_Out_Ptr%RayVelEng = RayVelEng
HFCC_Out_Ptr%RayMassEng = RayMassEng

PreOutput: If (.not. associated(HFCC_Out_Head)) then !No values currently in output list
HFCC_Out_Head => HFCC_Out_Ptr !Place at front of list
HFCC_Out_Tail => HFCC_Out_Head !Tail points to new value
nullify(HFCC_Out_Ptr%Next) !Nullify next pointer
else !Add at end of list
HFCC_Out_Tail%Next => HFCC_Out_Ptr !Add new value to end of list
HFCC_Out_Tail => HFCC_Out_Ptr !Point tail to new value
nullify (HFCC_Out_Tail%Next) !Nullify next pointer
endif PreOutput
!*************** End of BLOCK 1 Initial Data fill **********************

!*************** BLOCK 2 Data from loop calcs placed in list ************
allocate (HFCC_Out_Ptr, STAT=iStat) !Allocate a pointer
HFCC_Out_Ptr%ParticleNum = HFCC_Out_Tail%ParticleNum + 1
&n bsp; HFCC_Out_Ptr%RVxEng = RVxEng
HFCC_Out_Ptr%RVyEng = RVyEng
HFCC_Out_Ptr%RVzEng = RVzEng
HFCC_Out_Ptr%RVi = RVi(LoopCount)
HFCC_Out_Ptr%RVj = RVj(LoopCount)
HFCC_Out_Ptr%RVk = RVk(LoopCount)
HFCC_Out_Ptr%RayVelEng = RayVelEng
HFCC_Out_Ptr%RayMassEng = RayMassEng

MainOutput: If (.not. associated(HFCC_Out_Head)) then !No values currently in output list
HFCC_Out_Head => HFCC_Out_Ptr !Place at front of list
HFCC_Out_Tail => HFCC_Out_Head !Tail points to new value
nullify(HFCC_Out_Ptr%Next) !Nullify next pointer
else !Add at end of list
HFCC_Out_Tail%Next => HFCC_Out_Ptr !Add new value to end of list
HFCC_Out_Tail => HFCC_Out_Ptr !Point tail to new value
nullify (HFCC_Out_Tail%Next)  ; !Nullify next pointer
endif MainOutput
!*************** End of BLOCK 2
!***** F O R T R A N S T U F F E N D S H E R E *************

This first block of code is the interface declaration to my CVF routine (Actual variable names anonymized except for the pointer pHead)

The second block contains the declarations for the pointer routines, followed by the actual routines themselves. All of them are within the same module so there should be no scoping issues

'***** V I S U A L B A S I C S T U F F S T A R T S H E R E ****
Declare Sub XYZ_DLL Lib "XYZ.dll" Alias "_XYZDLL@72" (VAR1 As VAR1_TYPE, VAR2 As VAR2_TYPE, _
VAR3 As VAR3_TYPE, VAR4 As VAR4_TYPE, VAR5 As VAR5_TYPE, _
VAR6 As Integer, VAR7 As Integer, VAR8 As Single, _
VAR9 As Single, VAR10 As VAR10_TYPE, VAR11 As Integer, VAR12 As VAR12_TYPE, _
pHead As Long, _
ByVal VAR14 As String, ByVal VAR15 As String, ByVal VAR16 As String, _
VAR17 As VAR17_TYPE, VAR18 As VAR18_TYPE)
'-------------------------Module level declaration code begins here -----------------------------------------------------
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function GetProcessHeap Lib "kernel32" () As Long

Private Declare Function HeapAlloc Lib "kernel32" _
(ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long

Private Declare Function HeapFree Lib "kernel32" _
(ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Long) As Long

Private Declare Sub CopyMemoryPut Lib "kernel32" Alias "RtlMoveMemory " _
(ByVal Destination As Long, Source As Any, ByVal Length As Long)

Private Declare Sub CopyMemoryRead Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, ByVal Source As Long, ByVal Length As Long)

Private pHead As Long

Private OutCCData() As Single
Private OutCCDataLen As Integer

Private Type HFCC_OUT_TYPE 'Data structure used to hold HFCC data
ParticleNum As Long
RVxEng As Single
RVyEng As Single
RVzEng As Single
RVi As Single
RVj As Single
RVk As Single
RayVelEng As Single
RayMassEng As Single
PNext As Long
End Type

Private CCOutList As HFCC_OUT_TYPE
Private CCListOut As Long
'-------------------------Module level declaration code ends here ------

'----------------------- Extraction Code begins here -------------------- (NOTE: NListOut = 9 here)
Private Sub ReadLinkedListDataAndFreeMemory(NListOut As Long, CCOutList As HFCC_OUT_TYPE)

Dim pLocal As Long
Dim hHeap As Long

Dim ErrorCount As Integer 'Counts number of errors that occur.

On Error GoTo ErrorHandler ' Enable error-handling routine.

ErrorCount = 0

pLocal = pHead
OutCCDataLen = 0
Erase OutCCData

hHeap = GetProcessHeap()

Do While pLocal <> 0
OutCCDataLen = OutCCDataLen + 1
ReDim Preserve OutCCData(1 To NListOut, 1 To OutCCDataLen) As Single

ReadDataToStructure NListOut, pLocal, CCOutList

OutCCData(1, OutCCDataLen) = CCOutList.ParticleNum
OutCCData(2, OutCCDataLen) = CCOutList.RVxEng
OutCCData(3, OutCCDataLen) = CCOutList.RVyEng
OutCCData(4, OutCCDataLen) = CCOutList.RVzEng
OutCCData(5, OutCCDataLen) = CCOutList.RVi
OutCCData(6, OutCCDataLen) = CCOutList.RVj
OutCCData(7, OutCCDataLen) = CCOutList.RVk
OutCCData(8, OutCCDataLen) = CCOutList.RayVelEng
  ; OutCCData(9, OutCCDataLen) = CCOutList.RayMassEng

HeapFree hHeap, 0, pLocal

pLocal = CCOutList.PNext
Loop

On Error GoTo 0 ' Disable error-handling routine.

Exit Sub ' Exit to avoid handler.

ErrorHandler: ' Error-handling routine. See notes on error handler under mnuRun procedure
ErrorCount = ErrorCount + 1
If (ErrorCount >= 10) Then
MsgBoxReply = MsgBox("An unrecoverable error has occured in subroutine ReadLinkedListDataAndFreeMemory. This run will terminate!", _
vbCritical + vbOKOnly, "Unrecoverable Error")
Unload Me
Else
Resume ' Resume execution at same line that caused the error
End If

End Sub


Private Sub ReadDataToStructure(NListOut As Long, ByVal ptr As Long, struct As HFCC_OUT_TYPE)

Dim le As HFCC_OUT_TYPE

Dim ErrorCount As Integer 'Counts number of errors that occur.

On Error GoTo ErrorHandler ' Enable error-handling routine.

ErrorCount = 0

CopyMemoryRead le, ptr, (NListOut * 4& + 4&)

struct.ParticleNum = le.ParticleNum
struct.RVxEng = le.RVxEng
struct.RVyEng = le.RVyEng
struct.RVzEng = le.RVzEng
struct.RVi = le.RVi
struct.RVj = le.RVj
struct.RVk = le.RVk
struct.RayVelEng = le.RayVelEng
struct.RayMassEng = le.RayMassEng
struct.PNext = le.PNext

On Error GoTo 0 ' Disable error-handling routine.

Exit Sub ' Exit to avoid handler.

ErrorHandler: ' Error-handling routine. See notes on error handler under mnuRun procedure
ErrorCount = ErrorCount + 1
If (ErrorCount >= 10) Then
MsgBoxReply = MsgBox("An unrecoverable error has occured in subroutine ReadDataToStructure. This run will terminate!", _
vbCritical + vbOKOnly, "Unrecoverable Error")
Unload Me
Else
Resume ' Resume execution at same line that caused the error
End If

End Sub

0 Kudos
g_f_thomas
Beginner
1,217 Views

I don't see anything wrong with what you're doing but here's what I would do:

on the CVF side:

1. Link the dll to the MT RTL, I suspect you're using the single-threaded version;

2. Use the Memory Window in the IDE to check what's where;

3. Check that hHeap is not NULL before HeapFree, If it is try HeapCreate or Allocate;

4. Check the library both with static and dynamic linking using a CVF client with the same project settings and RTL in the case of the DLL. Exe's and DLL's have separate heaps.

on the VB6 side:

1. Use the Err object in your ErrorHandler to get further info: Err.Description, .Number, .GetLastDLLError, etc. and include them in your msgbox string;

2. I don't see where you called CVF's XYZ but I suspect its OK and is not the culprit.

I bet CVF 1 is the villain, but do let the forum know how things work out.

Gerry

0 Kudos
Zernow__Richard
New Contributor I
1,217 Views
Gerry,

Thanks. I'll try your suggestions this week end and post the results. BTW, I did, as part of trying to diagnose the problem, write to file the value of the pointer in VB prior to the HeapFree line. It appeared to have a valid address in it.

One other point that I neglected to state is that if I run this program from with the VB IDE it "seems" to run just fine. But, if I install this program on another computer, i.e the VB EXE and the CVF DLL it crashes. By install I mean actually package and install, not just copy the two files. And I am including the CVF RTLs during the install.

Thanks again.

Richard
0 Kudos
Reply