home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l320 / 2.img / EXAMPLES / DIVZ.F < prev    next >
Encoding:
Text File  |  1989-12-14  |  11.7 KB  |  367 lines
  1.       PROGRAM DIVZ
  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 divz.f -n0
  6. C To compile for an 80387:
  7. C       f77 divz.f -n2
  8. C To compile for an mW1167:
  9. C       f77 divz.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
  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 the arrays 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 = 1.0
  170.       D3 = 0.0
  171.  
  172. C Initialize the NDP. Masks all errors except invalid operations
  173.       CALL INIT_NDP()
  174.  
  175. C get type of NDP
  176.       TYPE = NDPTYPE()
  177.       IF (TYPE .EQ. NONE) THEN
  178.         WRITE (*,100) 'No NDP present. Exiting'
  179.         WRITE (*,101)
  180.         WRITE (*,101)
  181. C beep
  182.         WRITE (*,100) CHAR(7)
  183.         STOP
  184.       END IF
  185.  
  186.   100 FORMAT (1X,A)
  187.   101 FORMAT (1X)
  188.  
  189. C Dump NDP numeric and environment registers into buffer
  190.       TYPE = STNDPENV(WBUFF(1))
  191.  
  192. C display contents of NDP
  193.       OKAY = DISPLAY_NDP()
  194.       IF (OKAY .EQ. NO) THEN
  195.         WRITE (*,101)
  196.         WRITE (*,100) 'Problem in DISPLAY_NDP'
  197.         WRITE (*,101)
  198. C beep
  199.         WRITE (*,100) CHAR(7)
  200.         STOP
  201.       END IF
  202.  
  203. C Set up new exception handler
  204.       OKAY = SET_EX_HDL(N_EX_HDL)
  205.       IF (OKAY .EQ. NO) THEN
  206.         WRITE (*,101)
  207.         WRITE (*,100) 'Cannot set up new exception handler.'
  208.         WRITE (*,101)
  209. C beep
  210.         WRITE (*,100) CHAR(7)
  211.         STOP
  212.       END IF
  213.  
  214. C enable zero divide exception trap  
  215.       EMASK = ZM
  216.       SAVE_CW = ENAB_EX(EMASK)  
  217.  
  218.       IF (SAVE_CW .EQ. EVAL) THEN
  219.         WRITE (*,101)
  220.         WRITE (*,100) 'Problem in ENAB_EX'
  221.         WRITE (*,101)
  222. C beep
  223.         WRITE (*,100) CHAR(7)
  224.         STOP
  225.       END IF
  226.  
  227. C Force division by zero 
  228.       D1 = D2 / D3
  229.  
  230.       WRITE (*,102) 'The quotient is ',D1
  231.   102 FORMAT (1X,A,D20.14)
  232.       WRITE (*,101)
  233.       END
  234. C ********************  end of main ***************************
  235.  
  236.       INCLUDE 'DISPNDP.F'
  237.  
  238. C ******************** New exception handler **********************
  239.       SUBROUTINE N_EX_HDL()
  240. C Control branches to this routine (after it is installed)
  241. C anytime an NDP exception occurs and that exception has
  242. C been unmasked in the NDP's control word.
  243. C
  244.       INTEGER IM,DM,ZM,OM,UM,PM,OUM,DCM
  245.       PARAMETER(IM=1,DM=2,ZM=4,OM=8,UM=16,PM=32,OUM=64,DCM=128)
  246.  
  247. C dump NDP state to memory
  248.       INTEGER STNDPENV
  249. C display NDP state after calling STNDPENV
  250.       INTEGER DISPLAY_NDP
  251.  
  252. C The following section is specific for the 80287 and
  253. C 80387. To use it, just uncomment the code part and
  254. C comment out code in sections specific to the mW1167
  255.       INTEGER*4 BUFF(27)
  256.       INTEGER*2 WBUFF(54)
  257.       INTEGER*1 BBUFF(108)
  258.       EQUIVALENCE (BUFF, WBUFF, BBUFF)
  259.       COMMON BUFF
  260. C The placement of the Control Word, Status Word, and Tag
  261. C Word in the buffer differ between the 80287 and the 80387.
  262. C The following are to be used as subscripts into the
  263. C WBUFF array. To use them, just uncomment the PARAMETER
  264. C statement for the coprocessor you intend to use.
  265.       INTEGER CW,SW,TW
  266. C The following statement is specific for the 80287
  267. C      PARAMETER (CW=1,SW=2,TW=3)
  268. C The following statement is specific for the 80387
  269.       PARAMETER (CW=1,SW=3,TW=5)
  270. C end of 80287 and 80387 specific section
  271.  
  272. C The following section is specific for the mW1167
  273. C To use it, just uncomment the code part and
  274. C comment out code in sections specific to the
  275. C 80387 and 80287.
  276. C In the following arrays, the genuine data items begin
  277. C at subscript 1. Any subscript lower than that is padding
  278. C so as to align all genuine data items on the same boundary
  279. C      INTEGER*4 BUFF (-1:32)
  280. C      INTEGER*2 WBUFF (-1:2)
  281. C      REAL*4   R4BUFF (-1:32)
  282. C      REAL*8   R8BUFF (0:16)
  283. C      EQUIVALENCE (BUFF, WBUFF, R4BUFF, R8BUFF)
  284. C end of mW1167 specific section
  285.  
  286.       INTEGER I
  287. C type of coprocessor installed
  288.       INTEGER   TYPE
  289.  
  290.       INTEGER*1 NEW_VALUE (10)
  291.  
  292. C The following code initializes the new value. Each byte
  293. C is initialized separately so that this code may be
  294. C adapted for any hexadecimal values
  295. C
  296.        NEW_VALUE (1) =  Z'FF'
  297.        NEW_VALUE (2) =  Z'FF'
  298.        NEW_VALUE (3) =  Z'FF'
  299.        NEW_VALUE (4) =  Z'FF'
  300.        NEW_VALUE (5) =  Z'FF'
  301.        NEW_VALUE (6) =  Z'FF'
  302.        NEW_VALUE (7) =  Z'FF'
  303.        NEW_VALUE (8) =  Z'FF'
  304.        NEW_VALUE (9) =  Z'FB'
  305.        NEW_VALUE (10) = Z'43'
  306.  
  307.       WRITE (*,3000)
  308.  3000 FORMAT (1X)
  309.  3001 FORMAT (1X,A)
  310.       WRITE (*,3001) 'An NDP exception has just occurred'
  311.       WRITE (*,3000)
  312.       WRITE (*,3000)
  313.  
  314. C On entry the one or more error bits in the NDP status
  315. C word are on. The error handler calls STNDPENV to dump
  316. C NDP numeric and environment registers into the buffer.
  317. C A side effect of this is that the chip is reinitialized,
  318. C with all exceptions masked and all error bits cleared.
  319. C
  320.       TYPE = STNDPENV(WBUFF(1))  
  321.  
  322. C Display NDP state
  323.       I = DISPLAY_NDP()
  324.  
  325. C The default (masked) response of the 80387 to a division
  326. C by zero is to return an infinity whose sign is the
  327. C exclusive OR of the signs of the two operands. The
  328. C programmer has decided that it would be better if the
  329. C program would return a very large positive number. The
  330. C code below tests the zero divide bit in the status word.
  331. C If this is indeed the current error, the program moves a
  332. C very large value into the memory area for ST0 (the lowest
  333. C 80387 numeric register) and then calls LDNDPENV
  334. C which reloads the buffer into the 80387 and clears the
  335. C error bits in the status word, otherwise another
  336. C interrupt would happen immediately.
  337. C Note that LDNDPENV will NOT work with an 80287,
  338. C because of a bug in the interface between a protected
  339. C mode 80386 and an 80287.
  340. C
  341.  
  342. C The following section is specific for the 80387
  343. C To use it, just uncomment the code part and
  344. C comment out code in sections specific to the
  345. C 80287 and mW1167
  346. C The following code copies the bytes in NEW_VALUE to
  347. C the memory location in the coprocessor's buffer
  348. C where ST0 is stored
  349. C
  350.         I = IAND (ZM, WBUFF(SW))
  351.         IF (I .EQ. ZM) THEN
  352.           DO 2000, I = 1,10
  353.             BBUFF(I+28) = NEW_VALUE(I)
  354.  2000     CONTINUE
  355.         END IF
  356. C Load buffer back into NDP. This function clears the error
  357. C bits in the status word lest an NDP exception 
  358. C immediately recur     
  359.         CALL LDNDPENV(WBUFF(1))
  360. C end of code specific to the 80387
  361.  
  362. C Control now returns to the main program, right after
  363. C the instruction which caused the division by zero.
  364. C
  365.       END
  366. C **************** end of new exception handler ******************
  367.