
    <<PS0Impl.mesa>>
        <<Copyright Ó 1986 by Xerox Corporation.  All rights reserved.>>
        <<Doug Wyatt, October 29, 1986 11:09:47 am PST>>

    <<PostScript implementation: arithmetic and math.>>
    <<>>
    DIRECTORY
        PS,
        Random USING [Create, NextInt],
        Real USING [Fix, RealException],
        RealFns USING [ArcTanDeg, CosDeg, Ln, Log, Power, SinDeg, SqRt];

    PS0Impl: CEDAR PROGRAM
    IMPORTS PS, Random, Real, RealFns
    ~ BEGIN OPEN PS;
<<Arithmetic and math operators>>
    Add: PROC [num1, num2: Num] RETURNS [Num] ~ {
        WITH n1: num1 SELECT FROM
            int => WITH n2: num2 SELECT FROM
                int => {
                    int1: INT ~ n1.int;
                    int2: INT ~ n2.int;
                    int3: INT ~ int1+int2;
                    IF (int1<0)#(int2<0) OR (int2<0)=(int3<0) THEN RETURN [[int[int3]]]
                    ELSE RETURN [[real[REAL[int1]+REAL[int2]]]];
                    };
                real => RETURN [[real[REAL[n1.int]+n2.real]]];
                ENDCASE;
            real => WITH n2: num2 SELECT FROM
                int => RETURN [[real[n1.real+REAL[n2.int]]]];
                real => RETURN [[real[n1.real+n2.real]]];
                ENDCASE;
            ENDCASE;
        ERROR;
        };

    Sub: PROC [num1, num2: Num] RETURNS [Num] ~ {
        WITH n1: num1 SELECT FROM
            int => WITH n2: num2 SELECT FROM
                int => {
                    int1: INT ~ n1.int;
                    int2: INT ~ n2.int;
                    int3: INT ~ int1-int2;
                    IF (int1<0)=(int2<0) OR (int2<0)#(int3<0) THEN RETURN [[int[int3]]]
                    ELSE RETURN [[real[REAL[int1]-REAL[int2]]]];
                    };
                real => RETURN [[real[REAL[n1.int]-n2.real]]];
                ENDCASE;
            real => WITH n2: num2 SELECT FROM
                int => RETURN [[real[n1.real-REAL[n2.int]]]];
                real => RETURN [[real[n1.real-n2.real]]];
                ENDCASE;
            ENDCASE;
        ERROR;
        };

    Mul: PROC [num1, num2: Num] RETURNS [Num] ~ {
        WITH n1: num1 SELECT FROM
            int => WITH n2: num2 SELECT FROM
                int => {
                    int1: INT ~ n1.int;
                    int2: INT ~ n2.int;
                    int3: INT ~ int1*int2;
                    real3: REAL ~ REAL[int1]*REAL[int2];
                    <<********** fix this **********>>
                    IF int3=real3 THEN RETURN [[int[int3]]]
                    ELSE RETURN [[real[REAL[int1]*REAL[int2]]]];
                    };
                real => RETURN [[real[REAL[n1.int]*n2.real]]];
                ENDCASE;
            real => WITH n2: num2 SELECT FROM
                int => RETURN [[real[n1.real*REAL[n2.int]]]];
                real => RETURN [[real[n1.real*n2.real]]];
                ENDCASE;
            ENDCASE;
        ERROR;
        };

    Abs: PROC [num: Num] RETURNS [Num] ~ {
        WITH n: num SELECT FROM
            int => {
                IF n.int#INT.FIRST THEN RETURN [[int[ABS[n.int]]]]
                ELSE RETURN [[real[ABS[REAL[n.int]]]]];
                };
            real => RETURN [[real[ABS[n.real]]]];
            ENDCASE;
        ERROR;
        };

    Neg: PROC [num: Num] RETURNS [Num] ~ {
        WITH n: num SELECT FROM
            int => {
                IF n.int#INT.FIRST THEN RETURN [[int[-n.int]]]
                ELSE RETURN [[real[-REAL[n.int]]]];
                };
            real => RETURN [[real[-n.real]]];
            ENDCASE;
        ERROR;
        };

    Fix: PROC [r: REAL] RETURNS [REAL] ~ { RETURN[Real.Fix[r]] };

Truncate: PROC [x: REAL] RETURNS [z: REAL] ~ {
    z _ Fix[x ! Real.RealException => GOTO Big];
EXITS Big => RETURN [x];
};

Ceiling: PROC [x: REAL] RETURNS [z: REAL] ~ {
    z _ Fix[x ! Real.RealException => GOTO Big];
    WHILE z<x DO z _ z+1 ENDLOOP;
EXITS Big => RETURN [x];
};

Floor: PROC [x: REAL] RETURNS [z: REAL] ~ {
    z _ Fix[x ! Real.RealException => GOTO Big];
    WHILE z>x DO z _ z-1 ENDLOOP;
EXITS Big => RETURN [x];
};

Round: PROC [x: REAL] RETURNS [REAL] ~ {
    RETURN [Floor[x+0.5]];
};

