      PROGRAM UNFL
C Purpose: to demonstrate the principles used in
C creating a user-written numeric exception handler.
C To compile for an 80287:
C       f77 unfl.f -n0
C To compile for an 80387:
C       f77 unfl.f -n2
C To compile for an mW1167:
C       f77 unfl.f -n4
 
C Copyright MicroWay, Inc. 1989
C All Rights Reserved

C The following symbolic constants refer to bit positions
C in the 80x87 and Weitek Control Register and in the
C 80x87 and Weitek Status Register that correspond to the
C exceptions recognized by the coprocessors. See the
C discussion on numeric exception handling in the
C appropriate chapter of the manual
C

C       IM      1               All NDPs.
C       DM      2               80x87 only
C       ZM      4               All NDPs.
C       OM      8               All NDPs.
C       UM      16              All NDPs.
C       PM      32              All NDPs.
C       UOM     64              Weitek only.
C       DCM     128             Weitek only.

      INTEGER IM,DM,ZM,OM,UM,PM,OUM,DCM
      PARAMETER(IM=1,DM=2,ZM=4,OM=8,UM=16,PM=32,OUM=64,DCM=128)

C The following symbolic constants refer to the type of
C numeric coprocessor present

      INTEGER NONE,MW1167,I80387,I80287
      PARAMETER (NONE=0,MW1167=1,I80387=2,I80287=3)

C returns type of coprocessor
      INTEGER NDPTYPE

      INTEGER YES,NO
      PARAMETER (YES=1,NO=0)

C enables exceptions in coprocessor
      INTEGER ENAB_EX
C error value returned by ENAB_EX
      INTEGER EVAL
      PARAMETER (EVAL=-1)

C set up exception handler
      INTEGER SET_EX_HDL
C Important!  The following subroutine is passed as a parameter
C to SET_EX_HDL. The name must be declared external or the
C compiler will not generate the correct code to pass it.
C forward reference
      EXTERNAL N_EX_HDL

C dump NDP state to memory
      INTEGER STNDPENV
C display NDP state after calling STNDPENV
      INTEGER DISPLAY_NDP

      REAL*8 D1, D2, D3, D4

C Template of memory area to store and load 80287
C coprocessor's environment and numeric registers
C First, the environment  registers:
C       Control Word    unsigned 2 byte integer
C       Status Word     unsigned 2 byte integer
C       Tag Word        unsigned 2 byte integer
C       padding         unsigned 2 byte integer
C       padding         unsigned 2 byte integer
C       padding         unsigned 2 byte integer
C       IP Offset       unsigned 4 byte integer
C       CS Selector     unsigned 2 byte integer
C       padding         unsigned 2 byte integer
C       Data Offset     unsigned 4 byte integer
C       Operand Selector unsigned 2 byte integer
C       padding         unsigned 2 byte integer
C Next, the numeric registers:
C       ten byte real   st0
C       ten byte real   st1
C       ten byte real   st2
C       ten byte real   st3
C       ten byte real   st4
C       ten byte real   st5
C       ten byte real   st6
C       ten byte real   st7
C
C end of 80287 template

C Template of memory area to store and load 80387
C coprocessor's environment and numeric registers
C First, the environment  registers:
C       Control Word    unsigned 2 byte integer
C       padding         unsigned 2 byte integer
C       Status Word     unsigned 2 byte integer
C       padding         unsigned 2 byte integer
C       Tag Word        unsigned 2 byte integer
C       padding         unsigned 2 byte integer
C       IP Offset       unsigned 4 byte integer
C       CS Selector     unsigned 2 byte integer
C       padding         unsigned 2 byte integer
C       Data Offset     unsigned 4 byte integer
C       Operand Selector unsigned 2 byte integer
C       padding         unsigned 2 byte integer
C Next, the numeric registers:
C       ten byte real   st0
C       ten byte real   st1
C       ten byte real   st2
C       ten byte real   st3
C       ten byte real   st4
C       ten byte real   st5
C       ten byte real   st6
C       ten byte real   st7
C
C end of 80387 template

