PROGRAM VPP
C
C     TO TEST DIRECT MEMORY OPERATIONS
C     OLYMPIC SOFTWARE  --  9/27/88
C
      EXTERNAL GBIOS,GETADR,MXFER,MXFER1
C
      INTEGER*4 IS1,IS2
      INTEGER*2 IOF1,IOF2,N,ICNT
      INTEGER*2 IDAT(10000)
      INTEGER*2 IAR(4)
C
      DATA IS2,IOF2,N /47104,0,16384/

C***    GET IDAT ADDRESS
      CALL GETADR(IDAT,IS1,IOF1)
        WRITE(*,19)IS1,IOF1
 19     FORMAT(' IDAT IS AT: ',I6,':',I6)
C
C***    CHANGE TO GRAPHICS MODE, MODE=6 (CGA GRAPHICS)
      IAR(1)=0
      IAR(2)=6
      CALL GBIOS(IAR)
C
C***    PLOT VERTICAL LINES
      IAR(1)=12
      IAR(2)=15
      DO 10 J=1,640,2
      DO 10 I=1,200,2
      IAR(3)=J-1
      IAR(4)=I-1
      CALL GBIOS(IAR)
 10   CONTINUE
C
C***    MXFER DATA FROM VIDEO TO IDAT
      CALL MXFER(IS2,IOF2,IS1,IOF1,N)
C
C***    MCLR VIDEO DATA
      CALL MCLR(IS2,IOF2,N)
C
      ICNT=18
      CALL STIMER(ICNT)
C
C***    MXFER1 DATA FROM IDAT TO VIDEO
      IOP=0
      CALL MXFER1(IOP,IDAT,IS2,IOF2,N)
C
      ICNT=18
      CALL STIMER(ICNT)
C
C***    MCLR IDAT DATA
      CALL MCLR(IS1,IOF1,N)
C
C***    MXFER1 DATA FROM VIDEO TO IDAT
      IOP=1
      CALL MXFER1(IOP,IDAT,IS2,IOF2,N)
C
C***    MCLR VIDEO DATA
      CALL MCLR(IS2,IOF2,N)
C
      ICNT=18
      CALL STIMER(ICNT)
C
C***    MXFER DATA FROM IDAT TO VIDEO
      CALL MXFER(IS1,IOF1,IS2,IOF2,N)
C
      ICNT=18
      CALL STIMER(ICNT)
C
C***    CHANGE TO TEXT MODE, MODE=3
      IAR(1)=0
      IAR(2)=3
      CALL GBIOS(IAR)
C
      STOP
      END
C
      SUBROUTINE STIMER(ICNT)
C
C     SHORT INTERVAL TIMER ROUTINE
C     PROGRAM ENDS AFTER ICNT COUNTS (TOTAL DELAY <1 HOUR)
C     INTERVAL : 1/18 SEC
C     MIDNIGHT CROSSING RESETS STIMER (STIMER RETURNS)
C     OLYMPIC SOFTWARE  --  9/26/88
C
      EXTERNAL TBIOS
      INTEGER*2 IAR(6),ICX,IDX,EC,ICNT
C
      IAR(1)=0
      CALL TBIOS(IAR)
      IDX=IAR(5)*256+IAR(6)
      IAR(1)=0
 100  CALL TBIOS(IAR)
      EC=IAR(5)*256+IAR(6)-IDX
      IF(EC.LT.0)EC=EC+4*16384
      IF(IAR(2).NE.0)GOTO 200
      IF(EC.LT.ICNT)GOTO 100
C
 200  RETURN
      END