forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

EQUIVALENCE Problem

 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> General
View previous topic :: View next topic  
Author Message
EKruck



Joined: 09 Jan 2010
Posts: 224
Location: Aalen, Germany

PostPosted: Wed Sep 28, 2016 10:46 am    Post subject: EQUIVALENCE Problem Reply with quote

In the first case i1Data and c1Data are not the same; in the second case well. What can I do?

Code:
          :
    iLength = 32
    CALL Calculate (iLength)
          :

    SUBROUTINE Calculate (iLength)
    INTEGER               iLength
    INTEGER*1            i1Data(iLength)
    CHARACTER*(iLength)  c1Data
    EQUIVALENCE         (c1Data, i1Data(1))
          :

!----------------------------------------------
       
        :
    CALL Calculate ()
          :

    SUBROUTINE Calculate ()
    INTEGER, PARAMETER :: iLength = 32
    INTEGER*1            i1Data(iLength)
    CHARACTER*(iLength)  c1Data
    EQUIVALENCE         (c1Data, i1Data(1))
          :
Back to top
View user's profile Send private message Visit poster's website
wahorger



Joined: 13 Oct 2014
Posts: 1217
Location: Morrison, CO, USA

PostPosted: Wed Sep 28, 2016 8:41 pm    Post subject: Reply with quote

Can you be a little more specific; what do you mean by "not the same"?

If you look at LOC(i1Data(1)) and LOC(c1Data), are the results the same? If so, then the beginning address of the two items is the same physical memory location!
Back to top
View user's profile Send private message Visit poster's website
EKruck



Joined: 09 Jan 2010
Posts: 224
Location: Aalen, Germany

PostPosted: Thu Sep 29, 2016 7:12 am    Post subject: Reply with quote

You are right! I was expecting that. Run the attached program and you see the printed three groups should be but are not the same.
IF you activate the lines with !** the printed result is o.k.
Or alternatively:
Activate the lines with !++ instead of their neighbors, then the printed result is as well the same.
Code:
!-----------------------------------------------------------------------
    PROGRAM cTest

    IMPLICIT NONE
    CHARACTER*400 inString
    INTEGER       iLength

    inString = ' 32  202020060103092042676F46756C6C20'

    READ (inString, '(BN,I5)') iLength
   
    CALL Calculate (iLength, inString)
!++ CALL Calculate (inString)

    END PROGRAM cTest
!-----------------------------------------------------------------------

    SUBROUTINE Calculate (iLength, inString)
!++ SUBROUTINE Calculate (inString)

    IMPLICIT NONE
    CHARACTER*400         inString

    INTEGER               iLength
!++ INTEGER, PARAMETER :: iLength = 32

    INTEGER               iOK, LTX, I
    CHARACTER*(iLength)   cBuffer

    INTEGER*1           i1Data(iLength)
    CHARACTER*(iLength) c1Data
    EQUIVALENCE        (c1Data, i1Data(1))

    INTEGER, EXTERNAL :: CallTest

    READ (inString, '(BN,I5,A)')  iLength, cBuffer
!++ READ (inString, '(BN,5X,A)')  cBuffer

    READ (cBuffer,  '(BN,160Z2)') i1Data   ! Read string to crypt

!** DO I= 1, iLength
!**    c1Data(I:I) = CHAR (i1Data(I))
!** ENDDO

    LTX    = iLength / 2
    WRITE  (*, *) ' '
    WRITE  (*, '(''String lenghth  > '', I12)')    iLength
    WRITE  (*, '(''Input  in HEX   > '',160Z2.2)') (i1Data(I), I=1,LTX)
    WRITE  (*, '(''Input  in Int*1 > '', 16i4)')   (i1Data(I), I=1,LTX)

    iOK  = CallTest (c1Data, iLength)

    WRITE  (*, *) ' '
    WRITE  (*, '(''Input  in HEX   > '',160Z2.2)') (i1Data(I), I=1,LTX)
    WRITE  (*, '(''Input  in Int*1 > '', 16i4)')   (i1Data(I), I=1,LTX)

    RETURN
    END SUBROUTINE Calculate
