      PROGRAM CALLM1
C Purpose: calls real mode TSR via interrupt
C Copyright (C) MicroWay, Inc. 1989

C The real mode Interrupt Service Routine (ISR) is 
C table-driven. The calling program invokes the
C various routines by passing an index into the
C table via the ax register.

      INTEGER INIT_TEST
      PARAMETER (INIT_TEST=0)
      INTEGER FIRST_TEST_MSG,LAST_TEST_MSG
      PARAMETER (FIRST_TEST_MSG=1,LAST_TEST_MSG=3)
      INTEGER SHARE_BUFFER
      PARAMETER (SHARE_BUFFER=LAST_TEST_MSG+1)

      INTEGER MSG_LEN
      PARAMETER (MSG_LEN=80)

      INCLUDE 'DOS.FH'

      INTEGER INTNUM, I

C The following holds the address of the real mode data buffer.
C It is declared an integer because FORTRAN has no pointer type
      INTEGER PDB
C The following function returns the address of a data object
      INTEGER GET_ADDR

C This program makes extensive use of Phar Lap's 
C DOS Extender Function Z'25', subfunction Z'11',
C Issue Real Mode Interrupt. See the appropriate
C section of the Phar Lap manual. The array defined
C below serves as the parameter block to be passed
C to that subfunction.
      INTEGER*2 PARM_BLOCK (9)

C The values below act as indexes into the PARM_BLOCK array
      INTEGER INTNUM_INDEX, DS_INDEX, ES_INDEX
      INTEGER FS_INDEX, GS_INDEX, AX_INDEX, DX_INDEX

      PARAMETER (INTNUM_INDEX=1,DS_INDEX=2,ES_INDEX=3)
      PARAMETER (FS_INDEX=4,GS_INDEX=5,AX_INDEX=6)
      PARAMETER (DX_INDEX=8)

C Real Mode Interrupt Number
      INTEGER RM_INTNUM
      PARAMETER (RM_INTNUM=Z'48')

      CHARACTER*(6) OUT_MSG
      CHARACTER*(MSG_LEN) IN_MSG

      DATA (PARM_BLOCK(I),I=1,9) /0/
      DATA OUT_MSG /'Hello '/

C This program uses CALL INT386() to issue the Int Z'21',
C function Z'25'. Any calls to real mode code must
C go through Phar Lap's DOS Extender, i.e., we can
C not issue a real mode interrupt directly via INT386.

      INTNUM = Z'21'
C Real mode interrupt number => cl
      BINREGS(9) = RM_INTNUM
C Get real mode interrupt vector => ax
      WINREGS(1) = Z'2503'
      CALL INT386 (INTNUM,INREGS(1),OUTREGS(1))

C If vector is zero, definitely an error. However, a non-zero
C value does not prove everything okay. We could make a more
C stringent test, but in this example it didn't seem worthwhile
      IF (OUTREGS(2).EQ.0) THEN
        WRITE (*,100) 'Real Mode Interrupt not installed'
        WRITE (*,100) CHAR (7)
  100 FORMAT (1X,A)
        STOP
      ENDIF

C Initialize ax with error value
      WOUTREGS(1) = -1

C Call the real mode routine for the first time. If all is
C okay, it will pass back the address of a real mode buffer.
C We can access that buffer from protected mode by using
C segment selector Z'34', which maps to the first megabyte
C of memory

      PARM_BLOCK (INTNUM_INDEX) = RM_INTNUM
      PARM_BLOCK (AX_INDEX) = INIT_TEST
C Move address of PARM_BLOCK => edx
      INREGS(4) = GET_ADDR (PARM_BLOCK(1))
      WINREGS(1) = Z'2511'
      CALL INT386 (INTNUM,INREGS(1),OUTREGS(1))
      
      IF (WOUTREGS(1).NE.0) THEN
        WRITE (*,100) 'Problem in Real Mode Interrupt'
        WRITE (*,100) CHAR (7)
      ELSE
        PDB = WOUTREGS(5)*16
        PDB = PDB + WOUTREGS(3)
        WRITE (*,105) 'Address of data buffer = ',PDB
        WRITE (*,110)
  105 FORMAT (1X,A,Z5)
  110 FORMAT (1X)
      ENDIF

C Call real mode routine to output the test messages
      DO 115 I = FIRST_TEST_MSG, LAST_TEST_MSG
        PARM_BLOCK (AX_INDEX) = I
        CALL INT386 (INTNUM,INREGS(1),OUTREGS(1))
  115 CONTINUE

C Move output message defined in the Fortran program
C into data buffer. Real mode routine will output the
C message and move a new message which was defined in
C the real mode program into the shared buffer. Note
C that the real mode routine expects a null-terminated
C string.
      OUT_MSG(6:6) = CHAR(0)
      CALL BLK_BM(OUT_MSG,Z'34',PDB,LEN(OUT_MSG))
      PARM_BLOCK (AX_INDEX) = SHARE_BUFFER
      CALL INT386 (INTNUM,INREGS(1),OUTREGS(1))

C Move new message from data buffer into character
C variable and display it, to prove the process.
      CALL BLK_MB(IN_MSG(1:1),Z'34',PDB,MSG_LEN)
      WRITE (*,100) IN_MSG
      WRITE (*,110)

      END

