{File name LispFPTSubs.mc
Description:  DandeLion InterLisp Emulator Floating Point OpCodes
Author: Charnley
Last modified: Charnley                7-Aug-84 11:02:42
Created:    7-Aug-84 11:02:39
}

{	FloatIt
	Convert TOSH,,TOS to an unboxed floating point number in TOSH,,TOS
	can page fault getting data, will restore TOSH and TOS from uTOSH and uTOS
	will coerce smallp, smallneg, and Fixp to floating point
}

{	TIMINGS
	FloatP   8  1/3
	FixP(long: top 9 bits not the same)   21  1/3
	FixP(short: top 9 bits the same)   14  1/3
	Smallp   5  1/3
	Smallneg   5  1/3
}

{
	trashes Rx, L0, L1
	leaves TOSH LRot1 in TT (for fpt ucode)
	leaves Q with 0FF (for fpt ucode)
	returns thru L3
}

FloatIt:
	Ybus ← TOSH xor smallpl, ZeroBr,	c3;

CreateFPT:
	MAR ← Q ← [TOS, TOSH + 0], BRANCH[$, FLsmp],	c1;{not mem ref, byte merge}
	Ybus ← TOSH xor smallneg, ZeroBr, 	c2;
	Rx ← Q, rhRx ← crhTypeTable, BRANCH[$, FLsmn],	c3;

	Rx ← Rx LRot8,	c1;
	Rx ← Rx RShift1, getTypemsBit, 	c2;
	rhTT ← TOSH LRot0,	c3;

	MAR ← [rhRx, Rx + 0],	c1;
	Q ← 0FF,	c2;
	Q ← MD and Q, FloatNop,	c3;

	Ybus ← Q xor FloatpType, ZeroBr,	c1;
	Ybus ← Q xor FixpType, ZeroBr, BRANCH[GetXnonFpt, $],	c2;
	TT ← TOS, CANCELBR[$], FloatNop,	c3;

	Map ← [rhTT,TT], L0 ← L0.RedoCreate,	c1;
	Q ← 0FF, L1 ← L1.RestoreTosB2, 	c2;
	Rx ← rhRx ← MD, XRefBr,	c3;

	MAR ← [rhRx, TT + 0], BRANCH[FLptRemap, $],	c1, at[L0.RedoCreate, 10, RMapFixCallerB2];
	Q ← 0FF,	c2;
	TOSH ← MD,	c3;

	MAR ← [rhRx, TT + 1],	c1;
	TT ← LRot1 TOSH, CANCELBR[$, 2], L3Disp,	c2;
	TOS ← MD, RET[FloatItRet],	c3;

FLptRemap:
	CALL[RLMapFixB2],	c2;

GetXnonFpt:	{non-FloatType arg}
	TT ← TOS, FloatNop, BRANCH[ArgNotFixp, ArgIsFixp],	c3;

ArgNotFixp:
	GOTO[ufnZ2],	c1;

ArgIsFixp:
	Map ← [rhTT,TT], L0 ← L0.RedoFLFix,	c1;
	L1 ← L1.RestoreTosB2, 	c2;
	Rx ← rhRx ← MD, XRefBr,	c3;

	MAR ← [rhRx, TT + 0], BRANCH[FxptRemap, $],	c1, at[L0.RedoFLFix, 10, RMapFixCallerB2];
	,	c2;
	TOSH ← MD,	c3;

	MAR ← [rhRx, TT + 1],	c1;
	CANCELBR[$, 2],	c2;
	TOS ← MD, GOTO[ChipConvFixp],	c3;

FxptRemap:
	CALL[RLMapFixB2],	c2;

FLsmp:
	CANCELBR[$], FloatNop,	c2;
	ufloat ← 0, GOTO[ChipConvShort],	c3;

FLsmn:
	FloatNop,	c1;
	FloatNop,	c2;
	ufloat ← S xor ~S, GOTO[ChipConvShort],	c3;

ChipConvShort:
	FloatMode.RN.AI.FAST, FloatFLOW,	c1;
	FloatA ← ufloat, FLFloatA,	c2;
	FloatA ← TOS LRot0,	c3;

	FloatStartFlow,	c1;
	Noop,	c2;
	Noop,	c3;

	Q ← 0FF,	c1;
	FloatUnloadS, Float.M,	c2;
	FloatUnloadS, Float.L,	c3;

	TOSH ← FloatResult,	c1;
	TOS ← FloatResult, L3Disp,	c2;
	TT ← LRot1 TOSH, RET[FloatItRet],	c3;

ChipConvFixp:
	Q ← 80,	c1;
	Ybus ← TOSH - Q, CarryBr,	c2;
	Ybus ← TOSH + Q, CarryBr, BRANCH[IsShortp, $],	c3;

	Ybus ← TOSH, NegBr, BRANCH[IsNotShort, IsShortn],	c1;

IsShortp:
	CANCELBR[$],	c1;
IsShortn:
	CANCELBR[$], ufloat ← TOSH,	c2;
	GOTO[ChipConvShort],	c3;

IsNotShort:
	Q ← 8, BRANCH[itispos, itisneg],	c2;{Q ← 100}

itispos:	ufloat ← 0, GOTO[ChipConvLong],	c3;
itisneg:	ufloat ← S xor ~S, GOTO[ChipConvLong],	c3;

ChipConvLong:
	FloatMode.RN.AI.FAST, FloatPIPE,	c1;
	FloatAB ← ufloat, FLFloatA,	c2;
	FloatAB ← TOS LRot0,	c3;{has unload side effect}

	FloatPump,	c1;
	FloatPump,	c2;
	FloatA ← ufloat, FLFloatA,	c3;

	FloatA ← TOSH LRot0,	c1;
	FloatPump,	c2;
	FloatPump,	c3;

	FloatUnloadS, Float.M, FloatPump,	c1;
	FloatUnloadS, Float.L, FloatPump,	c2;
	FloatAB ← FloatResult,	c3;

	FloatAB ← FloatResult,	c1;
	FloatUnloadS, Float.M, FloatPump,	c2;
	FloatUnloadS, Float.L, FloatPump,	c3;

	Rx ← Q,	c1;
	Rx ← Rx LRot8,	c2;
	Q ← Rx,	c3;

	Rx ← FloatResult, FloatPump,	c1;
	TT ← FloatResult, FloatPump,	c2;
	Rx ← Rx + Q,	c3;

	Q ← 0FF,	c1;
	ufloatplus ← Rx,	c2;
	FloatA ← ufloatplus, FLPlus,	c3;

	FloatA ← TT LRot0,	c1;
	FloatPump,	c2;
	FloatPump,	c3;

	FloatPump,	c1;
	FloatPump,	c2;
	FloatPump,	c3;

	FloatPump,	c1;
	FloatPump, FloatUnloadS, Float.M,	c2;
	FloatPump, FloatUnloadS, Float.L,	c3;

	TOSH ← FloatResult,	c1;
	TOS ← FloatResult, L3Disp,	c2;
	TT ← LRot1 TOSH, RET[FloatItRet],	c3;

	{ E N D }