CP/M

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

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

Wrap

Text File | 1984-04-29 | 5.1 KB | 510 lines

; FUNCTION COSINE(X:REAL):REAL; ; {+++ COSINE ROUTINE, ANGLE "X" MUST BE IN RADIANS +++} ; CONST PI = 3.1415926536; ; J = 2; ; VAR M,N : INTEGER; ; R,S,T,U,V : REAL; NAME COSINE ENTRY COSINE ; FUNCTION FIX(Y,P: REAL): REAL; ; VAR SGN : -1..1; ; BEGIN L151 ENTR D,3,2 ; IF Y>0.0 THEN LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,12 DADD B LXI B,4 LDIR MOV H,A MOV L,A MOV D,A MOV E,A PUSH H PUSH D GRET D,-4 ; SGN := 1 JNC L165 ; ELSE IF Y=0.0 THEN MOV 0(IX),A MVI -1(IX),1 JMP L178 L165 LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,12 DADD B LXI B,4 LDIR MOV H,A MOV L,A MOV D,A MOV E,A PUSH H PUSH D EQUL D,-4 ; SGN := 0 JNC L180 ; ELSE MOV 0(IX),A MOV -1(IX),A ; SGN := -1; JMP L193 L180 MVI 0(IX),255 MVI -1(IX),255 L193 L178 ; FIX := SGN * TRUNC(ABS(Y)/P); MOV L,-1(IX) MOV H,0(IX) PUSH H LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,12 DADD B LXI B,4 LDIR CALL L116 LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,8 DADD B LXI B,4 LDIR FDVD D,-4 CALL L129 POP H MULT D,0 CVTF H LXI H,3 DADD S XCHG PUSH IX POP H LXI B,19 DADD B XCHG LXI B,4 LDDR POP H POP H ; END; EXIT D,8 ; ; ; ; BEGIN L138 cosine: ENTR D,2,24 ; R := 0.0; MOV H,A MOV L,A MOV D,A MOV E,A PUSH H PUSH D 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 ABS(X)>PI THEN R := FIX(X,PI); LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,8 DADD B LXI B,4 LDIR CALL L116 LXI H,612 LXI D,-30739 PUSH H PUSH D GRET D,-4 JNC L227 PUSH B PUSH B 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 CALL L151 ; FIX(...) LXI H,3 DADD S XCHG PUSH IX POP H LXI B,-4 DADD B XCHG LXI B,4 LDDR POP H POP H L227 ; X := X - R * PI; 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,-7 DADD B LXI B,4 LDIR LXI H,612 LXI D,-30739 PUSH H PUSH D MULT D,-4 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 ; M := -1; MVI 0(IX),255 MVI -1(IX),255 ; N := 0; MOV -2(IX),A MOV -3(IX),A ; S := 1.0; LXI H,320 MOV D,A MOV E,A PUSH H PUSH D LXI H,3 DADD S XCHG PUSH IX POP H LXI B,-8 DADD B XCHG LXI B,4 LDDR POP H POP H ; T := 1.0; LXI H,320 MOV D,A MOV E,A PUSH H PUSH D LXI H,3 DADD S XCHG PUSH IX POP H LXI B,-12 DADD B XCHG LXI B,4 LDDR POP H POP H ; U := -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 NEGT E LXI H,3 DADD S XCHG PUSH IX POP H LXI B,-16 DADD B XCHG LXI B,4 LDDR POP H POP H ; REPEAT ; V := S; L296 LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,-11 DADD B LXI B,4 LDIR LXI H,3 DADD S XCHG PUSH IX POP H LXI B,-20 DADD B XCHG LXI B,4 LDDR POP H POP H ; M := M + J; N := N + J; MOV L,-1(IX) MOV H,0(IX) INX H INX H MOV 0(IX),H MOV -1(IX),L MOV L,-3(IX) MOV H,-2(IX) INX H INX H MOV -2(IX),H MOV -3(IX),L ; T := T*U/(M*N) ; LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,-15 DADD B LXI B,4 LDIR LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,-19 DADD B LXI B,4 LDIR MULT D,-4 MOV L,-1(IX) MOV H,0(IX) MOV E,-3(IX) MOV D,-2(IX) MULT D,0 PUSH H CVTF B FDVD D,-4 LXI H,3 DADD S XCHG PUSH IX POP H LXI B,-12 DADD B XCHG LXI B,4 LDDR POP H POP H ; S := S + T; LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,-11 DADD B LXI B,4 LDIR LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,-15 DADD B LXI B,4 LDIR DADD D,-4 LXI H,3 DADD S XCHG PUSH IX POP H LXI B,-8 DADD B XCHG LXI B,4 LDDR POP H POP H ; UNTIL (S = V); LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,-11 DADD B LXI B,4 LDIR LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,-23 DADD B LXI B,4 LDIR EQUL D,-4 JNC L296 ; IF (TRUNC(R) MOD J<>0) THEN S := -S; LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,-7 DADD B LXI B,4 LDIR CALL L129 LXI H,2 XCHG MMOD D,0 MOV D,A MOV E,A DSB1 D,0 JZ L347 LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,-11 DADD B LXI B,4 LDIR NEGT E LXI H,3 DADD S XCHG PUSH IX POP H LXI B,-8 DADD B XCHG LXI B,4 LDDR POP H POP H L347 ; COSINE := S; LXI H,-4 DADD S SPHL XCHG PUSH IX POP H LXI B,-11 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