!-----------------------------------------------------------------------

    INTEGER FUNCTION CallTest (c1Data, iLength)

    IMPLICIT NONE
    INTEGER        iLength
    CHARACTER*32   c1Data
    INTEGER*1      i1Data(32)
    INTEGER        I, LTX

    DO I= 1, iLength
       i1Data(I) = ICHAR (c1Data(I:I))
    ENDDO

    LTX    = iLength / 2
    WRITE  (*, *) ' '
    WRITE  (*, '(''Parameter HEX   > '',160Z2.2)') (i1Data(I), I=1,LTX)
    WRITE  (*, '(''Parameter Int*1 > '', 16i4)')   (i1Data(I), I=1,LTX)

    CallTest = 0
    RETURN
    END FUNCTION CallTest
!-----------------------------------------------------------------------


Last edited by EKruck on Sat Oct 08, 2016 8:17 am; edited 1 time in total
Back to top
View user's profile Send private message Visit poster's website
wahorger



Joined: 13 Oct 2014
Posts: 1217
Location: Morrison, CO, USA

PostPosted: Thu Sep 29, 2016 3:00 pm    Post subject: Reply with quote

As coded and compiled using the DEBUG option, the results was that the conversion of ICHAR(c1Data(I:I)) in function CallTest fails. The Value of c1Data(I:I) is 128, which is the default value for an undefined (uninitialized) variable.

Looking back in Calculate, c1Data is never given an initial value; it is "undefined" at run time. Which means every character is set to 128 (80 hex) by default).

This is because the EQUIVALENCE statement is commented out.
Back to top
View user's profile Send private message Visit poster's website
EKruck



Joined: 09 Jan 2010
Posts: 224
Location: Aalen, Germany

PostPosted: Thu Sep 29, 2016 5:08 pm    Post subject: Reply with quote

Sorry, my mistake in a hurry.
Please activate the EQUIVALENCE statement and you will see: It's still not running correct.
Back to top
View user's profile Send private message Visit poster's website
wahorger



Joined: 13 Oct 2014
Posts: 1217
Location: Morrison, CO, USA

PostPosted: Thu Sep 29, 2016 7:47 pm    Post subject: Reply with quote

Yes, I see what you mean! Putting the LOC function in shows that the data locations are NOT the same, so the EQUIVALENCE is not actually working as one would have expected. It would appear you have found a bug, but I hesitate to say what kind of bug (error not given when it should, or bad code generation are two possibilities).

