(* Long number calculator by Joerg Roth *)

PROGRAM Calculator;

CONST
     Base=10;
     MaxDivisionDigits=79;

TYPE
     LongStringPtr=^LongString;
     LongString=RECORD
          s:STRING[255];
          next:LongStringPtr
     END;

     DigitPtr=^Digit;
     Digit=RECORD
              n:SHORTINT;
              next:DigitPtr;
              prev:DigitPtr
           END;
     LongNumber=RECORD
                    exact:BOOLEAN;
                    firstDigit:DigitPtr;
                    lastDigit:DigitPtr;
                    cntDigits:INTEGER;
                    exp:INTEGER;
                    sign:SHORTINT
                END;

     STRING255=STRING[255];

     ExpressionMode=(final,unary,binary);
     TreePtr=^Tree;
     Tree=RECORD
              CASE mode:ExpressionMode OF
                 final: (
                          nr:LongNumber
                       );
                 unary:(
                          operand:TreePtr;
                          unOperator:CHAR;
                       );
                 binary:(
                          leftOperand,rightOperand:TreePtr;
                          binOperator:CHAR;
                       );
              END;


VAR inSTR:LongStringPtr;
    expression:TreePtr;
    result:LongNumber;
    error:STRING[80];
    isError:BOOLEAN;
    line:STRING255;


(**** LongString ****)

    PROCEDURE addLine(VAR str:LongStringPtr;s:STRING255);
    VAR p:LongStringPtr;
    BEGIN
        IF str=NIL THEN
        BEGIN
            New(str);
            str^.s:=s;
            str^.next:=NIL
        END
        ELSE BEGIN
            p:=str;
            WHILE p^.next<>NIL DO
                p:=p^.next;
            New(p^.next);
            p^.next^.s:=s;
            p^.next^.next:=NIL
        END
    END;


    FUNCTION getChar(str:LongStringPtr;i:INTEGER):CHAR;
    VAR p:LongStringPtr;
    BEGIN
        p:=str;
        WHILE i>Length(p^.s) DO
        BEGIN
            i:=i-Length(p^.s);
            p:=p^.next;
        END;
        getChar:=p^.s[i]
    END;


    FUNCTION getLength(str:LongStringPtr):INTEGER;
    VAR p:LongStringPtr;
        l:INTEGER;
    BEGIN
        l:=0;
        p:=str;
        WHILE p<>NIL DO
        BEGIN
            l:=l+Length(p^.s);
            p:=p^.next;
        END;
        getLength:=l
    END;



