JaMMathImpl.mesa
Original version by John Warnock, February 27, 1979
Bill Paxton, December 19, 1980 9:35 AM
Doug Wyatt, 7-Nov-81 14:15:57
McGregor, September 10, 1982 11:17 am
Russ Atkinson, July 22, 1983 6:29 pm
DIRECTORY
Basics USING [BITAND, BITNOT, BITOR, BITSHIFT, BITXOR, LongNumber],
JaMBasic USING [Object],
JaMInternal USING [Frame],
JaMOps
USING
[Bug, Compare, Error, Install, InstallReason, MakeName, Pop, PopBoolean, PopInteger, PopReal, Push, PushBoolean, PushInteger, PushReal, rangechk, RegisterExplicit, StringCompare, typechk],
Real USING [FAdd, FDiv, Fix, Float, FMul, FSub, RealException],
RealFns USING [ArcTanDeg, CosDeg, Log, Power, SinDeg, SqRt];
JaMMathImpl:
PROGRAM
IMPORTS JaMOps, Basics, Real, RealFns = {
OPEN JaMOps, JaMInternal, JaMBasic;
Globals
overflow: name Object;
Math operations
Add:
PUBLIC
PROC[a,b: Object]
RETURNS[Object] = {
ENABLE Real.RealException => CHECKED {GOTO Overflow};
WITH a:a
SELECT
FROM
integer =>
WITH b:b
SELECT
FROM
integer => { i,j,k:
LONG
INTEGER;
i ← a.ivalue; j ← b.ivalue; k ← i + j;
IF (i<0)#(j<0) OR (i<0)=(k<0) THEN RETURN[[L,integer[k]]]
ELSE RETURN[[L,real[Real.FAdd[i,j]]]] };
real => RETURN[[L,real[Real.FAdd[a.ivalue,b.rvalue]]]];
ENDCASE;
real =>
WITH b:b
SELECT
FROM
integer => RETURN[[L,real[Real.FAdd[a.rvalue,b.ivalue]]]];
real => RETURN[[L,real[Real.FAdd[a.rvalue,b.rvalue]]]];
ENDCASE;
ENDCASE;
ERROR Error[typechk];
EXITS Overflow => ERROR Error[overflow];
};
Sub:
PUBLIC
PROC[a,b: Object]
RETURNS[Object] = {
ENABLE Real.RealException => CHECKED {GOTO Overflow};
WITH a:a
SELECT
FROM
integer =>
WITH b:b
SELECT
FROM
integer => { i,j,k:
LONG
INTEGER;
i ← a.ivalue; j ← b.ivalue; k ← i - j;
IF (i<0)=(j<0) OR (i<0)=(k<0) THEN RETURN[[L,integer[k]]]
ELSE RETURN[[L,real[Real.FSub[i,j]]]] };
real => RETURN[[L,real[Real.FSub[a.ivalue,b.rvalue]]]];
ENDCASE;
real =>
WITH b:b
SELECT
FROM
integer => RETURN[[L,real[Real.FSub[a.rvalue,b.ivalue]]]];
real => RETURN[[L,real[Real.FSub[a.rvalue,b.rvalue]]]];
ENDCASE;
ENDCASE;
ERROR Error[typechk];
EXITS Overflow => ERROR Error[overflow];
};
Mul:
PUBLIC
PROC[a,b: Object]
RETURNS[Object] = {
ENABLE Real.RealException => CHECKED {GOTO Overflow};
WITH a:a
SELECT
FROM
integer =>
WITH b:b
SELECT
FROM
integer => {
r: REAL ← Real.FMul[a.ivalue,b.ivalue];
lowest: REAL = FIRST[INT];
highest: REAL = LAST[INT];
IF r
IN [lowest..highest]
THEN RETURN[[L,integer[Real.Fix[r]]]]
ELSE RETURN[[L,real[r]]];
};
real => RETURN[[L,real[Real.FMul[a.ivalue,b.rvalue]]]];
ENDCASE;
real =>
WITH b:b
SELECT
FROM
integer => RETURN[[L,real[Real.FMul[a.rvalue,b.ivalue]]]];
real => RETURN[[L,real[Real.FMul[a.rvalue,b.rvalue]]]];
ENDCASE;
ENDCASE;
ERROR Error[typechk];
EXITS Overflow => ERROR Error[overflow];
};
Div:
PUBLIC
PROC[a,b: Object]
RETURNS[Object] = {
ENABLE Real.RealException => CHECKED {GOTO Overflow};
WITH a:a
SELECT
FROM
integer =>
WITH b:b
SELECT
FROM
integer =>
IF b.ivalue=0
THEN
GOTO Overflow
ELSE RETURN[[L,integer[a.ivalue/b.ivalue]]];
real => RETURN[[L,real[Real.FDiv[a.ivalue,b.rvalue]]]];
ENDCASE;
real =>
WITH b:b
SELECT
FROM
integer => RETURN[[L,real[Real.FDiv[a.rvalue,b.ivalue]]]];
real => RETURN[[L,real[Real.FDiv[a.rvalue,b.rvalue]]]];
ENDCASE;
ENDCASE;
ERROR Error[typechk];
EXITS Overflow => ERROR Error[overflow];
};
IDiv:
PUBLIC
PROC[a,b: Object]
RETURNS[Object] = {
WITH a:a
SELECT
FROM
integer =>
WITH b:b
SELECT
FROM
integer =>
IF b.ivalue=0
THEN
ERROR Error[overflow]
ELSE RETURN[[L,integer[a.ivalue/b.ivalue]]];
ENDCASE;
ENDCASE;
ERROR Error[typechk];
};
RDiv:
PUBLIC
PROC[a,b: Object]
RETURNS[Object] = {
ENABLE Real.RealException => CHECKED {GOTO Overflow};
WITH a:a
SELECT
FROM
integer =>
WITH b:b
SELECT
FROM
integer => RETURN[[L,real[Real.FDiv[a.ivalue,b.ivalue]]]];
real => RETURN[[L,real[Real.FDiv[a.ivalue,b.rvalue]]]];
ENDCASE;
real =>
WITH b:b
SELECT
FROM
integer => RETURN[[L,real[Real.FDiv[a.rvalue,b.ivalue]]]];
real => RETURN[[L,real[Real.FDiv[a.rvalue,b.rvalue]]]];
ENDCASE;
ENDCASE;
ERROR Error[typechk];
EXITS Overflow => ERROR Error[overflow];
};
Neg:
PUBLIC
PROC[a: Object]
RETURNS[Object] = {
ENABLE Real.RealException => CHECKED {GOTO Overflow};
WITH a:a
SELECT
FROM
integer =>
IF a.ivalue#
FIRST[
LONG
INTEGER]
THEN RETURN[[L,integer[-a.ivalue]]]
ELSE RETURN[[L,real[-Real.Float[a.ivalue]]]];
real => RETURN[[L,real[-a.rvalue]]];
ENDCASE;
ERROR Error[typechk];
EXITS Overflow => ERROR Error[overflow];
};
Eq:
PUBLIC
PROC[a,b: Object]
RETURNS[
BOOLEAN] = {
SELECT Compare[a,b]
FROM
F => RETURN[FALSE];
T => RETURN[TRUE];
nil => ERROR Error[typechk];
ENDCASE => ERROR Bug;
};
Lt:
PUBLIC
PROC[a,b: Object]
RETURNS[
BOOLEAN] = {
WITH a:a
SELECT
FROM
integer =>
WITH b:b
SELECT
FROM
integer => RETURN[a.ivalue<b.ivalue];
real => RETURN[a.ivalue<b.rvalue];
ENDCASE;
real =>
WITH b:b
SELECT
FROM
integer => RETURN[a.rvalue<b.ivalue];
real => RETURN[a.rvalue<b.rvalue];
ENDCASE;
string =>
WITH b:b
SELECT
FROM
string => RETURN[StringCompare[a,b]<0];
ENDCASE;
ENDCASE;
ERROR Error[typechk];
};
Gt:
PUBLIC
PROC[a,b: Object]
RETURNS[
BOOLEAN] = {
WITH a:a
SELECT
FROM
integer =>
WITH b:b
SELECT
FROM
integer => RETURN[a.ivalue>b.ivalue];
real => RETURN[a.ivalue>b.rvalue];
ENDCASE;
real =>
WITH b:b
SELECT
FROM
integer => RETURN[a.rvalue>b.ivalue];
real => RETURN[a.rvalue>b.rvalue];
ENDCASE;
string =>
WITH b:b
SELECT
FROM
string => RETURN[StringCompare[a,b]>0];
ENDCASE;
ENDCASE;
ERROR Error[typechk];
};
Intrinsics
JAdd:
PUBLIC
PROC[frame: Frame] = {
b: Object ← Pop[frame.opstk];
a: Object ← Pop[frame.opstk];
Push[frame.opstk,Add[a,b]];
};
JSub:
PUBLIC
PROC[frame: Frame] = {
b: Object ← Pop[frame.opstk];
a: Object ← Pop[frame.opstk];
Push[frame.opstk,Sub[a,b]];
};
JMul:
PUBLIC
PROC[frame: Frame] = {
b: Object ← Pop[frame.opstk];
a: Object ← Pop[frame.opstk];
Push[frame.opstk,Mul[a,b]];
};
JDiv:
PUBLIC
PROC[frame: Frame] = {
b: Object ← Pop[frame.opstk];
a: Object ← Pop[frame.opstk];
Push[frame.opstk,Div[a,b]];
};
JIDiv:
PUBLIC
PROC[frame: Frame] = {
b: Object ← Pop[frame.opstk];
a: Object ← Pop[frame.opstk];
Push[frame.opstk,IDiv[a,b]];
};
JRDiv:
PUBLIC
PROC[frame: Frame] = {
b: Object ← Pop[frame.opstk];
a: Object ← Pop[frame.opstk];
Push[frame.opstk,RDiv[a,b]];
};
JNeg:
PUBLIC
PROC[frame: Frame] = {
a: Object ← Pop[frame.opstk];
Push[frame.opstk,Neg[a]];
};
JSin:
PUBLIC
PROC[frame: Frame] = {
a: REAL ← PopReal[frame.opstk];
PushReal[frame.opstk,RealFns.SinDeg[a]];
};
JCos:
PUBLIC
PROC[frame: Frame] = {
a: REAL ← PopReal[frame.opstk];
PushReal[frame.opstk,RealFns.CosDeg[a]];
};
JATan:
PUBLIC
PROC[frame: Frame] = {
b: REAL ← PopReal[frame.opstk];
a: REAL ← PopReal[frame.opstk];
PushReal[frame.opstk,RealFns.ArcTanDeg[a,b]];
};
JExp:
PUBLIC
PROC[frame: Frame] = {
ENABLE Real.RealException => CHECKED {GOTO Overflow};
b: REAL ← PopReal[frame.opstk];
a: REAL ← PopReal[frame.opstk];
PushReal[frame.opstk,RealFns.Power[a,b]];
EXITS Overflow => ERROR Error[overflow];
};
JLog:
PUBLIC
PROC[frame: Frame] = {
b: REAL ← PopReal[frame.opstk];
a: REAL ← PopReal[frame.opstk];
IF a>0 AND b>0 THEN PushReal[frame.opstk,RealFns.Log[a,b]]
ELSE ERROR Error[rangechk];
};
JSqRt:
PUBLIC
PROC[frame: Frame] = {
a: REAL ← PopReal[frame.opstk];
IF a>=0 THEN PushReal[frame.opstk,RealFns.SqRt[a]]
ELSE ERROR Error[rangechk];
};
JEq:
PUBLIC
PROC[frame: Frame] = {
b: Object ← Pop[frame.opstk];
a: Object ← Pop[frame.opstk];
PushBoolean[frame.opstk,Eq[a,b]];
};
JLt:
PUBLIC
PROC[frame: Frame] = {
b: Object ← Pop[frame.opstk];
a: Object ← Pop[frame.opstk];
PushBoolean[frame.opstk,Lt[a,b]];
};
JGt:
PUBLIC
PROC[frame: Frame] = {
b: Object ← Pop[frame.opstk];
a: Object ← Pop[frame.opstk];
PushBoolean[frame.opstk,Gt[a,b]];
};
JNot:
PUBLIC
PROC[frame: Frame] = {
a: BOOLEAN ← PopBoolean[frame.opstk];
PushBoolean[frame.opstk,NOT a];
};
JAnd:
PUBLIC
PROC[frame: Frame] = {
b: BOOLEAN ← PopBoolean[frame.opstk];
a: BOOLEAN ← PopBoolean[frame.opstk];
PushBoolean[frame.opstk,a AND b];
};
JOr:
PUBLIC
PROC[frame: Frame] = {
b: BOOLEAN ← PopBoolean[frame.opstk];
a: BOOLEAN ← PopBoolean[frame.opstk];
PushBoolean[frame.opstk,a OR b];
};
JXor:
PUBLIC
PROC[frame: Frame] = {
b: BOOLEAN ← PopBoolean[frame.opstk];
a: BOOLEAN ← PopBoolean[frame.opstk];
PushBoolean[frame.opstk,a # b];
};
JBitNot:
PUBLIC
PROC[frame: Frame] = {
a,r: Basics.LongNumber;
a.li ← PopInteger[frame.opstk];
r.lowbits ← Basics.BITNOT[a.lowbits];
r.highbits ← Basics.BITNOT[a.highbits];
PushInteger[frame.opstk,r.li];
};
JBitAnd:
PUBLIC
PROC[frame: Frame] = {
a,b,r: Basics.LongNumber;
b.li ← PopInteger[frame.opstk];
a.li ← PopInteger[frame.opstk];
r.lowbits ← Basics.BITAND[a.lowbits,b.lowbits];
r.highbits ← Basics.BITAND[a.highbits,b.highbits];
PushInteger[frame.opstk,r.li];
};
JBitOr:
PUBLIC
PROC[frame: Frame] = {
a,b,r: Basics.LongNumber;
b.li ← PopInteger[frame.opstk];
a.li ← PopInteger[frame.opstk];
r.lowbits ← Basics.BITOR[a.lowbits,b.lowbits];
r.highbits ← Basics.BITOR[a.highbits,b.highbits];
PushInteger[frame.opstk,r.li];
};
JBitXor:
PUBLIC
PROC[frame: Frame] = {
a,b,r: Basics.LongNumber;
b.li ← PopInteger[frame.opstk];
a.li ← PopInteger[frame.opstk];
r.lowbits ← Basics.BITXOR[a.lowbits,b.lowbits];
r.highbits ← Basics.BITXOR[a.highbits,b.highbits];
PushInteger[frame.opstk,r.li];
};
JBitShift:
PUBLIC
PROC[frame: Frame] = {
OPEN Basics;
a,b,r: LongNumber;
shift: INTEGER;
b.li ← PopInteger[frame.opstk];
a.li ← PopInteger[frame.opstk];
r.li ← 0;
IF b.li
IN[-31..32]
THEN
SELECT (shift ← b.lowbits)
FROM
<-15 => { r.lowbits ← BITSHIFT[a.highbits,shift+16] };
< 0 => { r.highbits ←
BITSHIFT[a.highbits,shift];
r.lowbits ← BITOR[BITSHIFT[a.lowbits,shift],BITSHIFT[a.highbits,shift+16]] };
< 16 => { r.lowbits ←
BITSHIFT[a.lowbits,shift];
r.highbits ← BITOR[BITSHIFT[a.highbits,shift],BITSHIFT[a.lowbits,shift-16]] };
ENDCASE => { r.highbits ← BITSHIFT[a.lowbits,shift-16] };
PushInteger[frame.opstk,r.li];
};
Initialization
InstallMath:
PROC[why: InstallReason, frame: Frame] = {
SELECT why
FROM
register => {
Error name
overflow ← MakeName[".overflow"];
Math commands
RegisterExplicit[frame,".add"L,JAdd];
RegisterExplicit[frame,".sub"L,JSub];
RegisterExplicit[frame,".mul"L,JMul];
RegisterExplicit[frame,".div"L,JDiv];
RegisterExplicit[frame,".idiv"L,JIDiv];
RegisterExplicit[frame,".rdiv"L,JRDiv];
RegisterExplicit[frame,".neg"L,JNeg];
RegisterExplicit[frame,".sin"L,JSin];
RegisterExplicit[frame,".cos"L,JCos];
RegisterExplicit[frame,".atan"L,JATan];
RegisterExplicit[frame,".exp"L,JExp];
RegisterExplicit[frame,".log"L,JLog];
RegisterExplicit[frame,".sqrt"L,JSqRt];
RegisterExplicit[frame,".eq"L,JEq];
RegisterExplicit[frame,".lt"L,JLt];
RegisterExplicit[frame,".gt"L,JGt];
RegisterExplicit[frame,".not"L,JNot];
RegisterExplicit[frame,".and"L,JAnd];
RegisterExplicit[frame,".or"L,JOr];
RegisterExplicit[frame,".xor"L,JXor];
RegisterExplicit[frame,".bitnot"L,JBitNot];
RegisterExplicit[frame,".bitand"L,JBitAnd];
RegisterExplicit[frame,".bitor"L,JBitOr];
RegisterExplicit[frame,".bitxor"L,JBitXor];
RegisterExplicit[frame,".bitshift"L,JBitShift];
};
ENDCASE;
};
Install[InstallMath];
}.
Wyatt 7-Nov-81 14:14:30 change .div to do integer division for integer operands
add .rdiv