; intrinsic functions for sine and cosine

; intrinsic functions for sine and cosine
;<<<30 JULY 80 - mods to cosine routine>>>
;
NAME SINCOS
ENTRY SIN,L136
ENTRY COS,L132
INCLUDE DEFLT.SRC
INCLUDE FCTMAC.SRC
;
L136:
;
; (*
; * intrinsic function for sine
; *)
; function sin( x: real ):real;
; const a1 = 1.5707949;
; a3 = -0.64592098;
; a5 = 0.07948766;
; a7 = -0.004362476;
; piu2 = 0.6366197724; (* 2 / pi *)
; var x2: real;
; schg: boolean;
; begin
FCT375
sin: ENTR D,2,5
; schg := false;
FCC375
MOV -4(IX),A
; while x > halfpi do begin
FCT414
LXI H,-4
DADD S
SPHL
XCHG
PUSH IX
POP H
LXI B,8
DADD B
LXI B,4
LDIR
LXI H,356
LXI D,-30739
PUSH H
PUSH D
GRET D,-4
JNC FCT413
; x := x - pi;
LXI H,-4
DADD S
SPHL
XCHG
PUSH IX
POP H
LXI B,8
DADD B
LXI B,4
LDIR
LXI H,612
LXI D,-30739
PUSH H
PUSH D
DSUB 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
; schg := not schg
; end;
CMP -4(IX)
JRC FCT431
FCT430
FCT432 EQU FCT430
FCT435 EQU FCT432
INR A
FCT431
MOV L,A
XRA A
MOV H,A
MOV -4(IX),L
JMP FCT414
FCT413
; while x <= -halfpi do begin
FCT438
LXI H,-4
DADD S
SPHL
XCHG
PUSH IX
POP H
LXI B,8
DADD B
LXI B,4
LDIR
LXI H,484
LXI D,-30739
PUSH H
PUSH D
LE D,-4
JNC FCT437
; x := x + pi;
LXI H,-4
DADD S
SPHL
XCHG
PUSH IX
POP H
LXI B,8
DADD B
LXI B,4
LDIR
LXI H,612
LXI D,-30739
PUSH H
PUSH D
DADD 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
; schg := not schg
; end;
CMP -4(IX)
JRC FCT455
FCT454
FCT456 EQU FCT454
FCT459 EQU FCT456
INR A
FCT455
MOV L,A
XRA A
MOV H,A
MOV -4(IX),L
JMP FCT438
FCT437
; x := x * piu2;
LXI H,-4
DADD S
SPHL
XCHG
PUSH IX
POP H
LXI B,8
DADD B
LXI B,4
LDIR
LXI H,81
LXI D,31937
PUSH H
PUSH D
MULT 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
; x2 := 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
; x := (((a7*x2 + a5)*x2 + a3)*x2 + a1)*x;
LXI H,-1593
LXI D,31116
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
MULT D,-4
LXI H,-687
LXI D,25910
PUSH H
PUSH D
DADD D,-4
LXI H,-4
DADD S
SPHL
XCHG
PUSH IX
POP H
DCX H
DCX H
DCX H
LXI B,4
LDIR
MULT D,-4
LXI H,210
LXI D,-21111
PUSH H
PUSH D
DADD D,-4
LXI H,-4
DADD S
SPHL
XCHG
PUSH IX
POP H
DCX H
DCX H
DCX H
LXI B,4
LDIR
MULT D,-4
LXI H,356
LXI D,-30745
PUSH H
PUSH D
DADD D,-4
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
LXI B,11
DADD B
XCHG
LXI B,4
LDDR
POP H
POP H
; if schg then x := -x;
CMP -4(IX)
JNC FCT494
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
FCT494
; sin := x;
LXI H,-4
DADD S
SPHL
XCHG
PUSH IX
POP H
LXI B,8
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
; end;
EXIT D,4
;
; (*
; * intrinsic function for cosine
; *)
; function cos( x: real ):real;
; begin
FCT513
L132:
cos: ENTR D,2,5
; cos := sin( x + halfpi )
LXI H,-4
DADD S
SPHL
XCHG
PUSH IX
POP H
LXI B,8
DADD B
LXI B,4
LDIR
LXI H,356
LXI D,-30739
PUSH H
PUSH D
DADD 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
; end;
JMP FCC375
;