IMPLEMENTATION MODULE MathREAL;
(*$ LargeVars:=FALSE *)

FROM SYSTEM IMPORT ASSEMBLE;

(*$ IF m68881 *)
  IMPORT FPUExc;
(*$ ENDIF *)

PROCEDURE Short(x{0}: LONGREAL): REAL; (*$ EntryExitCode:=FALSE *)
BEGIN
  ASSEMBLE(
	MOVE.L	D2,-(A7)
	MOVE.L	D0,D2
	SWAP	D2
	ANDI.W	#$7FF0,D2
	CMPI.W	#$3800,D2
	BGT.S	L1
	MOVEQ	#0,D0
	BRA.S	L3
L1:
	CMPI.W	#$4800,D2
	BLT.S	L2
	ORI	#$02,CCR
	BRA.S	L3
L2:
	MOVEQ	#29,D2
	LSR.L	D2,D1
	MOVE.L	D0,D2
	ANDI.L	#$C0000000,D2
	OR.L	D2,D1
	LSL.L	#3,D0
	ANDI.L	#$3FFFFFFF,D0
	OR.L	D1,D0
L3:
	MOVE.L	(A7)+,D2
	RTS
  END);
END Short;

PROCEDURE Long(x{0}: REAL): LONGREAL; (*$ EntryExitCode:=FALSE *)
BEGIN
  ASSEMBLE(
	MOVE.L	D0,D1
	SWAP	D1
	ANDI.W	#$7F80,D1
	BNE.S	L4
	MOVEQ	#0,D0
	MOVEQ	#0,D1
	RTS
L4:
	MOVE.L	D2,-(A7)
	MOVE.L	D0,D1
	MOVEQ	#29,D2
	LSL.L	D2,D1
	ASR.L	#3,D0
	ANDI.L	#$8FFFFFFF,D0
	BTST	#27,D0
	BEQ.S	L5
	EORI.L	#$70000000,D0
L5:
	EORI.L	#$38000000,D0
	MOVE.L	(A7)+,D2
	RTS
  END);
END Long;

PROCEDURE FixS(x{0}: REAL): LONGINT; (*$ EntryExitCode:=FALSE *)
BEGIN
  ASSEMBLE(BRA Fix END);
END FixS;

PROCEDURE Fix(x{0}: REAL): LONGINT; (*$ EntryExitCode:=FALSE *)
 BEGIN
  ASSEMBLE(
	MOVE.L	D2,-(A7)
	TST.L	D0
	SPL	D2
	ADD.L	D0,D0
	ROL.L	#8,D0
	CLR.W	D1
	MOVE.B	D0,D1
	MOVE.B	#$01,D0
	ROR.L	#1,D0
	SUBI.W	#$007F,D1
	BGE.S	L6
	MOVEQ	#0,D0
	BRA.S	L8
L6:
	CMPI.B	#$1E,D1
	BLE.S	L7
	ORI	#$02,CCR
	BRA.S	L8
L7:
	SUBI.B	#$1F,D1
	NEG.B	D1
	LSR.L	D1,D0
	TST.B	D2
	BNE.S	L8
	NEG.L	D0
L8:
	MOVE.L	(A7)+,D2
	RTS
  END);
 END Fix;

PROCEDURE Flt(x{0}: LONGINT): REAL; (*$ EntryExitCode:=FALSE *)
BEGIN
  ASSEMBLE(
	MOVE.L	D2,-(A7)
	MOVEQ	#0,D2
	TST.L	D0
	BEQ.S	L12
	BPL.S	L9
	NEG.L	D0
	MOVEQ	#-1,D2
L9:
	MOVE.W	#$009E,D1
	CMPI.L	#$0000FFFF,D0
	BHI.S	L10
	SWAP	D0
	SUBI.W	#$0010,D1
L10:
	CMPI.L	#$00FFFFFF,D0
	BHI.S	L11
	LSL.L	#8,D0
	SUBQ.W	#8,D1
L11:
	LSL.L	#1,D0
	DBCS	D1,L11
	MOVE.B	D1,D0
	ROR.L	#8,D0
	ADDQ.B	#1,D2      (* Set Carry according to register (-1/0) *)
	ROXR.L	#1,D0
L12:
	MOVE.L	(A7)+,D2
	RTS
  END);
END Flt;

PROCEDURE Tst(x{0}: REAL): LONGINT; (*$ EntryExitCode:=FALSE *)
BEGIN
  ASSEMBLE(
	MOVEQ	#0,D1
	BRA	Cmp
  END);
END Tst;

