home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l320 / 2.img / EXAMPLES / DEBUG.F < prev    next >
Encoding:
Text File  |  1989-09-27  |  1.2 KB  |  47 lines
  1. c At each invocation to a subroutine or function,
  2. c USER_DEBUG checks the STATUS WORD indicator.
  3. c If any errors have occurred since the last call,
  4. c it prints the error and clears the STATUS WORD.
  5. c Compile main program with -g switch.
  6. c Compile this program without -g switch.
  7. c Link the programs together.
  8.  
  9.     subroutine user_debug(a,b,n)
  10.     character*(*) a,b
  11.     character*10 temp
  12.     integer n, j, stndpsw, k
  13.     data temp / 10H(' ',i1,$) /
  14. 1    Format (' ',a,$)
  15.     k=0
  16. 10    k=k+1
  17.     if (n.ge.10**k) goto 10
  18.     temp(7:7) = char(48+k)
  19.     j = stndpsw()
  20.     if (0.lt.(j.and.95)) then
  21.       Print 1, 'In '
  22.       Print 1, b
  23.       Print 1, ', before line #'
  24.       Print temp, n
  25.       Print 1, ' ("CALL '
  26.       Print 1, a
  27.       Print 1, '")'
  28.       If (0.lt.(J.AND. 1)) Print 1,', Invalid Operation'
  29.       If (0.lt.(J.AND. 2)) Print 1,', Denormal'
  30.       If (0.lt.(J.AND. 4)) Print 1,', Zero Divide'
  31.       If (0.lt.(J.AND. 8)) Print 1,', Overflow'
  32.       If (0.lt.(J.AND.16)) Print 1,', Underflow'
  33.       If (0.lt.(J.AND.32)) Print 1,', Precision'
  34.       If (0.lt.(J.AND.64)) Print 1,', Stack Fault'
  35.       Print *, '.'
  36.       call clrndpex
  37. d     else
  38. d      print 1, " ("
  39. d      j=len(b)
  40. d      print 1, b(2:j-1)
  41. d      print 1, "-"
  42. d      j=len(a)
  43. d      print 1, a(2:j-1)
  44. d      print 1, ")"
  45.      end if
  46.     end
  47.