(**** LongNumber ****)

    FUNCTION getDigit(c:CHAR):SHORTINT;
    VAR d:SHORTINT;
    BEGIN
        IF (c>='0') AND (c<='9') THEN
            d:=ORD(c)-ORD('0')
        ELSE BEGIN
            c:=UpCase(c);
            d:=ORD(c)-ORD('A')+10
        END;
        IF (d>=Base) THEN
            getDigit:=-1
        ELSE
            getDigit:=d
    END;


    FUNCTION digitToChar(n:SHORTINT):CHAR;
    BEGIN
        IF (n<10) THEN
            digitToChar:=CHR(n+ORD('0'))
        ELSE
            digitToChar:=CHR(n+ORD('A')-10)
    END;


    PROCEDURE createZero(VAR nr:LongNumber);
    BEGIN
        nr.exact:=TRUE;
        nr.exp:=0;
        nr.cntDigits:=1;
        nr.sign:=1;
        New(nr.firstDigit);
        nr.lastDigit:=nr.firstDigit;
        nr.firstDigit^.n:=0;
        nr.firstDigit^.next:=NIL;
        nr.firstDigit^.prev:=NIL
    END;


    PROCEDURE createOne(VAR nr:LongNumber);
    BEGIN
        nr.exact:=TRUE;
        nr.exp:=0;
        nr.cntDigits:=1;
        nr.sign:=1;
        New(nr.firstDigit);
        nr.lastDigit:=nr.firstDigit;
        nr.firstDigit^.n:=1;
        nr.firstDigit^.next:=NIL;
        nr.firstDigit^.prev:=NIL
    END;

    PROCEDURE copyNumber(VAR source,target:LongNumber);
    VAR i:INTEGER;
        p,q,q0:DigitPtr;
    BEGIN
        target.exact:=source.exact;
        target.exp:=source.exp;
        target.cntDigits:=source.cntDigits;
        target.sign:=source.sign;
        p:=source.firstDigit;
        q0:=NIL;
        FOR i:=1 TO source.cntDigits DO
        BEGIN
            New(q);
            q^.n:=p^.n;
            q^.prev:=q0;
            q^.next:=NIL;
            IF (q0<>NIL) THEN
                q0^.next:=q;
            q0:=q;
            IF (i=1) THEN
               target.firstDigit:=q;
            IF (i=source.cntDigits) THEN
               target.lastDigit:=q;
            p:=p^.next;
        END;
    END;


    PROCEDURE appendZeros(VAR nr:LongNumber;newcnt:INTEGER);
    VAR i:INTEGER;
        p:DigitPtr;
    BEGIN
        FOR i:=nr.cntDigits+1 TO newcnt DO
        BEGIN
            New(p);
            p^.n:=0;
            p^.prev:=NIL;
            p^.next:=nr.firstDigit;
            nr.firstDigit^.prev:=p;
            nr.firstDigit:=p;
            INC(nr.cntDigits)
        END
    END;


    PROCEDURE denormalize(VAR nr:LongNumber;newexp:INTEGER);
    VAR i:INTEGER;
        p:DigitPtr;
    BEGIN
        FOR i:=nr.exp-1 DOWNTO newexp DO
        BEGIN
            New(p);
            p^.n:=0;
            p^.next:=NIL;
            p^.prev:=nr.lastDigit;
            nr.lastDigit^.next:=p;
            nr.lastDigit:=p;
            INC(nr.cntDigits);
            DEC(nr.exp)
        END
    END;


    PROCEDURE normalize(VAR nr:LongNumber);
    VAR p:DigitPtr;
    BEGIN
        p:=nr.firstDigit;
        WHILE (nr.cntDigits>1) AND (p^.n=0) DO
        BEGIN
            nr.firstDigit:=p^.next;
            p^.next^.prev:=NIL;
            Dispose(p);
            p:=nr.firstDigit;
            DEC(nr.cntDigits)
        END;

        p:=nr.lastDigit;
        WHILE (nr.cntDigits>1) AND (p^.n=0) DO
        BEGIN
            nr.lastDigit:=p^.prev;
            p^.prev^.next:=NIL;
            Dispose(p);
            p:=nr.lastDigit;
            DEC(nr.cntDigits);
            INC(nr.exp)
        END;
        IF (nr.cntDigits=1) AND (nr.firstDigit^.n=0) THEN
            nr.exp:=0
    END;


    FUNCTION isZero(VAR nr:LongNumber):BOOLEAN;
    BEGIN
        normalize(nr);
        isZero:=(nr.cntDigits=1) AND (nr.firstDigit^.n=0)
    END;


    PROCEDURE doVal(str:LongStringPtr;fromI,toI:INTEGER;VAR nr:LONGNUMBER;VAR code:INTEGER);
    VAR i:INTEGER;
        last:DigitPtr;
        c:CHAR;
        d:SHORTINT;
    BEGIN
        nr.exact:=TRUE;
        nr.sign:=1;
        nr.exp:=0;
        nr.cntDigits:=1;
        IF getChar(str,fromI)='-' THEN
        BEGIN
            nr.sign:=-1;
            INC(fromI)
        END;
        d:=getDigit(getChar(str,fromI));
        IF (d<0) THEN
        BEGIN
            code:=1;
            Exit
        END;
        New(nr.firstDigit);
        nr.lastDigit:=nr.firstDigit;
        last:=nr.firstDigit;
        last^.n:=d;
        last^.next:=NIL;
        last^.prev:=NIL;

        FOR i:=fromI+1 TO toI DO
        BEGIN
            c:=getChar(str,i);
            IF (c='.') THEN
            BEGIN
                IF (nr.exp<>0) THEN
                BEGIN
                    code:=2;
                    Exit;
                END;
                nr.exp:=i-toI;
            END
            ELSE BEGIN
                d:=getDigit(c);
                IF (d<0) THEN
                BEGIN
                    code:=1;
                    Exit
                END;
                INC(nr.cntDigits);
                New(last^.next);
                last^.next^.n:=d;
                last^.next^.next:=NIL;
                last^.next^.prev:=last;
                last:=last^.next;
                nr.lastDigit:=last;
            END
        END;
        code:=0;
        normalize(nr)
    END;


    PROCEDURE writeNumber(nr:LongNumber);
    VAR i:INTEGER;
        p:DigitPtr;
    BEGIN
        IF nr.sign<0 THEN
            Write('-');
        p:=nr.firstDigit;
        IF nr.cntDigits+nr.exp<=0 THEN
        BEGIN
            Write('0.');
            FOR i:=1 TO -nr.cntDigits-nr.exp DO
                Write('0'); 
        END;
        FOR i:=1 TO nr.cntDigits DO
        BEGIN
            Write(digitToChar(p^.n));
            p:=p^.next;
            IF i-nr.cntDigits=nr.exp THEN
                Write('.');
        END;
        IF nr.exp>0 THEN
        BEGIN
            FOR i:=1 TO nr.exp DO
                Write('0');
            Write('.')
        END
    END;


    PROCEDURE disposeNumber(VAR nr:LongNumber);
    VAR p,p2:DigitPtr;
    BEGIN
        p:=nr.firstDigit;
        WHILE p<>NIL DO
        BEGIN
            p2:=p^.next;
            Dispose(p);
            p:=p2
        END;
        nr.firstDigit:=NIL;
        nr.lastDigit:=NIL;
        nr.cntDigits:=0;
        nr.exp:=0;
    END;


