-- JaMMath.mesa
-- Written by: John Warnock, February 27, 1979
-- Last changed by Doug Wyatt, February 10, 1981  5:51 PM
-- Last changed by Doug Brotz, June 5, 1981  2:00 PM

DIRECTORY
	JaMMathDefs,
	JaMMasterDefs USING [Frame, Object],
	JaMControlDefs USING [GetCurrentFrame, RegisterCommand],
	JaMExecDefs USING [JaMError, overflow, typechk],
	JaMFnsDefs USING [
		GetReal, PopBoolean, PopInteger, PushBoolean, PushInteger, PushReal],
	JaMStackDefs USING [Pop, Push],
	JaMStringDefs USING [StringCompare],
	Inline USING [BITAND, BITNOT, BITOR, BITSHIFT, BITXOR],
	Real USING [Fix, RealException],
	RealFns USING [ArcTanDeg, CosDeg, Log, Power, SinDeg];

JaMMath: PROGRAM
IMPORTS JaMFnsDefs,JaMControlDefs,JaMStringDefs,JaMExecDefs,JaMStackDefs,
	RealFns,Real,Inline
EXPORTS JaMMathDefs =
BEGIN OPEN JaMStackDefs,JaMMasterDefs;

TypeError: PROCEDURE =
	{ OPEN JaMExecDefs; ERROR JaMError[typechk,TRUE] };
OverFlwChk: PROCEDURE =
	{ OPEN JaMExecDefs; ERROR JaMError[overflow,TRUE] };

MixedMode: PUBLIC PROCEDURE[ob1,ob2: POINTER TO Object,
	PInt: PROCEDURE[i,j: INTEGER, o: POINTER TO Object],
	PLongInt: PROCEDURE[i,j: LONG INTEGER, o: POINTER TO Object],
	PReal: PROCEDURE[i,j: REAL, o: POINTER TO Object]] 
	RETURNS[rs: Object] = {
	ENABLE Real.RealException =>
		{ OPEN JaMExecDefs; ERROR JaMError[overflow,TRUE] };
	rsptr: POINTER TO Object_@rs;
	WITH dob1: ob1^ SELECT FROM
		IntegerType => WITH dob2: ob2^ SELECT FROM
			IntegerType =>
				PInt[dob1.IntegerVal,dob2.IntegerVal, rsptr];
			LongIntegerType	=>
				BEGIN
				li: LONG INTEGER_dob1.IntegerVal;
				PLongInt[li,dob2.LongIntegerVal, rsptr];
				END;
			RealType =>
				BEGIN
				r: REAL_dob1.IntegerVal;
				PReal[r,dob2.RealVal, rsptr];
				END;
			ENDCASE => TypeError[];
		LongIntegerType	=> WITH dob2: ob2^ SELECT FROM
			IntegerType =>
				BEGIN
				li: LONG INTEGER_dob2.IntegerVal;
				PLongInt[dob1.LongIntegerVal,li, rsptr];
				END;
			LongIntegerType	=>
				PLongInt[dob1.LongIntegerVal,dob2.LongIntegerVal, rsptr];
			RealType =>
				BEGIN
				r: REAL_dob1.LongIntegerVal;
				PReal[r,dob2.RealVal, rsptr];
				END;
			ENDCASE => TypeError[];
		RealType => WITH dob2: ob2^ SELECT FROM
			IntegerType =>
				BEGIN
				r: REAL_dob2.IntegerVal;
				PReal[dob1.RealVal,r, rsptr];
				END;
			LongIntegerType	=>
				BEGIN
				r: REAL_dob2.LongIntegerVal;
				PReal[dob1.RealVal,r, rsptr];
				END;
			RealType =>
				PReal[dob1.RealVal,dob2.RealVal, rsptr];
			ENDCASE => TypeError[];
		ENDCASE => TypeError[];
	};

