-- JaMMath.mesa
-- Written by: John Warnock, February 27, 1979
-- Last changed by Doug Wyatt, January 12, 1981  5:42 PM

DIRECTORY
	JaMMathDefs,
	JaMMasterDefs USING [Frame, Object],
	JaMControlDefs USING [GetCurrentFrame, NotifyCommand, NotifyStringObject],
	JaMExecDefs USING [JaMError],
	JaMFnsDefs USING [
		GetReal, PopBoolean, PopInteger, PushBoolean, PushInteger, PushReal],
	JaMStackDefs USING [Pop, Push],
	JaMStringDefs USING [StringCompare],
	InlineDefs 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,InlineDefs
EXPORTS JaMMathDefs =
BEGIN OPEN JaMStackDefs,JaMMasterDefs;

TypeError: PROCEDURE =
	BEGIN ERROR JaMExecDefs.JaMError[TypeChk,TRUE] END;
OverFlwChk: PUBLIC PROCEDURE =
	BEGIN ERROR JaMExecDefs.JaMError[OverFlow,TRUE] END;


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 => ERROR JaMExecDefs.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;
		o^_[lit,RealType[ri+rj]];
		END
	ELSE o^_[lit,LongIntegerType[i+j]];
	END;

AddR: PROCEDURE[i,j: REAL, o: POINTER TO Object] =
	BEGIN
	ri: REAL_i;
	rj: REAL_j;
	o^_[lit,RealType[ri+rj]];
	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;
		o^_[lit,RealType[ri-rj]];
		END
	ELSE o^_[lit,LongIntegerType[i-j]];
	END;

SubR: PROCEDURE[i,j: REAL, o: POINTER TO Object] =
	BEGIN
	ri: REAL_i;
	rj: REAL_j;
	o^_[lit,RealType[ri-rj]];
	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
	o^_[lit,RealType[i*j]];
	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
	IF j = 0 THEN OverFlwChk[];
	o^_[lit,RealType[i/j]];
	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[InlineDefs.BITNOT[PopInteger[]]];
	END;

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

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

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

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

TypeChk: StringType Object;
OverFlow: StringType Object;

StartMath: PROCEDURE =
	BEGIN OPEN JaMControlDefs;
	NotifyStringObject[@TypeChk, ".typechk"L];
	NotifyStringObject[@OverFlow, ".overflow"L];

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

-- Initialization
StartMath;

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
(600)\605b7B171b9B67b10B75b11B1483b14B195b1B1b3B731b6B732b5B725b5B580b4B430b5B106b4B106b5B146b4B142b4B140b6B766b1B1b8B766b11B769b3B84b3B131b2B130b3B129b6B99b6B150b5B149b6B150b8B162b7B21b8B22b9B