(**** Parser ****)

    FUNCTION priority(operation:CHAR):INTEGER;
    BEGIN
        IF (operation='+') OR (operation='-') THEN
            priority:=1
        ELSE IF (operation='*') OR (operation='/') OR (operation='%') THEN
            priority:=2
        ELSE 
            priority:=3;
    END;


    FUNCTION skipExpression(str:LongStringPtr;i,toI:INTEGER):INTEGER;
    VAR level:INTEGER;
    BEGIN
        WHILE (getChar(str,i) IN ['-','#']) DO
            INC(i);
        IF getChar(str,i)='(' THEN
        BEGIN
            INC(i);
            level:=1;
            WHILE (i<=toI) AND ((getChar(str,i)<>')') OR (level>1)) DO
            BEGIN
               IF getChar(str,i)='(' THEN
                   INC(level)
               ELSE IF getChar(str,i)=')' THEN
                   DEC(level);
               INC(i);
            END;
            IF (i<toI) THEN
               INC(i)
        END
        ELSE
            WHILE (i<=toI) AND (Pos(getChar(str,i),'+-*/%^')=0) DO
                INC(i);
        skipExpression:=i
    END;


    FUNCTION findOperator(str:LongStringPtr;fromI,toI:INTEGER):INTEGER;
    VAR i:INTEGER;
        lastPrio:INTEGER;
        lastI:INTEGER;
        newPrio:INTEGER;
    BEGIN
        i:=fromI;
        lastI:=-1;
        lastPrio:=999;
        REPEAT
            i:=skipExpression(str,i,toI);
            IF i<toI THEN
            BEGIN
                newPrio:=priority(getChar(str,i));
                IF (newPrio<=lastPrio) THEN
                BEGIN
                    lastPrio:=newPrio;
                    lastI:=i;
                END;
                INC(i)
            END
        UNTIL i>=toI;
        findOperator:=lastI
    END;


    FUNCTION parseExpression(str:LongStringPtr;fromI,toI:INTEGER):TreePtr;
    VAR pos:INTEGER;
        code:INTEGER;
        exprPtr:TreePtr;
    BEGIN
        pos:=findOperator(str,fromI,toI);
        IF pos=-1 THEN
        BEGIN
            IF getChar(str,fromI)='(' THEN
            BEGIN
                IF getChar(str,toI)<>')' THEN
                BEGIN
                    error:='missing ")"';
                    isError:=TRUE;
                    parseExpression:=NIL
                END
                ELSE
                    exprPtr:=parseExpression(str,fromI+1,toI-1)
            END
            ELSE IF (getChar(str,fromI) in ['-','#']) THEN
            BEGIN
                New(exprPtr);
                exprPtr^.mode:=unary;
                exprPtr^.operand:=parseExpression(str,fromI+1,toI);
                exprPtr^.unOperator:=getChar(str,fromI)
            END

            ELSE BEGIN
                New(exprPtr);
                exprPtr^.mode:=final;
                doVal(str,fromI,toI,exprPtr^.nr,code);
                IF (code<>0) THEN
                BEGIN
                    error:='illegal number';
                    isError:=TRUE;
                END
            END
        END
        ELSE BEGIN
            New(exprPtr);
            exprPtr^.mode:=binary;
            exprPtr^.leftOperand:=parseExpression(str,fromI,pos-1);
            exprPtr^.rightOperand:=parseExpression(str,pos+1,toI);
            exprPtr^.binOperator:=getChar(str,pos);
        END;
        parseExpression:=exprPtr
    END;


    PROCEDURE disposeExpression(VAR expression:TreePtr);
    BEGIN
        IF (expression<>NIL) THEN
        BEGIN
            CASE expression^.mode OF
                unary:
                   disposeExpression(expression^.operand);
                binary:
                   BEGIN
                       disposeExpression(expression^.leftOperand);
                       disposeExpression(expression^.rightOperand)
                   END
            END;
            Dispose(expression)
        END
    END;



    PROCEDURE printExpression(expression:TreePtr;level:INTEGER);
    VAR i:INTEGER;
    BEGIN
        FOR i:=1 TO level DO
            Write(' ');
        IF (expression=NIL) THEN
            WriteLn('NIL')
        ELSE
            CASE expression^.mode OF
                final:
                   BEGIN
                       WriteNumber(expression^.nr);
                       WriteLn
                   END;
                unary:
                   BEGIN
                       WriteLn('unary '+expression^.unOperator);
                       printExpression(expression^.operand,level+1)
                   END;
                binary:
                   BEGIN
                       WriteLn(expression^.binOperator);
                       printExpression(expression^.leftOperand,level+1);
                       printExpression(expression^.rightOperand,level+1)
                   END
            END
    END;

