DataMuseum.dk

Presents historical artifacts from the history of:

Jet Computer Jet80

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Jet Computer Jet80

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦6c49225a1⟧ TextFile

    Length: 3712 (0xe80)
    Types: TextFile
    Names: »ARCTAN.SRC«

Derivation

└─⟦c9df7130d⟧ Bits:30005915 Pascal MT+ Release 5.2 (Jet-80)
    └─ ⟦this⟧ »ARCTAN.SRC« 

TextFile

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