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 

Incorrect Warning Messages 133

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



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

PostPosted: Tue Jun 07, 2016 1:21 pm    Post subject: Incorrect Warning Messages 133 Reply with quote

Compiling my source I get incorrect warning messages. The related lines are marked below with '>>>'.

Code:

!  WARNING - 133: This statement will never be executed :


    SUBROUTINE ErrorHandling2 (cTexta)
      USE    GlobalData
      CHARACTER*(*)  cTexta
      SELECT CASE (iUserErrOut)
         CASE (0)
>>>         RETURN
         CASE (1)
            IF (iBgoMain .NE. 10) THEN
               CALL PopMessage ('BgoErrorMsg', ' *** CodeMeter Error *** ', TRIM(cTexta))
            ENDIF
            RETURN
>>>      CASE (2)
      END SELECT
      RETURN
    END SUBROUTINE ErrorHandling2


    DO I= 1, LI_Points
       IF (Points(I)%ControlType .EQ. ' ' .OR. CheckForControl(I) .EQ. 1) CYCLE
       iav_Check   = 1
       iav_Vectors = 1
       EXIT
>>> ENDDO


    IF (LiPhotos .GT. 0) THEN
       IF (LastAddress .LE. 0) THEN
          DO I= 1, LiAdjustPoints
             IF (indAdjPoints(I) .LT. 0) CYCLE
             indAdjPoints(I) = 1
             LastAddress = 3
             EXIT
>>>       ENDDO
       ENDIF
      :
      :
     
   
   100 IFGKB = (NRBG-1)*(iBlockShare-1)
       KBC   = IFGKB
       DO I= 1, IFGKB
          LSK = iFirstColumnsInSB(I+1) -1
          IF (LSK .LT. MPRG)   CYCLE
          KBC = I
          GOTO  130
>>>    ENDDO


        DO J= 1, LiSmallBlocks
           IF (iFirstColumnsInSB(J+1)-1 .LT. MINJ) CYCLE
           NRSANF = J
           EXIT
>>>     ENDDO
Back to top
View user's profile Send private message Visit poster's website
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7912
Location: Salford, UK

PostPosted: Wed Jun 08, 2016 6:44 am    Post subject: Reply with quote

I have logged this as needing fixing. What is in GlobalData?
Back to top
View user's profile Send private message AIM Address
EKruck



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

PostPosted: Wed Jun 08, 2016 9:52 am    Post subject: Reply with quote

Code:
!$ GlobalData
!-----------------------------------------------------------------------------------------------------------------------------------
    MODULE GlobalData       ! Global data modul for Bingo windows tools

!   KR BG REV. 2016-JAN-18                  COPYRIGHT:  E.KRUCK, AALEN

    IMPLICIT NONE
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    INTEGER       IXRESOL, IYRESOL                     ! Screen resolution in x and y
    INTEGER       iCurrWinPosX,  iCurrWinPosY          ! Current window position on screen (also start position)
    INTEGER       iMainWinSizeX, iMainWinSizeY         ! Current size main application window
    INTEGER       iDrawWinSizeX, iDrawWinSizeY         ! Current size of graphics window incl. settings around graphics
    INTEGER       iDrawAreaX, iDrawAreaY               ! Size of graphics area inside graphics window
    CHARACTER     cGaphicFileName*120                  ! File name for output of current screen graphics
    INTEGER       iWindowHandle                        ! Handle of current window (main or drawing window)
    INTEGER       iGraphicHandle                       ! Handle of graphica area
    INTEGER       MA, irb_GIF, irb_PNG
   
    INTEGER       LTX_CURDIR, I4ERR
    INTEGER       myProductCode, myFeatureCode
    INTEGER*2     I2ERR, I2DUMMY
    CHARACTER     cExePath*128
    CHARACTER     cOperator*64
    CHARACTER     TaskName*9, CLASSID*8
    CHARACTER     CURDIR*128, REPLYSTRING*255
    CHARACTER     SHOWDIR*32
    LOGICAL       StopBatch

    INTEGER       iBgoFont;   DATA iBgoFont   /0/      ! Font handle. If zero, font not yet created.
    REAL*8        dFontScale; DATA dFontScale /1.0D0/  ! Scale for iBgoFont
    INTEGER       iBgoMain;   DATA iBgoMain   /0/      ! Set >1 for batch programs

    CHARACTER*32  SHORT_DIR_NAME
    EXTERNAL      SHORT_DIR_NAME

    END MODULE GlobalData
!-----------------------------------------------------------------------------------------------------------------------------------
Back to top
View user's profile Send private message Visit poster's website
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7912
Location: Salford, UK