(**** Operationen ****)

    PROCEDURE unaryMinus(VAR result:LongNumber);
    BEGIN
        result.sign:=-result.sign
    END;


    PROCEDURE unaryTruncate(VAR result:LongNumber);
    VAR i:INTEGER;
        p:DigitPtr;
    BEGIN
        p:=result.firstDigit;
        FOR i:=1 TO result.cntDigits DO
        BEGIN
            IF (i>result.cntDigits+result.exp) THEN
                p^.n:=0;
            p:=p^.next;
        END;
        normalize(result);
    END;


    PROCEDURE add(VAR nr1,nr2:LongNumber;VAR result:LongNumber);
    VAR i:INTEGER;
        resSign:SHORTINT;
        addFlag:BOOLEAN;
        p1,p2,resP:DigitPtr;
        carry:INTEGER;
        digit:SHORTINT;
        op1,op2:LongNumber;
    BEGIN
        IF nr1.exp>nr2.exp THEN
            denormalize(nr1,nr2.exp)
        ELSE
            denormalize(nr2,nr1.exp);
        IF nr1.cntDigits>nr2.cntDigits THEN
            appendZeros(nr2,nr1.cntDigits)
        ELSE
            appendZeros(nr1,nr2.cntDigits);

        IF (nr1.sign>0) THEN
        BEGIN
            IF (nr2.sign>0) THEN
            BEGIN
                resSign:=1;
                addFlag:=TRUE;
                op1:=nr1;
                op2:=nr2
            END
            ELSE BEGIN
                resSign:=1;
                addFlag:=FALSE;
                op1:=nr1;
                op2:=nr2
            END
        END
        ELSE BEGIN
            IF (nr2.sign>0) THEN
            BEGIN
                resSign:=1;
                addFlag:=FALSE;
                op1:=nr2;
                op2:=nr1
            END
            ELSE BEGIN
                resSign:=-1;
                addFlag:=TRUE;
                op1:=nr1;
                op2:=nr2
            END
        END;
        result.exact:=nr1.exact AND nr2.exact;
        result.cntDigits:=0;
        result.sign:=resSign;
        result.exp:=nr1.exp;
        result.firstDigit:=NIL;
        result.lastDigit:=NIL;
        p1:=op1.lastDigit;
        p2:=op2.lastDigit;
        carry:=0;
        FOR i:=1 TO op1.cntDigits DO
        BEGIN
            IF addFlag THEN
            BEGIN
                digit:=p1^.n+p2^.n+carry;
                IF (digit>=Base) THEN
                BEGIN
                    DEC(digit,base);
                    carry:=1
                END
                ELSE
                    carry:=0
            END
            ELSE BEGIN
                digit:=p1^.n-p2^.n+carry;
                IF (digit<0) THEN
                BEGIN
                    INC(digit,base);
                    carry:=-1
                END
                ELSE
                    carry:=0
            END;
            New(resP);
            resP^.n:=digit;
            IF result.lastDigit=NIL THEN
            BEGIN
                result.lastDigit:=resP;
                result.firstDigit:=resP;
                resP^.next:=NIL;
                resP^.prev:=NIL
            END
            ELSE BEGIN
                result.firstDigit^.prev:=resP;
                resP^.next:=result.firstDigit;
                resP^.prev:=NIL;
                result.firstDigit:=resP
            END;
            INC(result.cntDigits);
            p1:=p1^.prev;
            p2:=p2^.prev
        END;
        IF carry=1 THEN
        BEGIN
            New(resP);
            resP^.n:=carry;
            result.firstDigit^.prev:=resP;
            resP^.next:=result.firstDigit;
            resP^.prev:=NIL;
            result.firstDigit:=resP;
            INC(result.cntDigits);
        END
        ELSE IF carry=-1 THEN
        BEGIN
            resP:=result.lastDigit;
            carry:=1;
            FOR i:=1 TO result.cntDigits DO
            BEGIN
                resP^.n:=Base-1-resP^.n+carry;
                IF (resP^.n>=Base) THEN
                BEGIN
                    DEC(resP^.n,Base);
                    carry:=1;
                END
                ELSE
                    carry:=0;
                resP:=resP^.prev
            END;
            result.sign:=result.sign*-1
        END;
        normalize(result);
        normalize(nr1);
        normalize(nr2)
    END;


    PROCEDURE subtract(VAR nr1,nr2:LongNumber;VAR result:LongNumber);
    BEGIN
        nr2.sign:=nr2.sign*-1;
        add(nr1,nr2,result);
        nr2.sign:=nr2.sign*-1
    END;


    PROCEDURE multiply(VAR nr1,nr2:LongNumber;VAR result:LongNumber);
    VAR help,helpRes:LongNumber;
        i,j:INTEGER;
        p1,p2,helpP:DigitPtr;
        res,carry:INTEGER;
    BEGIN
        createZero(result);

        p1:=nr2.firstDigit;
        FOR i:=1 TO nr2.cntDigits DO
        BEGIN
            New(helpP);
            helpP^.n:=0;
            helpP^.next:=NIL;
            helpP^.prev:=result.lastDigit;
            result.lastDigit^.next:=helpP;
            result.lastDigit:=helpP;
            INC(result.cntDigits);

            help.cntDigits:=0;
            help.lastDigit:=NIL;
            help.firstDigit:=NIL;
            help.exp:=0;
            help.sign:=1;
            p2:=nr1.lastDigit;
            carry:=0;
            FOR j:=1 TO nr1.cntDigits DO
            BEGIN
                res:=p2^.n*p1^.n+carry;
                carry:=res DIV Base;
                res:=res MOD Base;
                New(helpP);
                helpP^.n:=res;
                helpP^.prev:=NIL;
                IF help.lastDigit=NIL THEN
                BEGIN
                    help.lastDigit:=helpP;
                    help.firstDigit:=helpP;
                    helpP^.next:=NIL
                END
                ELSE BEGIN
                    help.firstDigit^.prev:=helpP;
                    helpP^.next:=help.firstDigit;
                    help.firstDigit:=helpP
                END;
                INC(help.cntDigits);
                p2:=p2^.prev
            END;

            New(helpP);
            helpP^.n:=carry;
            helpP^.prev:=NIL;
            help.firstDigit^.prev:=helpP;
            helpP^.next:=help.firstDigit;
            help.firstDigit:=helpP;
            INC(help.cntDigits);

            add(help,result,helpRes);
            disposeNumber(help);
            disposeNumber(result);
            result:=helpRes;

            p1:=p1^.next
        END;
        result.exact:=nr1.exact AND nr2.exact;
        result.exp:=result.exp+nr1.exp+nr2.exp;
        result.sign:=nr1.sign*nr2.sign;
        normalize(result);
    END;


    PROCEDURE doRound(VAR nr:LongNumber);
    VAR roundNr,helpRes:LongNumber;
        sign:SHORTINT;
    BEGIN
        IF (nr.cntDigits<3) THEN
            Exit;
        createZero(roundNr);
        roundNr.firstDigit^.n:=Base DIV 2;
        roundNr.exp:=nr.exp;

        sign:=nr.sign;
        nr.sign:=1;
        add(nr,roundNr,helpRes);
        disposeNumber(nr);
        disposeNumber(roundNr);
        nr:=helpRes;

        nr.exact:=FALSE;
        nr.lastDigit^.n:=0;
        nr.sign:=sign;
        normalize(nr)
    END;


    PROCEDURE divide(VAR nr1,nr2:LongNumber;VAR result:LongNumber);
    VAR oldexp:INTEGER;
        oldsign1,oldsign2:SHORTINT;
        cnt:INTEGER;
        digit:SHORTINT;
        p:DigitPtr;
        helpRes:LongNumber;
    BEGIN
        IF isZero(nr2) THEN
        BEGIN
            isError:=TRUE;
            error:='divided by zero';
            Exit
        END;
        oldexp:=nr2.exp;
        oldsign1:=nr1.sign;
        oldsign2:=nr2.sign;
        nr2.exp:=nr1.exp+nr1.cntDigits-nr2.cntDigits;
        nr1.sign:=1;
        nr2.sign:=1;

        cnt:=MaxDivisionDigits; 

        result.exact:=nr1.exact AND nr2.exact;
        result.sign:=oldsign1*oldsign2;
        result.cntDigits:=0;
        result.exp:=0;
        result.firstDigit:=NIL;
        result.lastDigit:=NIL;

        WHILE (cnt>0) AND (NOT isZero(nr1)) DO
        BEGIN
            digit:=0;
            WHILE (nr1.sign>0) DO
            BEGIN
                INC(digit);
                subtract(nr1,nr2,helpRes);
                disposeNumber(nr1);
                nr1:=helpRes
            END;
            DEC(digit);
            add(nr1,nr2,helpRes);
            disposeNumber(nr1);
            nr1:=helpRes;
            New(p);
            p^.n:=digit;
            INC(result.cntDigits);
            IF (result.firstDigit=NIL) THEN
            BEGIN
                result.firstDigit:=p;
                result.lastDigit:=p;
                p^.prev:=NIL;
                p^.next:=NIL
            END
            ELSE BEGIN
                result.lastDigit^.next:=p;
                p^.prev:=result.lastDigit;
                p^.next:=NIL;
                result.lastDigit:=p
            END;

            DEC(cnt);
            DEC(nr2.exp)
        END;
        IF cnt=0 THEN
            result.exact:=FALSE;
        result.exp:=nr2.exp-oldexp+1;

        normalize(result)
    END;


    PROCEDURE modulo(VAR nr1,nr2:LongNumber;VAR result:LongNumber);
    VAR help,help2,copyn1,copyn2:LongNumber;
    BEGIN
        IF isZero(nr2) THEN
        BEGIN
            isError:=TRUE;
            error:='divided by zero';
            Exit
        END;
        copyNumber(nr1,copyn1);
        copyNumber(nr2,copyn2);
        divide(nr1,nr2,help);

        unaryTruncate(help);
        multiply(help,copyn2,help2);
        subtract(copyn1,help2,result);
        disposeNumber(help);
        disposeNumber(help2);
        disposeNumber(copyn1);
        disposeNumber(copyn2);
    END;


    PROCEDURE power(VAR nr1,nr2:LongNumber;VAR result:LongNumber);
    VAR helpRes,one:LongNumber;
    BEGIN
        IF isZero(nr1) AND isZero(nr2) THEN
        BEGIN
            isError:=TRUE;
            error:='0^0 is not allowed';
            Exit
        END;
        IF nr2.exp<0 THEN
        BEGIN
            isError:=TRUE;
            error:='exponent must be integer';
            Exit
        END;
        IF nr2.sign<0 THEN
        BEGIN
            isError:=TRUE;
            error:='exponent must be positive';
            Exit
        END;

        createOne(result);
        createOne(one);

        WHILE NOT isZero(nr2) DO
        BEGIN

            multiply(result,nr1,helpRes);
            disposeNumber(result);
            result:=helpRes;
            subtract(nr2,one,helpRes);
            disposeNumber(nr2);
            nr2:=helpRes;
        END;
        disposeNumber(one);
        result.exact:=nr1.exact AND nr2.exact;
        normalize(result)
    END;



    PROCEDURE eval(expression:TreePtr;VAR result:LongNumber);
    VAR nr1,nr2:LongNumber;
    BEGIN
        CASE expression^.mode OF
            final:
               result:=expression^.nr;
            unary:
               BEGIN
                   eval(expression^.operand,result);