C Template of memory area to store and load mW1167
C coprocessor's environment and numeric registers
C First, the environment  registers:
C       Control Word    unsigned 2 byte integer
C       Status Word     unsigned 2 byte integer
C Next, the numeric registers:
C       32 real*4
C           or
C       16 real*8       must begin in even-numbered register
C           or
C       some combination of real*4 and real*8
C
C end of mW1167 template

C The arrays declared below will overlay the memory area
C used to store (and load) the coprocessor's registers.
C Any routines which are to access this information must
C include these declarations.

C The following section is specific for the 80287 and
C 80387. To use it, just uncomment the code part and
C comment out code in sections specific to the mW1167
      INTEGER*4 BUFF (27)
      INTEGER*2 WBUFF(54)
      INTEGER*1 BBUFF(108)
      EQUIVALENCE (BUFF, WBUFF, BBUFF)
      COMMON BUFF
C end of 80287 and 80387 specific section

C The following section is specific for the mW1167
C To use it, just uncomment the code part and
C comment out code in sections specific to the
C 80387 and 80287
C In the following arrays, the genuine data items begin
C at subscript 1. Any subscript lower than that is padding
C so as to align all genuine data items on the same boundary
C      INTEGER*4        BUFF (-1:32)
C      INTEGER*2        WBUFF (-1:2)
C      REAL*4   R4BUFF (-1:32)
C      REAL*8   R8BUFF (0:16)
C      EQUIVALENCE (BUFF, WBUFF, R4BUFF, R8BUFF)
C end of mW1167 specific section

C type of coprocessor
      INTEGER*4 TYPE
      INTEGER*4 SAVE_CW, EMASK
      INTEGER*4 OKAY

      D2 = 2.0E-150
      D3 = 2.0E-151
      D4 = 2.0E-15

C Initialize the NDP. Masks all errors except invalid operations
      CALL INIT_NDP()

C get type of NDP
      TYPE = NDPTYPE()
      IF (TYPE .EQ. NONE) THEN
        WRITE (*,100) 'No NDP present. Exiting'
        WRITE (*,101)
        WRITE (*,101)
C beep
        WRITE (*,100) CHAR(7)
        STOP
      END IF

  100 FORMAT (1X,A)
  101 FORMAT (1X)

C Dump NDP numeric and environment registers into buffer
      TYPE = STNDPENV(WBUFF(1))

C display contents of NDP
      OKAY = DISPLAY_NDP()
      IF (OKAY .EQ. NO) THEN
        WRITE (*,101)
        WRITE (*,100) 'Problem in DISPLAY_NDP'
        WRITE (*,101)
        STOP
      END IF

C Set up new exception handler
      OKAY = SET_EX_HDL(N_EX_HDL)
      IF (OKAY .EQ. NO) THEN
        WRITE (*,101)
        WRITE (*,100) 'Cannot set up new exception handler.'
        WRITE (*,101)
C beep
        WRITE (*,100) CHAR(7)
        STOP
      END IF

C enable underflow exception trap  
      EMASK = UM
      SAVE_CW = ENAB_EX(EMASK)

      IF (SAVE_CW .EQ. EVAL) THEN
        WRITE (*,101)
        WRITE (*,100) 'Problem in ENAB_EX'
        WRITE (*,101)
C beep
        WRITE (*,100) CHAR(7)
        STOP
      END IF

C Force underflow 
      D1 = D2 * D3 * D4

      WRITE (*,102) 'The product is ',D1
  102 FORMAT (1X,A,D20.14)
      WRITE (*,101)
      END
C ********************  end of main ***************************

      INCLUDE 'DISPNDP.F'

C ******************** New exception handler **********************
      SUBROUTINE N_EX_HDL()
C Control branches to this routine (after it is installed)
C anytime an NDP exception occurs and that exception has
C been unmasked in the NDP's control word.
C
      INTEGER IM,DM,ZM,OM,UM,PM,OUM,DCM
      PARAMETER(IM=1,DM=2,ZM=4,OM=8,UM=16,PM=32,OUM=64,DCM=128)

C dump NDP state to memory
      INTEGER STNDPENV
C display NDP state after calling STNDPENV
      INTEGER DISPLAY_NDP