PROCEDURE Cmp(x{0}, y{1}: REAL): LONGINT; (*$ EntryExitCode:=FALSE *)
(* result is returned in the condition code register: N Z V *)
BEGIN (* braucht D2 *)
  ASSEMBLE(
	MOVE.L	D2,-(A7)
	MOVE.L	D0,D2
	BPL.S	L13
	EORI.L	#$7FFFFFFF,D0
L13:
	ANDI.L	#$7F800000,D2
	BNE.S	L14
	MOVEQ	#0,D0
L14:
	MOVE.L	D1,D2
	BPL.S	L15
	EORI.L	#$7FFFFFFF,D1
L15:
	ANDI.L	#$7F800000,D2
	BNE.S	L16
	MOVEQ	#0,D1
L16:
	CMP.L	D1,D0
	BGE.S	L17
	MOVEQ	#-1,D0
	BRA.S	L19
L17:
	BEQ.S	L18
	MOVEQ	#1,D0
	BRA.S	L19
L18:
	MOVEQ	#0,D0
L19:
	MOVE.L	(A7)+,D2
	RTS
  END);
END Cmp;

PROCEDURE Abs(x{0}: REAL): REAL; (*$ EntryExitCode:=FALSE *)
BEGIN
  ASSEMBLE(
	BCLR	#31,D0
	RTS
  END);
END Abs;

PROCEDURE Neg(x{0}: REAL): REAL; (*$ EntryExitCode:=FALSE *)
BEGIN
  ASSEMBLE(
	BCHG	#31,D0
	RTS
  END);
END Neg;

PROCEDURE Sub(x{0}, y{1}: REAL): REAL; (*$ EntryExitCode:=FALSE *)
BEGIN
  ASSEMBLE(
	BCHG	#31,D1 (* y:=-y; and go on with Add(x,y) *)
	BRA	Add
  END);
END Sub;

PROCEDURE Add(x{0}, y{1}: REAL): REAL; (*$ EntryExitCode:=FALSE *)
BEGIN
  ASSEMBLE(
(*$ IF m68881 *)
	FMOVE.S	D1,FP0
	FADD.S	D0,FP0
	FMOVE.S	FP0,D0
(*$ ELSE *)
	MOVEM.L	D3-D6,-(A7)
	ROL.L	#1,D0
	ROL.L	#1,D1
	MOVE.L	D0,D4
	SUB.L	D1,D4
	BCC.S	L20
	EXG	D0,D1
L20:
	MOVE.B	D0,D3
	ANDI.B	#$01,D3
	BTST	#0,D4
	BEQ.S	L21
	BSET	#1,D3
L21:
	ROL.L	#8,D0
	CLR.W	D5
	MOVE.B	D0,D5
	SNE	D0
	ROR.L	#1,D0
	CLR.B	D0
	ROL.L	#8,D1
	CLR.W	D6
	MOVE.B	D1,D6
	SNE	D1
	ROR.L	#1,D1
	CLR.B	D1
	MOVE.W	D5,D4
	SUB.W	D6,D4
	CMPI.W	#$0018,D4
	BHI.S	L25
	LSR.L	D4,D1
	BTST	#1,D3
	BNE.S	L23
	ADD.L	D1,D0
	BCC.S	L22
	ROXR.L	#1,D0
	ADDQ.W	#1,D5
L22:
	BRA.S	L25
L23:
	SUB.L	D1,D0
	BMI.S	L25
	BEQ.S	L25
	CMPI.L	#$0000FFFF,D0
	BHI.S	L24
	SUBI.W	#$0010,D5
	SWAP	D0
	BMI.S	L25
L24:
	SUBQ.W	#1,D5
	LSL.L	#1,D0
	BPL.S	L24
L25:
	ADDI.L	#$00000080,D0
	BCC.S	L26
	ROXR.L	#1,D0
	ADDQ.W	#1,D5
L26:
	CLR.B	D0
	TST.L	D0
	BNE.S	L27
	CLR.W	D5
L27:
	TST.W	D5
	BGT.S	L28
	MOVEQ	#0,D0
	BRA.S	L30
L28:
	CMPI.W	#$00FF,D5
	BLT.S	L29
	ORI	#$02,CCR
	BRA.S	L30
L29:
	LSL.L	#1,D0
	MOVE.B	D5,D0
	ROR.L	#8,D0
	ROXR.B	#1,D3
	ROXR.L	#1,D0
L30:
	MOVEM.L	(A7)+,D3-D6
(*$ ENDIF *)
	RTS
  END);
END Add;