<<Primitives>>
    Padd: PROC [self: Root] ~ {
        num2: Num ~ PopNum[self.ostack];
        num1: Num ~ PopNum[self.ostack];
    PushNum[self.ostack, Add[num1, num2]];
        };

    Psub: PROC [self: Root] ~ {
        num2: Num ~ PopNum[self.ostack];
        num1: Num ~ PopNum[self.ostack];
    PushNum[self.ostack, Sub[num1, num2]];
        };

    Pmul: PROC [self: Root] ~ {
        num2: Num ~ PopNum[self.ostack];
        num1: Num ~ PopNum[self.ostack];
    PushNum[self.ostack, Mul[num1, num2]];
        };

    Pdiv: PROC [self: Root] ~ {
        n2: REAL ~ PopReal[self.ostack];
        n1: REAL ~ PopReal[self.ostack];
        PushReal[self.ostack, n1/n2];
        };

    Pidiv: PROC [self: Root] ~ {
        int2: INT ~ PopInt[self.ostack];
        int1: INT ~ PopInt[self.ostack];
        PushInt[self.ostack, int1/int2];
        };

    Pmod: PROC [self: Root] ~ {
        int2: INT ~ PopInt[self.ostack];
        int1: INT ~ PopInt[self.ostack];
        PushInt[self.ostack, int1 MOD int2];
        };

    Pabs: PROC [self: Root] ~ {
        num: Num ~ PopNum[self.ostack];
    PushNum[self.ostack, Abs[num]];
        };

    Pneg: PROC [self: Root] ~ {
        num: Num ~ PopNum[self.ostack];
    PushNum[self.ostack, Neg[num]];
        };

    Pceiling: PROC [self: Root] ~ {
        x: Any ~ Pop[self.ostack];
        SELECT Type[x] FROM
            integer => Push[self.ostack, x];
            real => PushReal[self.ostack, Ceiling[RealFromAny[x]]];
            ENDCASE => ERROR Error[typecheck];
        };

    Pfloor: PROC [self: Root] ~ {
        x: Any ~ Pop[self.ostack];
        SELECT Type[x] FROM
            integer => Push[self.ostack, x];
            real => PushReal[self.ostack, Floor[RealFromAny[x]]];
            ENDCASE => ERROR Error[typecheck];
        };

    Pround: PROC [self: Root] ~ {
        x: Any ~ Pop[self.ostack];
        SELECT Type[x] FROM
            integer => Push[self.ostack, x];
            real => PushReal[self.ostack, Round[RealFromAny[x]]];
            ENDCASE => ERROR Error[typecheck];
        };

    Ptruncate: PROC [self: Root] ~ {
        x: Any ~ Pop[self.ostack];
        SELECT Type[x] FROM
            integer => Push[self.ostack, x];
            real => PushReal[self.ostack, Truncate[RealFromAny[x]]];
            ENDCASE => ERROR Error[typecheck];
        };

    Psqrt: PROC [self: Root] ~ {
        num: REAL ~ PopReal[self.ostack];
        PushReal[self.ostack, RealFns.SqRt[num]];
        };

    Patan: PROC [self: Root] ~ {
        den: REAL ~ PopReal[self.ostack];
        num: REAL ~ PopReal[self.ostack];
        PushReal[self.ostack, RealFns.ArcTanDeg[num, den]];
        };

    Pcos: PROC [self: Root] ~ {
        angle: REAL ~ PopReal[self.ostack];
        PushReal[self.ostack, RealFns.CosDeg[angle]];
        };

    Psin: PROC [self: Root] ~ {
        angle: REAL ~ PopReal[self.ostack];
        PushReal[self.ostack, RealFns.SinDeg[angle]];
        };

    Pexp: PROC [self: Root] ~ {
        exponent: REAL ~ PopReal[self.ostack];
        base: REAL ~ PopReal[self.ostack];
        PushReal[self.ostack, RealFns.Power[base, exponent]];
        };

    Pln: PROC [self: Root] ~ {
        num: REAL ~ PopReal[self.ostack];
        PushReal[self.ostack, RealFns.Ln[num]];
        };

    Plog: PROC [self: Root] ~ {
        num: REAL ~ PopReal[self.ostack];
        PushReal[self.ostack, RealFns.Log[10, num]];
        };

    Prand: PROC [self: Root] ~ {
        int: INT ~ Random.NextInt[self.random];
        PushInt[self.ostack, int];
        };

    Psrand: PROC [self: Root] ~ {
        int: INT ~ PopInt[self.ostack];
        self.random _ Random.Create[seed: int];
        };

    Prrand: PROC [self: Root] ~ {
        ERROR Error[unimplemented];
        };


Register0: PROC [self: Root] ~ {
    Register[self, "add", Padd];
    Register[self, "div", Pdiv];
    Register[self, "idiv", Pidiv];
    Register[self, "mod", Pmod];
    Register[self, "mul", Pmul];
    Register[self, "sub", Psub];
    Register[self, "abs", Pabs];
    Register[self, "neg", Pneg];
    Register[self, "ceiling", Pceiling];
    Register[self, "floor", Pfloor];
    Register[self, "round", Pround];
    Register[self, "truncate", Ptruncate];
    Register[self, "sqrt", Psqrt];
    Register[self, "atan", Patan];
    Register[self, "cos", Pcos];
    Register[self, "sin", Psin];
    Register[self, "exp", Pexp];
    Register[self, "ln", Pln];
    Register[self, "log", Plog];
    Register[self, "rand", Prand];
    Register[self, "srand", Psrand];
    Register[self, "rrand", Prrand];
};

RegisterPrimitives[Register0];

END.