Microsoft KB Archive/51607

From BetaArchive Wiki
< Microsoft KB Archive
Revision as of 16:57, 18 July 2020 by 3155ffGd (talk | contribs) (importing KB archive)
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)

Article ID: 51607

Article Last Modified on 12/1/2003



APPLIES TO

  • Microsoft FORTRAN Compiler 5.0
  • Microsoft FORTRAN Compiler 5.1
  • Microsoft FORTRAN Compiler 5.0
  • Microsoft FORTRAN Compiler 5.1



This article was previously published under Q51607

SUMMARY

The two code examples below demonstrate one method to simulate a pointer in FORTRAN. The first example is for the MS-DOS operating system and the second is for the OS/2 operating system.

MORE INFORMATION

The code example below demonstrates using a pointer in FORTRAN with MS-DOS. This program loads a far address into an INTEGER*4 variable and passes the variable to a subroutine.

The program uses an INTERFACE TO SUBROUTINE statement to "lie" to FORTRAN about the data being passed. The INTERFACE statement indicates that the program passes an INTEGER*4 variable by value. Actually, the subroutine, to which the program refers using the ALIAS attribute, expects a far address to an array. The INTEGER*4 variable contains that address. The subroutine can refer to any value in the segment by specifying the correct index for the array.

The SETPOINT2 subroutine changes the screen attribute byte to cause characters on the video display to blink.

Sample Code 1

C Compile options needed: None

      INTERFACE TO SUBROUTINE SETPOINT[ALIAS:'SETPOINT2'] (ABC)
        INTEGER*4   ABC  [VALUE]
      END

      SUBROUTINE SETPOINT2 (ABC)
         INTEGER*2   ABC(*), N

         DO 100, N = 1, 2000
         ABC(N) = IOR(ABC(N), #8000)
100      CONTINUE
      END

         PROGRAM GRAPHTEST
            INTEGER*4      PTR

            PTR = #0B8000000
            WRITE (*, '(Z9)') PTR
            CALL SETPOINT (PTR)
         END
                

The code example below demonstrates using a pointer in FORTRAN with OS/2. This program retrieves a selector to the video buffer by calling the VioGetPhysBuf() function. The application converts the selector to a far pointer by shifting it 16 positions to the left.

The program uses an INTERFACE TO SUBROUTINE statement to "lie" to FORTRAN about the value it passes to the subroutine. The INTERFACE statement indicates that the program passes an INTEGER*4 by value. Actually, the subroutine, to which the program refers with an ALIAS attribute, expects a far address to an array. The INTEGER*4 variable contains that address. The subroutine can refer to any value in the segment by specifying the correct index for the array.

The SETPOINT2 subroutine changes the screen attribute byte to cause characters on the video display to blink.

Sample Code 2

C Compile options needed: None

      INTERFACE TO FUNCTION VIOGETPHYSBUF (BUFFER, HANDLE)
          STRUCTURE /BUFFSTRC/ 
            INTEGER*4  ADDRESS
            INTEGER*4  LENGTH
            INTEGER*2  SELECTOR
          END STRUCTURE
          RECORD /BUFFSTRC/ BUFFER
          INTEGER*2    HANDLE   [VALUE]
          INTEGER*2    VIOGETPHYSBUF
      END

      INTERFACE TO SUBROUTINE SETPOINT[ALIAS:'SETPOINT2'] (ABC)
        INTEGER*4   ABC  [VALUE]
      END

      SUBROUTINE SETPOINT2 (ABC)
         INTEGER*2   ABC(*), N

         DO 100, N = 1, 2000
         ABC(N) = IOR(ABC(N), #8000)
100      CONTINUE

      END

      PROGRAM GRAPHTEST

         STRUCTURE /BUFFSTRC/ 
            INTEGER*4  ADDRESS
            INTEGER*4  LENGTH
            INTEGER*2  SELECTOR
         END STRUCTURE
         RECORD /BUFFSTRC/ BUFFER

         INTEGER*2      ERROR, VIOGETPHYSBUF
         INTEGER*4      PTR

         BUFFER.ADDRESS = #0B8000
         BUFFER.LENGTH  = 4000

         ERROR = VIOGETPHYSBUF (BUFFER, 0)

         PTR = ISHA(BUFFER.SELECTOR, 16)
         WRITE (*, '(Z10, I3)') PTR, ERROR
         CALL SETPOINT (PTR)
      END
                


Additional query words: nofps (sample1 doesn't compile) kbinf 5.00 5.10

Keywords: KB51607