PostPosted: Wed Jun 08, 2016 10:05 am    Post subject: Reply with quote

I am still having problems getting this to compile.
I am now missing a TYPE for Points(I).
Back to top
View user's profile Send private message AIM Address
EKruck



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

PostPosted: Wed Jun 08, 2016 10:22 am    Post subject: Reply with quote

Hi Paul,

I could mail the complete routines to your personnal email account.

Erwi
Back to top
View user's profile Send private message Visit poster's website
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7912
Location: Salford, UK

PostPosted: Wed Jun 08, 2016 10:51 am    Post subject: Reply with quote

Thanks but I need a short sample and I may be able to do something by commenting out some lines.
Back to top
View user's profile Send private message AIM Address
JohnCampbell



Joined: 16 Feb 2006
Posts: 2551
Location: Sydney

PostPosted: Wed Jun 08, 2016 11:12 am    Post subject: Reply with quote

Paul,
The following adaptation shows different warnings with or without /64.
I used Release Win32 or Release x64.
Code:
!$ GlobalData
 !-----------------------------------------------------------------------------------------------------------------------------------
     MODULE GlobalData       ! Global data modul for Bingo windows tools

 !   KR BG REV. 2016-JAN-18                  COPYRIGHT:  E.KRUCK, AALEN

     IMPLICIT NONE
 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

     INTEGER       IXRESOL, IYRESOL                     ! Screen resolution in x and y
     INTEGER       iCurrWinPosX,  iCurrWinPosY          ! Current window position on screen (also start position)
     INTEGER       iMainWinSizeX, iMainWinSizeY         ! Current size main application window
     INTEGER       iDrawWinSizeX, iDrawWinSizeY         ! Current size of graphics window incl. settings around graphics
     INTEGER       iDrawAreaX, iDrawAreaY               ! Size of graphics area inside graphics window
     CHARACTER     cGaphicFileName*120                  ! File name for output of current screen graphics
     INTEGER       iWindowHandle                        ! Handle of current window (main or drawing window)
     INTEGER       iGraphicHandle                       ! Handle of graphica area
     INTEGER       MA, irb_GIF, irb_PNG
     
     INTEGER       LTX_CURDIR, I4ERR
     INTEGER       myProductCode, myFeatureCode
     INTEGER*2     I2ERR, I2DUMMY
     CHARACTER     cExePath*128
     CHARACTER     cOperator*64
     CHARACTER     TaskName*9, CLASSID*8
     CHARACTER     CURDIR*128, REPLYSTRING*255
     CHARACTER     SHOWDIR*32
     LOGICAL       StopBatch

     INTEGER       iBgoFont;   DATA iBgoFont   /0/      ! Font handle. If zero, font not yet created.
     REAL*8        dFontScale; DATA dFontScale /1.0D0/  ! Scale for iBgoFont
     INTEGER       iBgoMain;   DATA iBgoMain   /0/      ! Set >1 for batch programs

     CHARACTER*32  SHORT_DIR_NAME
     EXTERNAL      SHORT_DIR_NAME

     END MODULE GlobalData

     module other_data
!
       TYPE PPP
          CHARACTER ControlType
       END TYPE PPP
       TYPE (ppp) POINTS(11)
       INTEGER*4  CheckForControl(11)
!
       integer*4 LI_POINTS, IAV_CHECK, IAV_VECTORS
       INTEGER*4 LiPhotos,LastAddress, LiAdjustPoints
       INTEGER*4 indAdjPoints(22)
!   
       INTEGER*4 IFGKB, NRBG, iBlockShare, KBC, LSK,MPRG
       INTEGER*4 iFirstColumnsInSB(33)

       INTEGER*4 LiSmallBlocks, MINJ, NRSANF
     end module other_data
 !-----------------------------------------------------------------------------------------------------------------------------------


    SUBROUTINE ErrorHandling2 (cTexta,iUserErrOut)
       USE    GlobalData
       CHARACTER*(*)  cTexta
       INTEGER*4      iUserErrOut
       SELECT CASE (iUserErrOut)
          CASE (0)
! >>>
             RETURN
          CASE (1)
             IF (iBgoMain .NE. 10) THEN
                CALL PopMessage ('BgoErrorMsg', ' *** CodeMeter Error *** ', TRIM(cTexta))
             ENDIF
             RETURN
! >>>
          CASE (2)
       END SELECT
       RETURN
     END SUBROUTINE ErrorHandling2
Back to top
View user's profile Send private message
JohnCampbell



Joined: 16 Feb 2006
Posts: 2551
Location: Sydney

