CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol022 / sincos.src < prev next >

Wrap

Text File | 1984-04-29 | 4.1 KB | 382 lines

; 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 ;