|
DataMuseum.dkPresents historical artifacts from the history of: Jet Computer Jet80 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Jet Computer Jet80 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 4224 (0x1080)
Types: TextFile
Names: »SINCOS.SRC«
└─⟦c9df7130d⟧ Bits:30005915 Pascal MT+ Release 5.2 (Jet-80)
└─ ⟦this⟧ »SINCOS.SRC«
; intrinsic functions for sine and cosine ; NAME SINCOS ENTRY SIN,COS,L132,L136 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 ; «eof»