PostPosted: Wed Jun 08, 2016 11:14 am    Post subject: Reply with quote

extra code
Code:
    SUBROUTINE other_routine
       USE    GlobalData
       USE    Other_Data
!
       integer*4 i, j
!
!  Initialise variables
       CheckForControl = 1
       LI_Points       = 11
       LiPhotos        = 3
       LastAddress     = 4
       LiAdjustPoints  = 22
       indAdjPoints    = 5
       NRBG            = 7
       iBlockShare     = 2
       MPRG            = 1
       LiSmallBlocks   = 3
       iFirstColumnsInSB = 0
       MINJ            = 22
!
     DO I= 1, LI_Points
        IF (Points(I)%ControlType .EQ. ' ' .OR. CheckForControl(I) .EQ. 1) CYCLE
        iav_Check   = 1
        iav_Vectors = 1
        EXIT
! >>>
     ENDDO


     IF (LiPhotos .GT. 0) THEN
        IF (LastAddress .LE. 0) THEN
           DO I= 1, LiAdjustPoints
              IF (indAdjPoints(I) .LT. 0) CYCLE
              indAdjPoints(I) = 1
              LastAddress = 3
              EXIT
! >>>
           ENDDO
        ENDIF
      ENDIF
!       :
!       :
       
     
    100 IFGKB = (NRBG-1)*(iBlockShare-1)
        KBC   = IFGKB
        DO I= 1, IFGKB
           LSK = iFirstColumnsInSB(I+1) -1
           IF (LSK .LT. MPRG)   CYCLE
           KBC = I
           GOTO  130
! >>>
        ENDDO

    130 CONTINUE
   
         DO J= 1, LiSmallBlocks
            IF (iFirstColumnsInSB(J+1)-1 .LT. MINJ) CYCLE
            NRSANF = J
            EXIT
! >>>
         ENDDO

      END SUBROUTINE other_routine


The /64 response is:
Code:
[FTN95/Win32 Ver. 8.00.0 Copyright (c) Silverfrost Ltd 1993-2016]

    PROCESSING MODULE  [<GLOBALDATA> FTN95/Win32 v8.00.0]
    NO ERRORS  [<GLOBALDATA> FTN95/Win32 v8.00.0]
    PROCESSING MODULE  [<OTHER_DATA> FTN95/Win32 v8.00.0]
    NO ERRORS  [<OTHER_DATA> FTN95/Win32 v8.00.0]
0066)              RETURN
WARNING - 133: This statement will never be executed
0071)              RETURN
WARNING - 133: This statement will never be executed
    NO ERRORS, 2 WARNINGS  [<ERRORHANDLING2> FTN95/Win32 v8.00.0]
0123)     100 IFGKB = (NRBG-1)*(iBlockShare-1)
WARNING - 21: Label 100 is declared, but not used
0105)      ENDDO
WARNING - 133: This statement will never be executed
0116)            ENDDO
WARNING - 133: This statement will never be executed
0131)         ENDDO
WARNING - 133: This statement will never be executed
0140)          ENDDO
WARNING - 133: This statement will never be executed
    NO ERRORS, 5 WARNINGS  [<OTHER_ROUTINE> FTN95/Win32 v8.00.0]
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7912
Location: Salford, UK

PostPosted: Fri Jan 20, 2017 11:00 am    Post subject: Reply with quote

My test sample now works correctly for 64 bit compilation so hopefully this issue is now fixed for the next release.
Back to top
View user's profile Send private message AIM Address
EKruck



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

PostPosted: Sat Feb 25, 2017 11:39 am    Post subject: Reply with quote

Now I have two more of those warnings compared to the prior release.
Back to top
View user's profile Send private message Visit poster's website
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7912
Location: Salford, UK

PostPosted: Sat Feb 25, 2017 8:40 pm    Post subject: Reply with quote

Is it possible to demonstrate these in a short program?
Back to top
View user's profile Send private message AIM Address
EKruck



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

PostPosted: Mon Feb 27, 2017 6:48 pm    Post subject: Reply with quote

It happens only when I compile with /debug.
Does this help?
Back to top
View user's profile Send private message Visit poster's website
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7912
Location: Salford, UK

PostPosted: Tue Feb 28, 2017 11:00 am    Post subject: Reply with quote

I have made a note that this needs to be revisited.
Back to top
View user's profile Send private message AIM Address
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7912
Location: Salford, UK

PostPosted: Thu Mar 23, 2017 12:10 pm    Post subject: Reply with quote

This has now been fixed for the next release of FTN95.
Back to top
View user's profile Send private message AIM Address
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> 64-bit 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