Also, the program (as written) would NOT run properly in /CHECKMATE mode at all because the uninitialized data is still a problem (due to the addresses not being properly equivalenced.

However, by declaring the array sizes as a static size and accommodating the read of the character buffer with an implied DO-loop for idata, the program works fine. See the code posting of the changes after this next section.

Code:
Non-working version:
!-----------------------------------------------------------------------
    PROGRAM cTest

    IMPLICIT NONE
    CHARACTER*400 inString
    INTEGER       iLength

    inString = ' 32  202020060103092042676F46756C6C20'

    READ (inString, '(BN,I5)') iLength
   
    CALL Calculate (iLength, inString)
!++ CALL Calculate (inString)

    END PROGRAM cTest
!-----------------------------------------------------------------------

    SUBROUTINE Calculate (iLength, inString)
!++ SUBROUTINE Calculate (inString)

    IMPLICIT NONE
    CHARACTER*400         inString

    INTEGER               iLength
!++ INTEGER, PARAMETER :: iLength = 32

    INTEGER               iOK, LTX, I
    CHARACTER*(iLength)   cBuffer

    INTEGER*1           i1Data(iLength)
    CHARACTER*(iLength) c1Data
   EQUIVALENCE        (c1Data, i1Data)

    INTEGER, EXTERNAL :: CallTest

   print *,"Location of character data =",loc(c1data)
    print *,"Location of integer data   =",loc(i1Data)
   
    READ (inString, '(BN,I5,A)')  iLength, cBuffer
!++ READ (inString, '(BN,5X,A)')  cBuffer
    READ (cBuffer,  '(BN,160Z2)') i1Data   ! Read string to crypt

!** DO I= 1, iLength
!**    c1Data(I:I) = CHAR (i1Data(I))
!** ENDDO
    LTX    = iLength / 2
    WRITE  (*, *) ' '
    WRITE  (*, '(''String lenghth  > '', I12)')    iLength
    WRITE  (*, '(''Input  in HEX   > '',160Z2.2)') (i1Data(I), I=1,LTX)
    WRITE  (*, '(''Input  in Int*1 > '', 16i4)')   (i1Data(I), I=1,LTX)

    iOK  = CallTest (c1Data, iLength)

    WRITE  (*, *) ' '
    WRITE  (*, '(''Input  in HEX   > '',160Z2.2)') (i1Data(I), I=1,LTX)
    WRITE  (*, '(''Input  in Int*1 > '', 16i4)')   (i1Data(I), I=1,LTX)

    RETURN
    END SUBROUTINE Calculate
!-----------------------------------------------------------------------

    INTEGER FUNCTION CallTest (c1Data, iLength)

    IMPLICIT NONE
    INTEGER        iLength
    CHARACTER*32   c1Data
    INTEGER*1      i1Data(32)
    INTEGER        I, LTX
   print *,"Location of input data=",loc(c1data)   
    DO I= 1, iLength
       write(*,*)"At Index=",i," Char date=",ichar(c1data(i:i))
       i1Data(I) = ICHAR (c1Data(I:I))
    ENDDO

    LTX    = iLength / 2
    WRITE  (*, *) ' '
    WRITE  (*, '(''Parameter HEX   > '',160Z2.2)') (i1Data(I), I=1,LTX)
    WRITE  (*, '(''Parameter Int*1 > '', 16i4)')   (i1Data(I), I=1,LTX)

    CallTest = 0
    RETURN
    END FUNCTION CallTest
!-----------------------------------------------------------------------


This works:

[code:1:a53db70234] CHARACTER*(400) cBuffer

INTEGER*1
Back to top
View user's profile Send private message Visit poster's website
wahorger



Joined: 13 Oct 2014
Posts: 1217
Location: Morrison, CO, USA

PostPosted: Thu Sep 29, 2016 7:48 pm    Post subject: Reply with quote

Oh bummer, exceeded the max message length. Here's the code section to change to make it work properly.

Code:
    CHARACTER*(400)   cBuffer

    INTEGER*1           i1Data(400)
    CHARACTER*(400) c1Data
   EQUIVALENCE        (c1Data, i1Data)

    INTEGER, EXTERNAL :: CallTest

   print *,"Location of character data =",loc(c1data)
    print *,"Location of integer data   =",loc(i1Data)
   
    READ (inString, '(BN,I5,A)')  iLength, cBuffer
!++ READ (inString, '(BN,5X,A)')  cBuffer
    READ (trim(cBuffer),  '(BN,160Z2)') (i1Data(i),i=1,ilength)   ! Read string to crypt
Back to top
View user's profile Send private message Visit poster's website
EKruck



Joined: 09 Jan 2010
Posts: 224
Location: Aalen, Germany

PostPosted: Thu Sep 29, 2016 8:12 pm    Post subject: Reply with quote

Paul,

it looks really like a bug - probably a new one. With earlier FTN95 version I do not remember those problens.
I have a lot of those parts in my software. The interesting point is, that comilation with /64 provides different results. Parts which are working in the 32-bit version fail with /64 and vice versa.
I decided to remove the EQUIVALENCE statements and copy between INTEGER*1 and character variables using CHAR and ICHAR.

Erwin
Back to top
View user's profile Send private message Visit poster's website
wahorger



Joined: 13 Oct 2014
Posts: 1217
Location: Morrison, CO, USA

PostPosted: Thu Sep 29, 2016 9:18 pm    Post subject: Reply with quote

There's probably some reason why you cannot dynamically allocate an array and then equivalence it to another dynamic array. It really doesn't make sense because the compiler cannot determine intent when the allocation is at run-time.

While it might work, I think it is odd to try. At least in "C" or "C++", you could allocate an array as character and then type cast the pointer to an integer. You then have the same effect as an "EQUIVALENCE" but with dynamic arrays.

A problem/solution better left to Paul!
Back to top
View user's profile Send private message Visit poster's website
John-Silver



Joined: 30 Jul 2013
Posts: 1520
Location: Aerospace Valley

PostPosted: Fri Sep 30, 2016 11:54 am    Post subject: Reply with quote

Quote:
EQUIVALENCE (c1Data, i1Data(1))


I'm having trouble following this !

How can a character variable (c1Data) of variable length 'istring' be EQUIValenced to an Integer variable (i1Data(1) ???
Back to top
View user's profile Send private message
EKruck



Joined: 09 Jan 2010
Posts: 224
Location: Aalen, Germany

PostPosted: Fri Sep 30, 2016 4:02 pm    Post subject: Reply with quote

John,
please note that it is integer*1, i.e. each character is one int*1.
The length of both is identical, but this is not required.
I'm using this since years with success.
Erwin
Back to top
View user's profile Send private message Visit poster's website
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> General All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group