|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 3712 (0xe80)
Types: TextFile
Names: »ARCTAN.SRC«
└─⟦c9df7130d⟧ Bits:30005915 Pascal MT+ Release 5.2 (Jet-80)
└─ ⟦this⟧ »ARCTAN.SRC«
; INTRINSIC FUNCTION FOR CALCULATING ARCTANGENT ; NAME ARCTAN ENTRY ARCTAN,L131 INCLUDE DEFLT.SRC INCLUDE FCTMAC.SRC ; F SET 0 ; ; function arctan( x: real ): real; ; const ; a1 = 3.7092563; ; a2 = -7.10676; ; a3 = -0.26476862; ; b0 = 0.17465544; ; b1 = 6.762139; ; b2 = 3.3163354; ; b3 = 1.44863154; ; var i,k: real; ; signchg, adjust: boolean; ; begin arctan: L131: L150 ENTR D,2,10 ; adjust := false; MOV -8(IX),A ; signchg := false; MOV -9(IX),A ; if x < 0.0 then LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,8 DADD B LXI B,4 LDIR MOV H,A MOV L,A PUSH H PUSH H LESS D,-4 ; begin JNC L206 ; signchg := true; MVI -9(IX),1 ; x := -x ; end; LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,8 DADD B LXI B,4 LDIR NEGT E LXI H,3 DADD S XCHG PUSH IX POP H LXI B,11 DADD B XCHG LXI B,4 LDDR POP H POP H L206 ; if x > 1.0 then LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,8 DADD B LXI B,4 LDIR LXI H,320 MOV D,A MOV E,A PUSH H PUSH D GRET D,-4 ; begin JNC L228 ; adjust := true; MVI -8(IX),1 ; x := 1.0 / x LXI H,320 MOV D,A MOV E,A PUSH H PUSH D ; end; LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,8 DADD B LXI B,4 LDIR FDVD D,-4 LXI H,3 DADD S XCHG PUSH IX POP H LXI B,11 DADD B XCHG LXI B,4 LDDR POP H POP H L228 ; i := x * x; LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,8 DADD B LXI B,4 LDIR LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,8 DADD B LXI B,4 LDIR MULT D,-4 LXI H,3 DADD S XCHG PUSH IX POP H XCHG LXI B,4 LDDR POP H POP H ; k := x * (b0 + a1 / LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,8 DADD B LXI B,4 LDIR LXI H,-423 LXI D,27760 PUSH H PUSH D LXI H,630 LXI D,-19911 PUSH H PUSH D ; (b1 + i + a2 / LXI H,876 LXI D,12728 PUSH H PUSH D LXI H,-4 DADD S SPHL XCHG PUSH IX POP H DCX H DCX H DCX H LXI B,4 LDIR DADD D,-4 LXI H,1009 LXI D,-19127 PUSH H PUSH D ; (b2 + i + a3 / LXI H,618 LXI D,8043 PUSH H PUSH D LXI H,-4 DADD S SPHL XCHG PUSH IX POP H DCX H DCX H DCX H LXI B,4 LDIR DADD D,-4 LXI H,-61 LXI D,-14368 PUSH H PUSH D ; (b3 + i) ) ) ); LXI H,348 LXI D,-18848 PUSH H PUSH D LXI H,-4 DADD S SPHL XCHG PUSH IX POP H DCX H DCX H DCX H LXI B,4 LDIR DADD D,-4 FDVD D,-4 DADD D,-4 FDVD D,-4 DADD D,-4 FDVD D,-4 DADD D,-4 MULT D,-4 LXI H,3 DADD S XCHG PUSH IX POP H LXI B,-4 DADD B XCHG LXI B,4 LDDR POP H POP H ; if adjust then k := halfpi - k; CMP -8(IX) JNC L284 LXI H,356 LXI D,-30739 PUSH H PUSH D LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,-7 DADD B LXI B,4 LDIR DSUB D,-4 LXI H,3 DADD S XCHG PUSH IX POP H LXI B,-4 DADD B XCHG LXI B,4 LDDR POP H POP H L284 ; if signchg then k := - k; CMP -9(IX) JNC L297 LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,-7 DADD B LXI B,4 LDIR NEGT E LXI H,3 DADD S XCHG PUSH IX POP H LXI B,-4 DADD B XCHG LXI B,4 LDDR POP H POP H L297 ; arctan := k ; end; LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,-7 DADD B LXI B,4 LDIR LXI H,3 DADD S XCHG PUSH IX POP H LXI B,15 DADD B XCHG LXI B,4 LDDR POP H POP H EXIT D,4 ; «eof»