home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BPL70N12.ZIP / ARISOURC.ZIP / FPATN.ASM next >
Encoding:
Assembly Source File  |  1993-03-07  |  8.1 KB  |  169 lines
  1.  
  2. ; *******************************************************
  3. ; *                                                     *
  4. ; *     Turbo Pascal Runtime Library Version 7.0        *
  5. ; *     Real ArcTan                                     *
  6. ; *                                                     *
  7. ; *     Copyright (C) 1989-1993 Norbert Juffa           *
  8. ; *                                                     *
  9. ; *******************************************************
  10.  
  11.              TITLE   FPATN
  12.  
  13.  
  14. CODE         SEGMENT BYTE PUBLIC
  15.  
  16.              ASSUME  CS:CODE
  17.  
  18. ; Externals
  19.  
  20.              EXTRN   RealAdd:NEAR,RealPoly:NEAR,RealTrunc:NEAR,RealFloat:NEAR
  21.              EXTRN   RealDivRev:NEAR,RealMulNChk2:NEAR,CmpAbsValue:NEAR
  22.              EXTRN   ShortMulRev:NEAR
  23.  
  24. ; Publics
  25.  
  26.              PUBLIC  RArcTan
  27.  
  28. ;-------------------------------------------------------------------------------
  29. ; RArcTan computes the arctangent of a TURBO-Pascal six byte floating-point
  30. ; number. No overflow is possible, since function values range from -pi/2 to
  31. ; pi/2. The argument is reduced such that |z| <= 1/16 by an interval scheme
  32. ; based on the identity Arctan (x) = Arctan (a) + Arctan ((x-a) / (1 + x*a)).
  33. ; The arctangent of the reduced argument is then computed using a fast poly-
  34. ; nomial approximation. The result is finally adjusted depending on which
  35. ; reduction interval the argument was in. This polynomial approximation to the
  36. ; arctangent is used:
  37. ;
  38. ; p(z):=((-1.420288085938e-1*x^2+1.999981270101e-1)*x^2
  39. ;         -3.333333321307e-1)*x^2*x+x
  40. ;
  41. ; This approximation has a theoretical maximum relative error of 2.98e-13.
  42. ; Maximum observed error when evaluated in REAL arithmetic is 1.11e-12.
  43. ;
  44. ; INPUT:     DX:BX:AX  argument
  45. ;
  46. ; OUTPUT:    DX:BX:AX  arctan of argument
  47. ;
  48. ; DESTROYS:  AX,BX,CX,DX,SI,DI,Flags
  49. ;-------------------------------------------------------------------------------
  50.  
  51. RArcTanExt   PROC    FAR
  52. $atn_x:      RET                       ; return zero
  53. RArcTanExt   ENDP
  54.  
  55.              ALIGN   4
  56.  
  57. RArcTan      PROC    FAR
  58.              CMP     AL, 06Dh          ; x very small ?
  59.              JB      $atn_x            ; yes, return x
  60.              PUSH    BP                ; save TURBO-Pascal frame pointer
  61.              MOV     CH, 80h           ; load mask for sign bit
  62.              AND     CH, DH            ; isolate sign bit
  63.              XOR     DH, CH            ; absolute value of x
  64.              PUSH    CX                ; save sign bit
  65.              MOV     CX, 81h           ; load
  66.              XOR     SI, SI            ;  floating
  67.              MOV     DI, SI            ;   constant 1
  68.              CALL    CmpAbsValue       ; x <= 1 ?
  69.              PUSHF                     ; save division flag
  70.              JB      $no_division      ; x <= 1, no division
  71.              CALL    RealDivRev        ; compute x = 1/x
  72. $no_division:MOV     DI, DX            ; save
  73.              MOV     SI, BX            ;  x
  74.              PUSH    AX                ;
  75.              ADD     AL, 3             ; x * 8
  76.              MOV     CH, 0FFh          ; signal rounding desired
  77.              CALL    RealTrunc         ; n = Round (x * 8)
  78.              MOV     BP, AX            ; save n
  79.              POP     CX                ; DI:SI:CX = x
  80.              OR      AX, AX            ; n = 0 ?
  81.              MOV     DX, DI            ; reload x
  82.              MOV     BX, SI            ;  into
  83.              XCHG    AX, CX            ;   DX:BX:AX
  84.              JZ      $atn_appr         ; n=0, evaluate approximating polynomial
  85.              XCHG    AX, CX            ; AX=n, CX = LSW of x
  86.              PUSH    AX                ; save n
  87.              PUSH    CX                ; save LSW of x
  88.              CWD                       ; convert n to longint (n <= 8)
  89.              CALL    RealFloat         ; convert n to REAL
  90.              POP     CX                ; get LSW of x
  91.              SUB     AL, 3             ; n/8
  92.              MOV     BP, AX            ; save
  93.              MOV     AH, DH            ; AX = packed n
  94.              XCHG    AX, BP            ; BP = packed n
  95.              XOR     DH, 80h           ; -n/8
  96.              PUSH    DI                ; save
  97.              PUSH    SI                ;  x
  98.              PUSH    CX                ; save x
  99.              CALL    RealAdd           ; x - n/8
  100.              POP     CX                ; get
  101.              POP     SI                ;  x
  102.              POP     DI                ;   from stack
  103.              PUSH    DX                ; save x - n/8
  104.              PUSH    BX                ;  on
  105.              PUSH    AX                ;   stack
  106.              MOV     AX, BP            ; get packed floating point n
  107.              XOR     DX, DX            ; unpack
  108.              MOV     BX, DX            ;  floating point
  109.              XCHG    AH, DH            ;   n
  110.              CALL    ShortMulRev       ; x * n
  111.              MOV     CX, 81h           ; load
  112.              XOR     SI, SI            ;  real constant
  113.              MOV     DI, SI            ;   1.0
  114.              CALL    RealAdd           ; compute 1 + x*n/8
  115.              POP     CX                ; get
  116.              POP     SI                ;  back
  117.              POP     DI                ;   x - n/8
  118.              CALL    RealDivRev        ; compute (x - n/8) / (1 + x*n/8)
  119.              POP     BP                ; get integer n
  120.              MOV     CX, BP            ; compute
  121.              ADD     CX, CX            ;  offset into
  122.              ADD     BP, CX            ;   constant field
  123.              ADD     BP, BP            ;    as 6*n
  124.              ADD     BP, OFFSET ATN_CST; address of constant B for interval n
  125. $atn_appr:   MOV     CX, 3             ; approximation uses three coefficients
  126.              XOR     SI, SI            ; polynomial of type P(x²)*x+x
  127.              MOV     DI,OFFSET AT_COEFF; pointer to first coefficient
  128.              CALL    RealPoly          ; compute arctan (z) = z + z * P(z)
  129.              CMP     BP, OFFSET ATN_CST+6; first or second interval ?
  130.              JB      $first_intv       ; first interval, no correction needed
  131.              JNE     $normal_add       ; not second interval, no special add
  132.              MOV     CX, 03365h        ; add eps for second interval
  133.              MOV     SI, 07B6Eh        ;  for a pseudo
  134.              MOV     DI, 05561h        ;   multiple precision
  135.              CALL    RealAdd           ;    addition
  136. $normal_add: MOV     CX, CS:[BP-6]     ; load value
  137.              MOV     SI, CS:[BP-4]     ;  of constant B appropriate
  138.              MOV     DI, CS:[BP-2]     ;   for reduction interval
  139.              CALL    RealAdd           ; add B to arctan (z)
  140. $first_intv: POPF                      ; get flag for division
  141.              JB      $no_add           ; if no division then done
  142.              MOV     CX, 02181h        ; load
  143.              MOV     SI, 0DAA2h        ;  real constant
  144.              MOV     DI, 0490Fh        ;   0.5*pi
  145.              XOR     DH, 80h           ; - arctan (z)
  146.              CALL    RealAdd           ; compute 0.5*pi - arctan (z)
  147. $no_add:     POP     CX                ; get sign mask
  148.              POP     BP                ; restore TURBO-Pascal frame pointer
  149.              OR      DH, CH            ; make sign bit
  150.              RET                       ; done
  151. ATN_CST      DB      07Dh,000h,000h,0D4h,0ADh,07Eh ; arctan (1/8) - eps
  152.              DB      07Eh,064h,0C9h,0AFh,0DBh,07Ah ; arctan (2/8)
  153.              DB      07Fh,027h,00Fh,0CAh,0B0h,037h ; arctan (3/8)
  154.              DB      07Fh,00Eh,02Bh,038h,063h,06Dh ; arctan (4/8)
  155.              DB      080h,0F8h,05Eh,05Dh,000h,00Fh ; arctan (5/8)
  156.              DB      080h,035h,019h,07Dh,0BCh,024h ; arctan (6/8)
  157.              DB      080h,0C2h,02Bh,03Eh,005h,038h ; arctan (7/8)
  158.              DB      080h,021h,0A2h,0DAh,00Fh,049h ; arctan (8/8)
  159. AT_COEFF     DB      07Eh,               070h,091h ; -1.420288085938e-1
  160.              DB      07Eh,014h,01Bh,04Fh,0CCh,04Ch ;  1.999981270101e-1
  161.              DB      07Fh,056h,0A0h,0AAh,0AAh,0AAh ; -3.333333321307e-1
  162. RArcTan      ENDP
  163.  
  164.              ALIGN   4
  165.  
  166. CODE         ENDS
  167.  
  168.              END
  169.