home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l320 / 2.img / EXAMPLES / UNFL.F < prev    next >
Encoding:
Text File  |  1989-12-14  |  11.5 KB  |  363 lines
  1.       PROGRAM UNFL
  2. C Purpose: to demonstrate the principles used in
  3. C creating a user-written numeric exception handler.
  4. C To compile for an 80287:
  5. C       f77 unfl.f -n0
  6. C To compile for an 80387:
  7. C       f77 unfl.f -n2
  8. C To compile for an mW1167:
  9. C       f77 unfl.f -n4
  10.  
  11. C Copyright MicroWay, Inc. 1989
  12. C All Rights Reserved
  13.  
  14. C The following symbolic constants refer to bit positions
  15. C in the 80x87 and Weitek Control Register and in the
  16. C 80x87 and Weitek Status Register that correspond to the
  17. C exceptions recognized by the coprocessors. See the
  18. C discussion on numeric exception handling in the
  19. C appropriate chapter of the manual
  20. C
  21.  
  22. C       IM      1               All NDPs.
  23. C       DM      2               80x87 only
  24. C       ZM      4               All NDPs.
  25. C       OM      8               All NDPs.
  26. C       UM      16              All NDPs.
  27. C       PM      32              All NDPs.
  28. C       UOM     64              Weitek only.
  29. C       DCM     128             Weitek only.
  30.  
  31.       INTEGER IM,DM,ZM,OM,UM,PM,OUM,DCM
  32.       PARAMETER(IM=1,DM=2,ZM=4,OM=8,UM=16,PM=32,OUM=64,DCM=128)
  33.  
  34. C The following symbolic constants refer to the type of
  35. C numeric coprocessor present
  36.  
  37.       INTEGER NONE,MW1167,I80387,I80287
  38.       PARAMETER (NONE=0,MW1167=1,I80387=2,I80287=3)
  39.  
  40. C returns type of coprocessor
  41.       INTEGER NDPTYPE
  42.  
  43.       INTEGER YES,NO
  44.       PARAMETER (YES=1,NO=0)
  45.  
  46. C enables exceptions in coprocessor
  47.       INTEGER ENAB_EX
  48. C error value returned by ENAB_EX
  49.       INTEGER EVAL
  50.       PARAMETER (EVAL=-1)
  51.  
  52. C set up exception handler
  53.       INTEGER SET_EX_HDL
  54. C Important!  The following subroutine is passed as a parameter
  55. C to SET_EX_HDL. The name must be declared external or the
  56. C compiler will not generate the correct code to pass it.
  57. C forward reference
  58.       EXTERNAL N_EX_HDL
  59.  
  60. C dump NDP state to memory
  61.       INTEGER STNDPENV
  62. C display NDP state after calling STNDPENV
  63.       INTEGER DISPLAY_NDP
  64.  
  65.       REAL*8 D1, D2, D3, D4
  66.  
  67. C Template of memory area to store and load 80287
  68. C coprocessor's environment and numeric registers
  69. C First, the environment  registers:
  70. C       Control Word    unsigned 2 byte integer
  71. C       Status Word     unsigned 2 byte integer
  72. C       Tag Word        unsigned 2 byte integer
  73. C       padding         unsigned 2 byte integer
  74. C       padding         unsigned 2 byte integer
  75. C       padding         unsigned 2 byte integer
  76. C       IP Offset       unsigned 4 byte integer
  77. C       CS Selector     unsigned 2 byte integer
  78. C       padding         unsigned 2 byte integer
  79. C       Data Offset     unsigned 4 byte integer
  80. C       Operand Selector unsigned 2 byte integer
  81. C       padding         unsigned 2 byte integer
  82. C Next, the numeric registers:
  83. C       ten byte real   st0
  84. C       ten byte real   st1
  85. C       ten byte real   st2
  86. C       ten byte real   st3
  87. C       ten byte real   st4
  88. C       ten byte real   st5
  89. C       ten byte real   st6
  90. C       ten byte real   st7
  91. C
  92. C end of 80287 template
  93.  
  94. C Template of memory area to store and load 80387
  95. C coprocessor's environment and numeric registers
  96. C First, the environment  registers:
  97. C       Control Word    unsigned 2 byte integer
  98. C       padding         unsigned 2 byte integer
  99. C       Status Word     unsigned 2 byte integer
  100. C       padding         unsigned 2 byte integer
  101. C       Tag Word        unsigned 2 byte integer
  102. C       padding         unsigned 2 byte integer
  103. C       IP Offset       unsigned 4 byte integer
  104. C       CS Selector     unsigned 2 byte integer
  105. C       padding         unsigned 2 byte integer
  106. C       Data Offset     unsigned 4 byte integer
  107. C       Operand Selector unsigned 2 byte integer
  108. C       padding         unsigned 2 byte integer
  109. C Next, the numeric registers:
  110. C       ten byte real   st0
  111. C       ten byte real   st1
  112. C       ten byte real   st2
  113. C       ten byte real   st3
  114. C       ten byte real   st4
  115. C       ten byte real   st5
  116. C       ten byte real   st6
  117. C       ten byte real   st7
  118. C
  119. C end of 80387 template
  120.  
  121. C Template of memory area to store and load mW1167
  122. C coprocessor's environment and numeric registers
  123. C First, the environment  registers:
  124. C       Control Word    unsigned 2 byte integer
  125. C       Status Word     unsigned 2 byte integer
  126. C Next, the numeric registers:
  127. C       32 real*4
  128. C           or
  129. C       16 real*8       must begin in even-numbered register
  130. C           or
  131. C       some combination of real*4 and real*8
  132. C
  133. C end of mW1167 template
  134.  
  135. C The arrays declared below will overlay the memory area
  136. C used to store (and load) the coprocessor's registers.
  137. C Any routines which are to access this information must
  138. C include these declarations.
  139.  
  140. C The following section is specific for the 80287 and
  141. C 80387. To use it, just uncomment the code part and
  142. C comment out code in sections specific to the mW1167
  143.       INTEGER*4 BUFF (27)
  144.       INTEGER*2 WBUFF(54)
  145.       INTEGER*1 BBUFF(108)
  146.       EQUIVALENCE (BUFF, WBUFF, BBUFF)
  147.       COMMON BUFF
  148. C end of 80287 and 80387 specific section
  149.  
  150. C The following section is specific for the mW1167
  151. C To use it, just uncomment the code part and
  152. C comment out code in sections specific to the
  153. C 80387 and 80287
  154. C In the following arrays, the genuine data items begin
  155. C at subscript 1. Any subscript lower than that is padding
  156. C so as to align all genuine data items on the same boundary
  157. C      INTEGER*4        BUFF (-1:32)
  158. C      INTEGER*2        WBUFF (-1:2)
  159. C      REAL*4   R4BUFF (-1:32)
  160. C      REAL*8   R8BUFF (0:16)
  161. C      EQUIVALENCE (BUFF, WBUFF, R4BUFF, R8BUFF)
  162. C end of mW1167 specific section
  163.  
  164. C type of coprocessor
  165.       INTEGER*4 TYPE
  166.       INTEGER*4 SAVE_CW, EMASK
  167.       INTEGER*4 OKAY
  168.  
  169.       D2 = 2.0E-150
  170.       D3 = 2.0E-151
  171.       D4 = 2.0E-15
  172.  
  173. C Initialize the NDP. Masks all errors except invalid operations
  174.       CALL INIT_NDP()
  175.  
  176. C get type of NDP
  177.       TYPE = NDPTYPE()
  178.       IF (TYPE .EQ. NONE) THEN
  179.         WRITE (*,100) 'No NDP present. Exiting'
  180.         WRITE (*,101)
  181.         WRITE (*,101)
  182. C beep
  183.         WRITE (*,100) CHAR(7)
  184.         STOP
  185.       END IF
  186.  
  187.   100 FORMAT (1X,A)
  188.   101 FORMAT (1X)
  189.  
  190. C Dump NDP numeric and environment registers into buffer
  191.       TYPE = STNDPENV(WBUFF(1))
  192.  
  193. C display contents of NDP
  194.       OKAY = DISPLAY_NDP()
  195.       IF (OKAY .EQ. NO) THEN
  196.         WRITE (*,101)
  197.         WRITE (*,100) 'Problem in DISPLAY_NDP'
  198.         WRITE (*,101)
  199.         STOP
  200.       END IF
  201.  
  202. C Set up new exception handler
  203.       OKAY = SET_EX_HDL(N_EX_HDL)
  204.       IF (OKAY .EQ. NO) THEN
  205.         WRITE (*,101)
  206.         WRITE (*,100) 'Cannot set up new exception handler.'
  207.         WRITE (*,101)
  208. C beep
  209.         WRITE (*,100) CHAR(7)
  210.         STOP
  211.       END IF
  212.  
  213. C enable underflow exception trap  
  214.       EMASK = UM
  215.       SAVE_CW = ENAB_EX(EMASK)
  216.  
  217.       IF (SAVE_CW .EQ. EVAL) THEN
  218.         WRITE (*,101)
  219.         WRITE (*,100) 'Problem in ENAB_EX'
  220.         WRITE (*,101)
  221. C beep
  222.         WRITE (*,100) CHAR(7)
  223.         STOP
  224.       END IF
  225.  
  226. C Force underflow 
  227.       D1 = D2 * D3 * D4
  228.  
  229.       WRITE (*,102) 'The product is ',D1
  230.   102 FORMAT (1X,A,D20.14)
  231.       WRITE (*,101)
  232.       END
  233. C ********************  end of main ***************************
  234.  
  235.       INCLUDE 'DISPNDP.F'
  236.  
  237. C ******************** New exception handler **********************
  238.       SUBROUTINE N_EX_HDL()
  239. C Control branches to this routine (after it is installed)
  240. C anytime an NDP exception occurs and that exception has
  241. C been unmasked in the NDP's control word.
  242. C
  243.       INTEGER IM,DM,ZM,OM,UM,PM,OUM,DCM
  244.       PARAMETER(IM=1,DM=2,ZM=4,OM=8,UM=16,PM=32,OUM=64,DCM=128)
  245.  
  246. C dump NDP state to memory
  247.       INTEGER STNDPENV
  248. C display NDP state after calling STNDPENV
  249.       INTEGER DISPLAY_NDP
  250.  
  251. C The following section is specific for the 80287 and
  252. C 80387. To use it, just uncomment the code part and
  253. C comment out code in sections specific to the mW1167
  254.       INTEGER*4 BUFF(27)
  255.       INTEGER*2 WBUFF(54)
  256.       INTEGER*1 BBUFF(108)
  257.       EQUIVALENCE (BUFF, WBUFF, BBUFF)
  258.       COMMON BUFF
  259. C The placement of the Control Word, Status Word, and Tag
  260. C Word in the buffer differ between the 80287 and the 80387.
  261. C The following are to be used as subscripts into the
  262. C WBUFF array. To use them, just uncomment the PARAMETER
  263. C statement for the coprocessor you intend to use.
  264.       INTEGER CW,SW,TW
  265. C The following statement is specific for the 80287
  266. C      PARAMETER (CW=1,SW=2,TW=3)
  267. C The following statement is specific for the 80387
  268.       PARAMETER (CW=1,SW=3,TW=5)
  269. C end of 80287 and 80387 specific section
  270.  
  271. C The following section is specific for the mW1167
  272. C To use it, just uncomment the code part and
  273. C comment out code in sections specific to the
  274. C 80387 and 80287.
  275. C In the following arrays, the genuine data items begin
  276. C at subscript 1. Any subscript lower than that is padding
  277. C so as to align all genuine data items on the same boundary
  278. C      INTEGER*4 BUFF (-1:32)
  279. C      INTEGER*2 WBUFF (-1:2)
  280. C      REAL*4   R4BUFF (-1:32)
  281. C      REAL*8   R8BUFF (0:16)
  282. C      EQUIVALENCE (BUFF, WBUFF, R4BUFF, R8BUFF)
  283. C end of mW1167 specific section
  284.  
  285.       INTEGER I
  286. C type of coprocessor installed
  287.       INTEGER   TYPE
  288.  
  289.       INTEGER SEGSELECT
  290. C Selects program's data segment
  291.       PARAMETER (SEGSELECT=20)
  292.  
  293.       INTEGER*1 NEW_VALUE (8)
  294.  
  295. C The following code initializes the new value. Each byte
  296. C is initialized separately so that this code may be
  297. C adapted for any hexadecimal values
  298. C
  299.        NEW_VALUE (1) =  Z'0'
  300.        NEW_VALUE (2) =  Z'0'
  301.        NEW_VALUE (3) =  Z'0'
  302.        NEW_VALUE (4) =  Z'0'
  303.        NEW_VALUE (5) =  Z'0'
  304.        NEW_VALUE (6) =  Z'0'
  305.        NEW_VALUE (7) =  Z'0'
  306.        NEW_VALUE (8) =  Z'0'
  307.  
  308.       WRITE (*,3000)
  309.  3000 FORMAT (1X)
  310.  3001 FORMAT (1X,A)
  311.       WRITE (*,3001) 'An NDP exception has just occurred'
  312.       WRITE (*,3000)
  313.       WRITE (*,3000)
  314.  
  315. C On entry the one or more error bits in the NDP status
  316. C word are on. The error handler calls STNDPENV to dump
  317. C NDP numeric and environment registers into the buffer.
  318. C A side effect of this is that the chip is reinitialized,
  319. C with all exceptions masked and all error bits cleared.
  320. C
  321.       TYPE = STNDPENV(WBUFF(1))
  322.  
  323. C Display NDP state
  324.       I = DISPLAY_NDP()
  325.  
  326. C The default (masked) response of the 80387 to an
  327. C underflow is to return a denormal if possible or,
  328. C failing that, zero. In this case, the programmer has
  329. C decided that it would be better if the program
  330. C would always return zero. The code below tests the 
  331. C underflow error bit in the status word. If this is indeed
  332. C the current error, the program moves zero into the memory
  333. C area whose address is in the operand offset field of the
  334. C 80387. It then calls INIT_NDP which reinitializes
  335. C the 80387, clearing the error bits in the status word,
  336. C otherwise another interrupt would happen immediately.
  337. C
  338.  
  339. C The following section is specific for the 80387
  340. C To use it, just uncomment the code part and
  341. C comment out code in sections specific to the
  342. C 80287 and mW1167
  343. C The following code copies the bytes in NEW_VALUE to
  344. C the memory location where the program was attempting
  345. C to store the underflowed value.
  346.  
  347.         I = IAND (UM, WBUFF(3))
  348.         IF (I .EQ. UM) THEN
  349.           CALL BLK_BM (NEW_VALUE(1),SEGSELECT,(BUFF(6)),8)
  350.         END IF
  351.  
  352. C Initialize the NDP. This function clears the error
  353. C bits in the status word lest an NDP exception
  354. C immediately recur
  355.         CALL INIT_NDP()
  356. C end of code specific to the 80387
  357.  
  358. C Control now returns to the main program, right after
  359. C the instruction which caused the underflow.
  360. C
  361.       END
  362. C **************** end of new exception handler ******************
  363.