-- JaMMath.mesa
-- Written by: John Warnock, February 27, 1979
-- Last changed by Doug Wyatt, February 10, 1981 5:51 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;
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[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