C The following section is specific for the 80287 and
C 80387. To use it, just uncomment the code part and
C comment out code in sections specific to the mW1167
      INTEGER*4 BUFF(27)
      INTEGER*2 WBUFF(54)
      INTEGER*1 BBUFF(108)
      EQUIVALENCE (BUFF, WBUFF, BBUFF)
      COMMON BUFF
C The placement of the Control Word, Status Word, and Tag
C Word in the buffer differ between the 80287 and the 80387.
C The following are to be used as subscripts into the
C WBUFF array. To use them, just uncomment the PARAMETER
C statement for the coprocessor you intend to use.
      INTEGER CW,SW,TW
C The following statement is specific for the 80287
C      PARAMETER (CW=1,SW=2,TW=3)
C The following statement is specific for the 80387
      PARAMETER (CW=1,SW=3,TW=5)
C end of 80287 and 80387 specific section

C The following section is specific for the mW1167
C To use it, just uncomment the code part and
C comment out code in sections specific to the
C 80387 and 80287.
C In the following arrays, the genuine data items begin
C at subscript 1. Any subscript lower than that is padding
C so as to align all genuine data items on the same boundary
C      INTEGER*4 BUFF (-1:32)
C      INTEGER*2 WBUFF (-1:2)
C      REAL*4   R4BUFF (-1:32)
C      REAL*8   R8BUFF (0:16)
C      EQUIVALENCE (BUFF, WBUFF, R4BUFF, R8BUFF)
C end of mW1167 specific section

      INTEGER I
C type of coprocessor installed
      INTEGER   TYPE

      INTEGER SEGSELECT
C Selects program's data segment
      PARAMETER (SEGSELECT=20)

      INTEGER*1 NEW_VALUE (8)

C The following code initializes the new value. Each byte
C is initialized separately so that this code may be
C adapted for any hexadecimal values
C
       NEW_VALUE (1) =  Z'0'
       NEW_VALUE (2) =  Z'0'
       NEW_VALUE (3) =  Z'0'
       NEW_VALUE (4) =  Z'0'
       NEW_VALUE (5) =  Z'0'
       NEW_VALUE (6) =  Z'0'
       NEW_VALUE (7) =  Z'0'
       NEW_VALUE (8) =  Z'0'

      WRITE (*,3000)
 3000 FORMAT (1X)
 3001 FORMAT (1X,A)
      WRITE (*,3001) 'An NDP exception has just occurred'
      WRITE (*,3000)
      WRITE (*,3000)

C On entry the one or more error bits in the NDP status
C word are on. The error handler calls STNDPENV to dump
C NDP numeric and environment registers into the buffer.
C A side effect of this is that the chip is reinitialized,
C with all exceptions masked and all error bits cleared.
C
      TYPE = STNDPENV(WBUFF(1))

C Display NDP state
      I = DISPLAY_NDP()

C The default (masked) response of the 80387 to an
C underflow is to return a denormal if possible or,
C failing that, zero. In this case, the programmer has
C decided that it would be better if the program
C would always return zero. The code below tests the 
C underflow error bit in the status word. If this is indeed
C the current error, the program moves zero into the memory
C area whose address is in the operand offset field of the
C 80387. It then calls INIT_NDP which reinitializes
C the 80387, clearing the error bits in the status word,
C otherwise another interrupt would happen immediately.
C

C The following section is specific for the 80387
C To use it, just uncomment the code part and
C comment out code in sections specific to the
C 80287 and mW1167
C The following code copies the bytes in NEW_VALUE to
C the memory location where the program was attempting
C to store the underflowed value.

        I = IAND (UM, WBUFF(3))
        IF (I .EQ. UM) THEN
          CALL BLK_BM (NEW_VALUE(1),SEGSELECT,(BUFF(6)),8)
        END IF

C Initialize the NDP. This function clears the error
C bits in the status word lest an NDP exception
C immediately recur
        CALL INIT_NDP()
C end of code specific to the 80387

C Control now returns to the main program, right after
C the instruction which caused the underflow.
C
      END
C **************** end of new exception handler ******************