PROCEDURE Mul(x{0}, y{1}: REAL): REAL; (*$ EntryExitCode:=FALSE *)
BEGIN (* braucht D4..D7 *)
  ASSEMBLE(
(*$ IF m68881 *)
	FMOVE.S	D1,FP0
	FMUL.S	D0,FP0
	FMOVE.S	FP0,D0
(*$ ELSE *)
	MOVEM.L	D4-D7,-(A7)
	MOVE.L	D0,D7
	EOR.L	D1,D7
	SWAP	D0
	MOVE.W	D0,D5
	ANDI.W	#$7F80,D5
	BEQ.S	L33
	LSR.W	#7,D5
	ANDI.W	#$007F,D0
	ORI.W	#$0080,D0
	SWAP	D1
	MOVE.W	D1,D7
	ANDI.W	#$7F80,D7
	BEQ.S	L33
	LSR.W	#7,D7
	ANDI.W	#$007F,D1
	ORI.W	#$0080,D1
	ADD.W	D7,D5
	SUBI.W	#$007E,D5
	BLT.S	L33
	MOVE.L	D0,D4
	SWAP	D4
	SWAP	D1
	MULU	D1,D4
	CLR.W	D4
	SWAP	D4
	MOVE.W	D0,D6
	MULU	D1,D6
	ADD.L	D6,D4
	MOVE.L	D0,D6
	SWAP	D6
	SWAP	D1
	MULU	D1,D6
	ADD.L	D6,D4
	MULU	D1,D0
	SWAP	D0
	ADD.L	D4,D0
	BMI.S	L31
	LSL.L	#1,D0
	SUBQ.W	#1,D5
L31:
	ADDI.L	#$00000080,D0
	BCC.S	L32
	ROXR.L	#1,D0
	ADDQ.W	#1,D5
L32:
	TST.W	D5
	BMI.S	L33
	CMPI.W	#$00FF,D5
	BLT.S	L34
	ORI	#$02,CCR
	BRA.S	L35
L33:
	MOVEQ	#0,D0
	BRA.S	L35
L34:
	LSL.L	#1,D0
	MOVE.B	D5,D0
	ROR.L	#8,D0
	ROXL.L	#1,D7
	ROXR.L	#1,D0
L35:
	MOVEM.L	(A7)+,D4-D7
(*$ ENDIF *)
	RTS
  END);
END Mul;

PROCEDURE Div(x{0}, y{1}: REAL): REAL; (*$ EntryExitCode:=FALSE *)
BEGIN (* braucht D4..D6 *)
  ASSEMBLE(
(*$ IF m68881 *)
	FMOVE.S	x,FP0
	FDIV.S	y,FP0
	FMOVE.S	FP0,D0
(*$ ELSE *)
	MOVEM.L	D4-D6,-(A7)
	MOVE.L	D0,D6
	EOR.L	D1,D6
	LSL.L	#1,D1
	ROL.L	#8,D1
	CLR.W	D6
	MOVE.B	D1,D6
	BNE.S	L36
	DIVU	D6,D6   (* Force a DIV by zero trap *)
L36:
	MOVE.B	#$01,D1
	ROR.L	#1,D1
	LSL.L	#1,D0
	ROL.L	#8,D0
	CLR.W	D5
	MOVE.B	D0,D5
	BEQ.S	L39
	MOVE.B	#$01,D0
	ROR.L	#1,D0
	SUB.W	D6,D5
	ADDI.W	#$007F,D5
	SWAP	D1
	LSR.L	#1,D0
	DIVU	D1,D0
	MOVE.W	D0,D4
	CLR.W	D0
	DIVU	D1,D0
	SWAP	D0
	MOVE.W	D4,D0
	MOVE.L	D1,D4
	SWAP	D4
	MULU	D0,D4
	LSR.L	#1,D4
	DIVU	D1,D4
	ANDI.L	#$0000FFFF,D4
	LSL.L	#1,D4
	SWAP	D0
	SUB.L	D4,D0
	BMI.S	L37
	LSL.L	#1,D0
	SUBQ.W	#1,D5
L37:
	ADDI.L	#$00000080,D0
	BCC.S	L38
	ROXR.L	#1,D0
	ADDQ.W	#1,D5
L38:
	TST.W	D5
	BMI.S	L39
	CMPI.W	#$00FF,D5
	BLT.S	L40
	ORI	#$02,CCR
	BRA.S	L41
L39:
	MOVEQ	#0,D0
	BRA.S	L41
L40:
	ROL.L	#1,D0
	MOVE.B	D5,D0
	ROR.L	#8,D0
	ROXL.L	#1,D6
	ROXR.L	#1,D0
L41:
	MOVEM.L	(A7)+,D4-D6
(*$ ENDIF *)
	RTS
  END);
END Div;

(*
PROCEDURE Floor(x{0}:REAL):REAL;
PROCEDURE Ceil(x{0}:REAL):REAL
*)

(*$ IF NOT m68881 *) (* sonst Init FPUExc! *)

(*$ EntryExitCode:=FALSE *) (* muß NICHTS initialisieren! *)
BEGIN
  ASSEMBLE(RTS END);
CLOSE
  ASSEMBLE(RTS END);

(*$ ENDIF *)
END MathREAL.mod