LOverflowChk: PUBLIC PROCEDURE[i,j: LONG INTEGER] RETURNS[BOOLEAN] =
	BEGIN
	--RETURN[IF((i<0)=(j<0)) THEN IF((i+j)<0)=(i<0) THEN FALSE ELSE TRUE ELSE FALSE];
	RETURN[(i<0)=(j<0) AND ((i+j)<0)#(i<0)];
	END;


Add: PUBLIC PROCEDURE =
	BEGIN
	frame: Frame_JaMControlDefs.GetCurrentFrame[];
	ob2: Object_Pop[frame.opstk];
	ob1: Object_Pop[frame.opstk];
	Push[MixedMode[@ob1,@ob2,AddI,AddLI,AddR],frame.opstk];
	END;

AddI: PROCEDURE[i,j: INTEGER, o: POINTER TO Object] =
	BEGIN
	l: LONG INTEGER_LONG[i] + LONG[j];
	IF l > 32767 OR l < -LONG[32768] THEN o^_[lit,LongIntegerType[l]]
	ELSE o^_[lit,IntegerType[i+j]];
	END;

AddLI: PROCEDURE[i,j: LONG INTEGER, o: POINTER TO Object] =
	BEGIN
	IF LOverflowChk[i,j] THEN
		BEGIN
		ri: REAL_i;
		rj: REAL_j;
		rsum: REAL _ ri + rj;
		o^_[lit,RealType[rsum]];
		END
	ELSE o^_[lit,LongIntegerType[i+j]];
	END;

AddR: PROCEDURE[i,j: REAL, o: POINTER TO Object] =
	BEGIN
	ri: REAL_i;
	rj: REAL_j;
	rsum: REAL _ ri + rj;
	o^_[lit,RealType[rsum]];
	END;



Sub: PUBLIC PROCEDURE =
	BEGIN
	frame: Frame_JaMControlDefs.GetCurrentFrame[];
	ob2: Object_Pop[frame.opstk];
	ob1: Object_Pop[frame.opstk];
	Push[MixedMode[@ob1,@ob2,SubI,SubLI,SubR],frame.opstk];
	END;

SubI: PROCEDURE[i,j: INTEGER, o: POINTER TO Object] =
	BEGIN
	l: LONG INTEGER_LONG[i] - LONG[j];
	IF l > 32767 OR l < -LONG[32768] THEN o^_[lit,LongIntegerType[l]]
	ELSE o^_[lit,IntegerType[i-j]];
	END;

SubLI: PROCEDURE[i,j: LONG INTEGER, o: POINTER TO Object] =
	BEGIN
	IF LOverflowChk[i,-j] THEN
		BEGIN
		ri: REAL_i;
		rj: REAL_j;
		rdif: REAL _ ri - rj;
		o^_[lit,RealType[rdif]];
		END
	ELSE o^_[lit,LongIntegerType[i-j]];
	END;

SubR: PROCEDURE[i,j: REAL, o: POINTER TO Object] =
	BEGIN
	ri: REAL_i;
	rj: REAL_j;
	rdif: REAL _ ri - rj;
	o^_[lit,RealType[rdif]];
	END;


Mul: PUBLIC PROCEDURE =
	BEGIN
	frame: Frame_JaMControlDefs.GetCurrentFrame[];
	ob2: Object_Pop[frame.opstk];
	ob1: Object_Pop[frame.opstk];
	Push[MixedMode[@ob1,@ob2,MulI,MulLI,MulR],frame.opstk];
	END;

MulI: PROCEDURE[i,j: INTEGER, o: POINTER TO Object] =
	BEGIN
	l: LONG INTEGER_LONG[i] * LONG[j];
	IF l > 32767 OR l < -LONG[32768] THEN o^_[lit,LongIntegerType[l]]
	ELSE o^_[lit,IntegerType[i*j]];
	END;

MulLI: PROCEDURE[i,j: LONG INTEGER, o: POINTER TO Object] =
	BEGIN
	ri: REAL_i;
	rj: REAL_j;
	r: REAL_ri * rj;
	IF r > 17777777777B OR r < 20000000000B THEN o^_[lit,RealType[r]]
	ELSE o^_[lit,LongIntegerType[Real.Fix[r]]];
	END;

MulR: PROCEDURE[i,j: REAL, o: POINTER TO Object] =
	BEGIN
	rprod: REAL _ i*j;
	o^_[lit,RealType[rprod]];
	END;


Div: PUBLIC PROCEDURE =
	BEGIN
	frame: Frame_JaMControlDefs.GetCurrentFrame[];
	ob2: Object_Pop[frame.opstk];
	ob1: Object_Pop[frame.opstk];
	Push[MixedMode[@ob1,@ob2,DivI,DivLI,DivR],frame.opstk];
	END;

DivI: PROCEDURE[i,j: INTEGER, o: POINTER TO Object] =
	BEGIN
	IF j = 0 THEN OverFlwChk[];
	o^_[lit,IntegerType[i/j]];
	END;

DivLI: PROCEDURE[i,j: LONG INTEGER, o: POINTER TO Object] =
	BEGIN
	IF j = 0 THEN OverFlwChk[];
	o^_[lit,LongIntegerType[i/j]];
	END;

DivR: PROCEDURE[i,j: REAL, o: POINTER TO Object] =
	BEGIN
	rquot: REAL;
	IF j = 0 THEN OverFlwChk[];
	rquot _ i/j;
	o^_[lit,RealType[rquot]];
	END;

Neg: PUBLIC PROCEDURE =
	BEGIN OPEN JaMFnsDefs;
	frame: Frame_JaMControlDefs.GetCurrentFrame[];
	ob: Object_Pop[frame.opstk];
	WITH dob: ob SELECT FROM
		IntegerType =>
			BEGIN
			i: INTEGER_dob.IntegerVal;
			PushInteger[-i];
			END;
		LongIntegerType =>
			BEGIN
			l: LONG INTEGER_dob.LongIntegerVal;
			PushReal[-l];
			END;
		RealType =>
			BEGIN
			r: REAL_dob.RealVal;
			PushReal[-r];
			END;
		ENDCASE => TypeError[];
	END;

Sin: PUBLIC PROCEDURE =
	BEGIN
	r: REAL_JaMFnsDefs.GetReal[];
	JaMFnsDefs.PushReal[RealFns.SinDeg[r]];
	END;

Cos: PUBLIC PROCEDURE =
	BEGIN
	r: REAL_JaMFnsDefs.GetReal[];
	JaMFnsDefs.PushReal[RealFns.CosDeg[r]];
	END;

ATan: PUBLIC PROCEDURE =
	BEGIN
	r1: REAL_JaMFnsDefs.GetReal[];
	r2: REAL_JaMFnsDefs.GetReal[];
	JaMFnsDefs.PushReal[RealFns.ArcTanDeg[r2,r1]];
	END;

Exp: PUBLIC PROCEDURE =
	BEGIN
	r1: REAL_JaMFnsDefs.GetReal[];
	r2: REAL_JaMFnsDefs.GetReal[];
	JaMFnsDefs.PushReal[RealFns.Power[r2,r1]];
	END;

Log: PUBLIC PROCEDURE =
	BEGIN
	r1: REAL_JaMFnsDefs.GetReal[];
	r2: REAL_JaMFnsDefs.GetReal[];
	JaMFnsDefs.PushReal[RealFns.Log[r2,r1]];
	END;

Equal: PUBLIC PROCEDURE =
	BEGIN
	frame: Frame_JaMControlDefs.GetCurrentFrame[];
	ob2: Object_Pop[frame.opstk];
	ob1: Object_Pop[frame.opstk];
	WITH sob1: ob1 SELECT FROM
		StringType => WITH sob2: ob2 SELECT FROM
			StringType =>
				BEGIN
				eq: BOOLEAN_JaMStringDefs.StringCompare[sob1,sob2] =equal;
				JaMFnsDefs.PushBoolean[eq];
				END;
			ENDCASE => TypeError[];
		ENDCASE	=> Push[MixedMode[@ob1,@ob2,EqI,EqLI,EqR],frame.opstk];
	END;

EqI: PROCEDURE[i,j: INTEGER, o: POINTER TO Object] =
	BEGIN
	o^_[lit,BooleanType[BooleanVal:i = j]];
	END;

EqLI: PROCEDURE[i,j: LONG INTEGER, o: POINTER TO Object] =
	BEGIN
	o^_[lit,BooleanType[BooleanVal:i = j]];
	END;

EqR: PROCEDURE[i,j: REAL, o: POINTER TO Object] =
	BEGIN
	o^_[lit,BooleanType[BooleanVal:i = j]];
	END;


LessThan: PUBLIC PROCEDURE =
	BEGIN
	frame: Frame_JaMControlDefs.GetCurrentFrame[];
	ob2: Object_Pop[frame.opstk];
	ob1: Object_Pop[frame.opstk];
	WITH sob1: ob1 SELECT FROM
		StringType => WITH sob2: ob2 SELECT FROM
			StringType =>
				BEGIN
				ls: BOOLEAN_JaMStringDefs.StringCompare[sob1,sob2]=less;
				JaMFnsDefs.PushBoolean[ls];
				END;
			ENDCASE => TypeError[];
		ENDCASE	=> Push[MixedMode[@ob1,@ob2,LtI,LtLI,LtR],frame.opstk];
	END;

LtI: PROCEDURE[i,j: INTEGER, o: POINTER TO Object] =
	BEGIN
	o^_[lit,BooleanType[BooleanVal:i < j]];
	END;

LtLI: PROCEDURE[i,j: LONG INTEGER, o: POINTER TO Object] =
	BEGIN
	o^_[lit,BooleanType[BooleanVal:i < j]];
	END;

LtR: PROCEDURE[i,j: REAL, o: POINTER TO Object] =
	BEGIN
	o^_[lit,BooleanType[BooleanVal:i < j]];
	END;


GreaterThan: PUBLIC PROCEDURE =
	BEGIN
	frame: Frame_JaMControlDefs.GetCurrentFrame[];
	ob2: Object_Pop[frame.opstk];
	ob1: Object_Pop[frame.opstk];
	WITH sob1: ob1 SELECT FROM
		StringType => WITH sob2: ob2 SELECT FROM
			StringType =>
				BEGIN
				gr: BOOLEAN_JaMStringDefs.StringCompare[sob1,sob2]=greater;
				JaMFnsDefs.PushBoolean[gr];
				END;
			ENDCASE => TypeError[];
		ENDCASE	=> Push[MixedMode[@ob1,@ob2,GtI,GtLI,GtR],frame.opstk];
	END;

GtI: PROCEDURE[i,j: INTEGER, o: POINTER TO Object] =
	BEGIN
	o^_[lit,BooleanType[BooleanVal:i > j]];
	END;

GtLI: PROCEDURE[i,j: LONG INTEGER, o: POINTER TO Object] =
	BEGIN
	o^_[lit,BooleanType[BooleanVal:i > j]];
	END;

GtR: PROCEDURE[i,j: REAL, o: POINTER TO Object] =
	BEGIN
	o^_[lit,BooleanType[BooleanVal:i > j]];
	END;


Not: PUBLIC PROCEDURE =
	BEGIN OPEN JaMFnsDefs;
	PushBoolean[NOT PopBoolean[]];
	END;

And: PUBLIC PROCEDURE =
	BEGIN OPEN JaMFnsDefs;
	b1: BOOLEAN_PopBoolean[];
	b2: BOOLEAN_PopBoolean[];
	PushBoolean[b2 AND b1];
	END;

Or: PUBLIC PROCEDURE =
	BEGIN OPEN JaMFnsDefs;
	b1: BOOLEAN_PopBoolean[];
	b2: BOOLEAN_PopBoolean[];
	PushBoolean[b2 OR b1];
	END;

Xor: PUBLIC PROCEDURE =
	BEGIN OPEN JaMFnsDefs;
	b1: BOOLEAN_PopBoolean[];
	b2: BOOLEAN_PopBoolean[];
	PushBoolean[b1 # b2];
	END;

BitNot: PUBLIC PROCEDURE =
	BEGIN OPEN JaMFnsDefs;
	PushInteger[Inline.BITNOT[PopInteger[]]];
	END;

BitAnd: PUBLIC PROCEDURE =
	BEGIN OPEN JaMFnsDefs;
	i1: INTEGER = PopInteger[];
	i2: INTEGER = PopInteger[];
	PushInteger[Inline.BITAND[i1,i2]];
	END;

BitOr: PUBLIC PROCEDURE =
	BEGIN OPEN JaMFnsDefs;
	i1: INTEGER = PopInteger[];
	i2: INTEGER = PopInteger[];
	PushInteger[Inline.BITOR[i1,i2]];
	END;

BitXor: PUBLIC PROCEDURE =
	BEGIN OPEN JaMFnsDefs;
	i1: INTEGER = PopInteger[];
	i2: INTEGER = PopInteger[];
	PushInteger[Inline.BITXOR[i1,i2]];
	END;

BitShift: PUBLIC PROCEDURE =
	BEGIN OPEN JaMFnsDefs;
	shift: INTEGER = PopInteger[];
	word: INTEGER = PopInteger[];
	PushInteger[Inline.BITSHIFT[word,shift]];
	END;

-- Initialization

STOP;

{ OPEN JaMControlDefs;
-- Math commands
RegisterCommand[".add"L,Add];
RegisterCommand[".sub"L,Sub];
RegisterCommand[".mul"L,Mul];
RegisterCommand[".div"L,Div];
RegisterCommand[".neg"L,Neg];
RegisterCommand[".sin"L,Sin];
RegisterCommand[".cos"L,Cos];
RegisterCommand[".atan"L,ATan];
RegisterCommand[".exp"L,Exp];
RegisterCommand[".log"L,Log];
RegisterCommand[".eq"L,Equal];
RegisterCommand[".lt"L,LessThan];
RegisterCommand[".gt"L,GreaterThan];
RegisterCommand[".not"L,Not];
RegisterCommand[".and"L,And];
RegisterCommand[".or"L,Or];
RegisterCommand[".xor"L,Xor];
RegisterCommand[".bitnot"L,BitNot];
RegisterCommand[".bitand"L,BitAnd];
RegisterCommand[".bitor"L,BitOr];
RegisterCommand[".bitxor"L,BitXor];
RegisterCommand[".bitshift"L,BitShift];
};

END.

DKW  March 28, 1980  4:55 PM
	added StartMath

DKW  April 1, 1980  3:48 PM
	now uses NotifyCommand, NotifyStringObject

DKW  May 31, 1980  1:05 AM
	updated for Mesa6

DKW  July 14, 1980  11:19 PM
	FloatFns => RealFns

DKW  January 12, 1981  5:42 PM
	MixedMode catches RealException

DKW  February 10, 1981  5:51 PM
	imports errors from JaMExecDefs; initializes after STOP

DKB  June 5, 1981  2:00 PM
	Work around REAL expression in constructor bug in Mesa 6.1 compiler.
(670)