(*
                   Write(expression^.unOperator);
                   writeNumber(result);
                   WriteLn;
*)
                   IF (isError) THEN
                       Exit;
                   CASE expression^.unOperator OF
                       '-':unaryMinus(result);
                       '#':unaryTruncate(result);
                       ELSE BEGIN
                           isError:=TRUE;
                           error:='unkown unary operation:'+expression^.unOperator
                       END
                   END
               END;
            binary:
               BEGIN
                   eval(expression^.leftOperand,nr1);
                   eval(expression^.rightOperand,nr2);
(*
                   writeNumber(nr1);
                   Write(expression^.binOperator);
                   writeNumber(nr2);
                   WriteLn;
*)
                   IF (isError) THEN
                       Exit;
                   CASE expression^.binOperator OF
                       '+':add(nr1,nr2,result);
                       '-':subtract(nr1,nr2,result);
                       '*':multiply(nr1,nr2,result);
                       '/':divide(nr1,nr2,result);
                       '^':power(nr1,nr2,result);
                       '%':modulo(nr1,nr2,result);
                       ELSE BEGIN
                           isError:=TRUE;
                           error:='unkown operation:'+expression^.binOperator
                       END
                   END
               END
        END
    END;

(* Wichtige Testf„lle:
   šberlauf               1+999
   Unterlauf              1000-1
   2*Negativ              -1-1
   1*Negativ              -1+2
   Un„res - vor Klammer   -(1+2)
   Von Links nach rechts  1/3*3
*)
BEGIN
    WriteLn('Long number calculator by J. Roth');
    WriteLn('Enter an expression e.g.:');
    WriteLn(' >(1+3)*4^5');
    WriteLn(' >');
    WriteLn('Empty line starts evaluation:');
    WriteLn('Binary operators:');
    Writeln(' +, -, *, /');
    Writeln(' ^:power');
    Writeln(' %:modulo');
    WriteLn;
    WriteLn('Unary operators:');
    Writeln(' -:minus');
    WriteLn(' #:truncate');
    WriteLn;
    WHILE TRUE DO
    BEGIN
        inStr:=NIL;
        Write('>');
        ReadLn(line);
        IF Length(line)=0 THEN
            Halt;
        WHILE (Length(line)>0) DO
        BEGIN
            addLine(inStr,line);
            Write('>');
            ReadLn(line)
        END;

        error:='';
        isError:=FALSE;
        expression:=parseExpression(inStr,1,getLength(inStr));

        IF (isError) THEN
            WriteLn(error)
        ELSE BEGIN
            error:='';
            isError:=FALSE;

(*            printExpression(expression,0); *)

            eval(expression,result);
            disposeExpression(expression);

            IF (isError) THEN
                WriteLn(error)
            ELSE BEGIN
                IF (NOT result.exact) THEN
                    doRound(result);
                WriteNumber(result);
                WriteLn
            END
        END
    END
END.