Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/ADC_TP3.ZIP/CALC.PAS

Pascal/Delphi Source File | 1987-03-01 | 33.5 KB | 933 lines

PROGRAM calc(INPUT,OUTPUT);
  {
         This program uses recursive descent to evaluate expressions
    written in infix notation.  The operations addition (+),
    subtraction (-), multiplication (*), and division (/) are supported,
    as are the functions ABS, ARCTAN, COS, EXP, LN, SQR, and SQRT.
    PI returns the value for pi.  Results exceeding 1.0E37 are reported
    as overflows.  Results less than 1.0E-37 are set to zero.

         Written by James L. Dean
                    406 40th Street
                    New Orleans, LA 70124
                    February 25, 1985

  }
  TYPE
    argument_record_ptr = ^argument_record;
    argument_record = RECORD
                        value : REAL;
                        next_ptr : argument_record_ptr
                      END;
    string_1 = STRING[1];
    string_255 = STRING[255];
  VAR
    error_detected              : BOOLEAN;
    error_msg                   : string_255;
    expression                  : string_255;
    expression_index            : INTEGER;
    expression_length           : INTEGER;
    result                      : REAL;
  PROCEDURE set_error(msg : string_255);
    BEGIN
      error_detected:=TRUE;
      error_msg
       :='Error:  '+msg+'.'
    END;
  PROCEDURE eat_leading_spaces;
    VAR
      non_blank_found           : BOOLEAN;
    BEGIN
      non_blank_found:=FALSE;
      WHILE((expression_index <= expression_length)
      AND   (NOT non_blank_found)) DO
        IF expression[expression_index] = ' ' THEN
          expression_index:=expression_index+1
        ELSE
          non_blank_found:=TRUE
    END;
  FUNCTION unsigned_integer : REAL;
    VAR
      non_digit_found           : BOOLEAN;
      result                    : REAL;
      tem_char                  : CHAR;
      tem_real                  : REAL;
    BEGIN
      non_digit_found:=FALSE;
      result:=0.0;
      REPEAT
        tem_char:=expression[expression_index];
        IF ((tem_char >= '0') AND (tem_char <= '9')) THEN
          BEGIN
            tem_real:=ORD(tem_char)-ORD('0');
            result:=10.0*result+tem_real;
            expression_index:=expression_index+1;
            IF expression_index > expression_length THEN
            non_digit_found:=TRUE
          END
        ELSE
          non_digit_found:=TRUE
      UNTIL (non_digit_found);
      unsigned_integer:=result
    END;
  FUNCTION unsigned_number : REAL;
    VAR
      exponent_value            : REAL;
      exponent_sign             : CHAR;
      factor                    : REAL;
      non_digit_found           : BOOLEAN;
      result                    : REAL;
      tem_char                  : CHAR;
      tem_real_1                : REAL;
      tem_real_2                : REAL;
    BEGIN
      result:=unsigned_integer;
      IF (NOT error_detected) THEN
        BEGIN
          IF expression_index <= expression_length THEN
            BEGIN
              tem_char:=expression[expression_index];
              IF tem_char = '.' THEN
                BEGIN
                  tem_real_1:=result;
                  expression_index:=expression_index+1;
                  IF expression_index > expression_length THEN
                    set_error(
            'end of expression encountered where decimal part expected')
                  ELSE
                    BEGIN
                      tem_char:=expression[expression_index];
                      IF ((tem_char >= '0') AND (tem_char <= '9')) THEN
                        BEGIN
                          factor:=1.0;
                          non_digit_found:=FALSE;
                          WHILE (NOT non_digit_found) DO
                            BEGIN
                              factor:=factor/10.0;
                              tem_real_2:=ORD(tem_char)-ORD('0');
                              tem_real_1:=tem_real_1+factor*tem_real_2;
                              expression_index:=expression_index+1;
                              IF expression_index > expression_length THEN
                               non_digit_found:=TRUE
                              ELSE
                                BEGIN
                                  tem_char
                                   :=expression[expression_index];
                                  IF ((tem_char < '0')
                                  OR  (tem_char > '9')) THEN
                                    non_digit_found:=TRUE
                                END
                            END;
                          result:=tem_real_1
                        END
                      ELSE
                        set_error(
                         'decimal part of real number is missing')
                    END
                END;
              IF (NOT error_detected) THEN
                BEGIN
                  IF expression_index <= expression_length THEN
                    BEGIN
                      IF ((tem_char = 'e') OR (tem_char = 'E')) THEN
                        BEGIN
                          expression_index:=expression_index+1;
                          IF expression_index > expression_length THEN
                            set_error(
               'end of expression encountered where exponent expected')
                         ELSE
                            BEGIN
                              tem_char
                               :=expression[expression_index];
                              IF ((tem_char = '+')
                              OR  (tem_char = '-')) THEN
                                BEGIN
                                  exponent_sign:=tem_char;
                                  expression_index:=expression_index+1
                                END
                              ELSE
                                exponent_sign:=' ';
                              IF expression_index > expression_length
                               THEN
                                set_error(
     'end of expression encountered where exponent magnitude expected')
                              ELSE
                                BEGIN
                                  tem_char:=expression[expression_index];
                                 IF ((tem_char >= '0')
                                  AND (tem_char <= '9')) THEN
                                    BEGIN
                                      exponent_value
                                       :=unsigned_integer;
                                      IF (NOT error_detected) THEN
                                        BEGIN
                                          IF exponent_value > 37.0 THEN
                                            set_error(
                                   'magnitude of exponent is too large')
                                          ELSE
                                            BEGIN
                                              tem_real_1:=1.0;
                                              WHILE (exponent_value > 0.0) DO
                                                BEGIN
                                                  exponent_value
                                                   :=exponent_value-1.0;
                                                  tem_real_1:=10.0*tem_real_1
                                                END;
                                              IF exponent_sign = '-' THEN
                                               tem_real_1
                                                :=1.0/tem_real_1;
                                              IF result <> 0.0 THEN
                                                BEGIN
                                                  tem_real_2
                                                   :=(LN(tem_real_1)
                                                   +LN(ABS(result)))
                                                   /LN(10.0);
                                                  IF tem_real_2 < -37.0 THEN
                                                    result:=0.0
                                                  ELSE
                                                    IF tem_real_2 > 37.0 THEN
                                                      set_error(
                                                       'constant is too big')
                                                    ELSE
                                                      result:=result*tem_real_1
                                                END
                                            END
                                        END
                                    END
                                  ELSE
                                    set_error(
                                     'nonnumeric exponent encountered')
                                END
                            END
                        END
                    END
                END
            END
        END;
      unsigned_number:=result
    END;
  FUNCTION pop_argument(VAR argument_stack_head : argument_record_ptr) : REAL;
    VAR
      argument_stack_ptr        : argument_record_ptr;
      result                    : REAL;
    BEGIN
      result
       :=argument_stack_head^.value;
      argument_stack_ptr
       :=argument_stack_head^.next_ptr;
      DISPOSE(argument_stack_head);
      argument_stack_head:=argument_stack_ptr;
      pop_argument:=result
    END;
  FUNCTION abs_function(VAR argument_stack_head : argument_record_ptr;
   VAR function_name : string_255) : REAL;
    VAR
      argument                  : REAL;
      result                    : REAL;
    BEGIN
      result:=0.0;
      IF argument_stack_head = NIL THEN
        set_error(
         'argument to "'+function_name+'" is missing')
      ELSE
        BEGIN
          argument:=pop_argument(argument_stack_head);
          IF argument_stack_head = NIL THEN
            IF argument >= 0.0 THEN
              result:=argument
            ELSE
              result:=-argument
          ELSE
            set_error(
             'extraneous argument supplied to function "'+
             function_name+'"')
        END;
      abs_function:=result
    END;
  FUNCTION arctan_function(VAR argument_stack_head : argument_record_ptr;
   VAR function_name : string_255) : REAL;
    VAR
      argument                  : REAL;
      result                    : REAL;
    BEGIN
      result:=0.0;
      IF argument_stack_head = NIL THEN
       set_error(
        'argument to "'+function_name+'" is missing')
      ELSE
        BEGIN
          argument:=pop_argument(argument_stack_head);
          IF argument_stack_head = NIL THEN
            result:=ARCTAN(argument)
          ELSE
            set_error(
             'extraneous argument supplied to function "'+
             function_name+'"')
        END;
      arctan_function:=result
    END;
  FUNCTION cos_function(VAR argument_stack_head : argument_record_ptr;
   VAR function_name : string_255) : REAL;
    VAR
      argument                  : REAL;
      result                    : REAL;
    BEGIN
      result:=0.0;
      IF argument_stack_head = NIL THEN
        set_error(
         'argument to "'+function_name+'" is missing')
      ELSE
        BEGIN
          argument:=pop_argument(argument_stack_head);
          IF argument_stack_head = NIL THEN
            result:=COS(argument)
          ELSE
            set_error(
             'extraneous argument supplied to function "'+
             function_name+'"')
        END;
      cos_function:=result
    END;
  FUNCTION exp_function(VAR argument_stack_head : argument_record_ptr;
   VAR function_name : string_255) : REAL;
    VAR
      argument                  : REAL;
      result                    : REAL;
      tem_real                  : REAL;
    BEGIN
      result:=0.0;
      IF argument_stack_head = NIL THEN
        set_error(
         'argument to "'+function_name+'" is missing')
      ELSE
        BEGIN
          argument:=pop_argument(argument_stack_head);
          IF argument_stack_head = NIL THEN
            BEGIN
              tem_real:=argument/LN(10.0);
              IF tem_real < -37.0 THEN
                result:=0.0
              ELSE
                IF tem_real > 37.0 THEN
                  set_error(
                   'overflow detected while calculating "'+
                   function_name+'"')
                ELSE
                  result:=EXP(argument)
            END
          ELSE
            set_error(
             'extraneous argument supplied to function "'+
             function_name+'"')
        END;
      exp_function:=result
    END;
  FUNCTION ln_function(VAR argument_stack_head : argument_record_ptr;
   VAR function_name : string_255) : REAL;
    VAR
      argument                  : REAL;
      result                    : REAL;
    BEGIN
      result:=0.0;
      IF argument_stack_head = NIL THEN
        set_error(
         'argument to "'+function_name+'" is missing')
      ELSE
        BEGIN
          argument:=pop_argument(argument_stack_head);
          IF argument_stack_head = NIL THEN
            IF argument <= 0.0 THEN
              set_error(
               'argument to "'+function_name+
               '" is other than positive')
            ELSE
              result:=LN(argument)
          ELSE
            set_error(
             'extraneous argument supplied to function "'+
             function_name+'"')
        END;
      ln_function:=result
    END;
  FUNCTION pi_function(VAR argument_stack_head : argument_record_ptr;
   VAR function_name : string_255) : REAL;
    VAR
      argument                  : REAL;
      result                    : REAL;
    BEGIN
      result:=0.0;
      IF argument_stack_head = NIL THEN
        result:=4.0*ARCTAN(1.0)
      ELSE
        set_error(
         'extraneous argument supplied to function "'+
         function_name+'"');
      pi_function:=result
    END;
  FUNCTION sin_function(VAR argument_stack_head : argument_record_ptr;
   VAR function_name : string_255) : REAL;
    VAR
      argument                  : REAL;
      result                    : REAL;
    BEGIN
      result:=0.0;
      IF argument_stack_head = NIL THEN
        set_error(
         'argument to "'+function_name+'" is missing')
      ELSE
        BEGIN
          argument:=pop_argument(argument_stack_head);
          IF argument_stack_head = NIL THEN
            result:=SIN(argument)
          ELSE
            set_error(
             'extraneous argument supplied to function "'+
             function_name+'"')
        END;
      sin_function:=result
    END;
  FUNCTION sqr_function(VAR argument_stack_head : argument_record_ptr;
   VAR function_name : string_255) : REAL;
    VAR
      argument                  : REAL;
      result                    : REAL;
      tem_real                  : REAL;
    BEGIN
      result:=0.0;
      IF argument_stack_head = NIL THEN
        set_error(
         'argument to "'+function_name+'" is missing')
      ELSE
        BEGIN
          argument:=pop_argument(argument_stack_head);
          IF argument_stack_head = NIL THEN
            IF argument = 0.0 THEN
              result:=0.0
            ELSE
              BEGIN
                tem_real:=2.0*LN(ABS(argument))/LN(10.0);
                IF tem_real < -37.0 THEN
                  result:=0.0
                ELSE
                  IF tem_real > 37.0 THEN
                    set_error(
                     'overflow detected during calculation of "'+
                     function_name+'"')
                  ELSE
                    result:=argument*argument
              END
          ELSE
            set_error(
             'extraneous argument supplied to function "'+
             function_name+'"')
        END;
      sqr_function:=result
    END;
  FUNCTION sqrt_function(VAR argument_stack_head : argument_record_ptr;
   VAR function_name : string_255) : REAL;
    VAR
      argument                  : REAL;
      result                    : REAL;
    BEGIN
      result:=0.0;
      IF argument_stack_head = NIL THEN
        set_error(
         'argument to "'+function_name+'" is missing')
      ELSE
        BEGIN
          argument:=pop_argument(argument_stack_head);
          IF argument_stack_head = NIL THEN
            IF argument < 0.0 THEN
              set_error(
               'argument to "'+function_name+
               '" is negative')
            ELSE
              result:=SQRT(argument)
          ELSE
            set_error(
             'extraneous argument supplied to function "'+
             function_name+'"')
        END;
      sqrt_function:=result
    END;
  FUNCTION simple_expression : REAL; FORWARD;
  FUNCTION funct : REAL;
    VAR
      argument                  : REAL;
      argument_stack_head       : argument_record_ptr;
      argument_stack_ptr        : argument_record_ptr;
      arguments_okay            : BOOLEAN;
      function_name             : string_255;
      non_alphanumeric_found    : BOOLEAN;
      result                    : REAL;
      right_parenthesis_found   : BOOLEAN;
      tem_char                  : CHAR;
    BEGIN
      result:=0.0;
      non_alphanumeric_found:=FALSE;
      function_name:='';
      WHILE((expression_index <= expression_length)
      AND   (NOT non_alphanumeric_found)) DO
        BEGIN
          tem_char:=expression[expression_index];
          tem_char:=UPCASE(tem_char);
          IF ((tem_char >= 'A') AND (tem_char <= 'Z')) THEN
            BEGIN
              function_name:=function_name+tem_char;
              expression_index:=expression_index+1
            END
          ELSE
            non_alphanumeric_found:=TRUE
        END;
      argument_stack_head:=NIL;
      arguments_okay:=TRUE;
      eat_leading_spaces;
      IF expression_index <= expression_length THEN
        BEGIN
          tem_char:=expression[expression_index];
          IF tem_char = '(' THEN
            BEGIN
              expression_index:=expression_index+1;
              right_parenthesis_found:=FALSE;
              WHILE ((NOT right_parenthesis_found)
              AND    (arguments_okay)
              AND    (expression_index <= expression_length)) DO
                BEGIN
                  argument:=simple_expression;
                  IF error_detected THEN
                    arguments_okay:=FALSE
                  ELSE
                    BEGIN
                      IF argument_stack_head = NIL THEN
                        BEGIN
                          NEW(argument_stack_head);
                          argument_stack_head^.value:=argument;
                          argument_stack_head^.next_ptr:=NIL
                        END
                      ELSE
                        BEGIN
                          NEW(argument_stack_ptr);
                          argument_stack_ptr^.value:=argument;
                          argument_stack_ptr^.next_ptr
                           :=argument_stack_head;
                          argument_stack_head:=argument_stack_ptr
                        END;
                      eat_leading_spaces;
                      IF expression_index <= expression_length THEN
                        BEGIN
                          tem_char:=expression[expression_index];
                          IF tem_char = ')' THEN
                            BEGIN
                              right_parenthesis_found:=TRUE;
                              expression_index:=expression_index+1
                            END
                          ELSE
                            IF tem_char = ',' THEN
                              expression_index:=expression_index+1
                            ELSE
                              BEGIN
                                arguments_okay:=FALSE;
                                set_error(
                            'comma missing from function arguments')
                              END
                        END
                    END
                END;
              IF arguments_okay THEN
                BEGIN
                  IF (NOT right_parenthesis_found) THEN
                    BEGIN
                      arguments_okay:=FALSE;
                      set_error(
                   '")" to terminate function arguments is missing')
                    END
                END
            END
        END;
      IF arguments_okay THEN
        BEGIN
          IF function_name = 'ABS' THEN
            result
             :=abs_function(argument_stack_head,function_name)
          ELSE
            IF function_name = 'ARCTAN' THEN
              result
               :=arctan_function(argument_stack_head,function_name)
            ELSE
              IF function_name = 'COS' THEN
                result
                 :=cos_function(argument_stack_head,function_name)
              ELSE
                IF function_name = 'EXP' THEN
                  result
                   :=exp_function(argument_stack_head,function_name)
                ELSE
                  IF function_name = 'LN' THEN
                    result
                     :=ln_function(argument_stack_head,function_name)
                  ELSE
                    IF function_name = 'PI' THEN
                      result
                       :=pi_function(argument_stack_head,function_name)
                    ELSE
                      IF function_name = 'SIN' THEN
                        result
                         :=sin_function(argument_stack_head,function_name)
                      ELSE
                        IF function_name = 'SQR' THEN
                          result
                           :=sqr_function(argument_stack_head,function_name)
                        ELSE
                          IF function_name = 'SQRT' THEN
                            result
                             :=sqrt_function(argument_stack_head,function_name)
                          ELSE
                            set_error('the function "'+
                             function_name+'" is unrecognized')
        END;
      WHILE (argument_stack_head <> NIL) DO
        BEGIN
          argument_stack_ptr:=argument_stack_head^.next_ptr;
          DISPOSE(argument_stack_head);
          argument_stack_head:=argument_stack_ptr
        END;
      funct:=result
    END;
  FUNCTION factor : REAL;
    VAR
      result                    : REAL;
      tem_char                  : CHAR;
    BEGIN
      result:=0.0;
      eat_leading_spaces;
      IF expression_index > expression_length THEN
        set_error(
         'end of expression encountered where factor expected')
      ELSE
        BEGIN
          tem_char:=expression[expression_index];
          BEGIN
            IF tem_char = '(' THEN
              BEGIN
                expression_index:=expression_index+1;
                result:=simple_expression;
                IF (NOT error_detected) THEN
                  BEGIN
                    eat_leading_spaces;
                    IF expression_index > expression_length THEN
                      set_error(
                       'end of expression encountered '+
                       'where ")" was expected')
                    ELSE
                      IF expression[expression_index] = ')' THEN
                        expression_index:=expression_index+1
                      ELSE
                        set_error('expression not followed by ")"')
                  END
              END
            ELSE
              IF ((tem_char >= '0') AND (tem_char <= '9')) THEN
                result:=unsigned_number
              ELSE
                IF (((tem_char >= 'a') AND (tem_char <= 'z'))
                OR  ((tem_char >= 'A') AND (tem_char <= 'Z'))) THEN
                  result:=funct
                ELSE
                  set_error(
                   'function, unsigned number, or "(" expected')
          END
        END;
      factor:=result
    END;
  FUNCTION quotient_of_factors(VAR left_value,right_value : REAL) : REAL;
    VAR
      result                    : REAL;
      tem_real                  : REAL;
    BEGIN
      result:=0.0;
      IF right_value = 0.0 THEN
        set_error('division by zero attempted')
      ELSE
        BEGIN
          IF left_value = 0.0 THEN
            result:=0.0
          ELSE
            BEGIN
              tem_real:=(LN(ABS(left_value))-LN(ABS(right_value)))/LN(10.0);
              IF tem_real < -37.0 THEN
                result:=0.0
              ELSE
                IF tem_real > 37.0 THEN
                  set_error(
                   'overflow detected during division')
                ELSE
                  result:=left_value/right_value
            END
        END;
      quotient_of_factors:=result
    END;
  FUNCTION product_of_factors(VAR left_value,right_value : REAL) : REAL;
    VAR
      result                    : REAL;
      tem_real                  : REAL;
    BEGIN
      result:=0.0;
      IF ((left_value <> 0.0) AND (right_value <> 0.0)) THEN
        BEGIN
          tem_real:=(LN(ABS(left_value))+LN(ABS(right_value)))/LN(10.0);
          IF tem_real < -37.0 THEN
            result:=0.0
          ELSE
            IF tem_real > 37.0 THEN
              set_error(
               'overflow detected during multiplication')
            ELSE
              result:=left_value*right_value
        END;
      product_of_factors:=result
    END;
  FUNCTION factor_operator : string_1;
    VAR
      result                    : string_1;
    BEGIN
      eat_leading_spaces;
      IF expression_index <= expression_length THEN
        BEGIN
          result:=expression[expression_index];
          IF ((result = '*')
          OR  (result = '/')) THEN
            expression_index:=expression_index+1
        END
      ELSE
        result:='';
      factor_operator:=result
    END;
  FUNCTION term : REAL;
    VAR
      operator                  : string_1;
      operator_found            : BOOLEAN;
      result                    : REAL;
      right_value               : REAL;
    BEGIN
      result:=0;
      eat_leading_spaces;
      IF expression_index > expression_length THEN
        set_error(
         'end of expression encountered where term was expected')
      ELSE
        BEGIN
          result:=factor;
          operator_found:=TRUE;
          WHILE((NOT error_detected)
          AND   (operator_found)) DO
            BEGIN
              operator:=factor_operator;
              IF LENGTH(operator) = 0 THEN
                operator_found:=FALSE
              ELSE
                IF ((operator <> '*')
                AND (operator <> '/')) THEN
                  operator_found:=FALSE
                ELSE
                  BEGIN
                    right_value:=factor;
                    IF (NOT error_detected) THEN
                      BEGIN
                        IF operator = '*' THEN
                            result:=product_of_factors(
                             result,right_value)
                        ELSE
                            result:=quotient_of_factors(
                             result,right_value)
                      END
                  END
            END
        END;
      term:=result
    END;
  FUNCTION sum_of_terms(VAR left_value,right_value : REAL) : REAL;
    VAR
      result                    : REAL;
    BEGIN
      result:=0.0;
      IF ((left_value > 0.0) AND (right_value > 0.0)) THEN
        IF left_value > (1.0E37 - right_value) THEN
          set_error('overflow detected during addition')
        ELSE
          result:=left_value+right_value
      ELSE
        IF ((left_value < 0.0) AND (right_value < 0.0)) THEN
          IF left_value < (-1.0E37 - right_value) THEN
            set_error('overflow detected during addition')
          ELSE
            result:=left_value+right_value
        ELSE
          result:=left_value+right_value;
      sum_of_terms:=result
    END;
  FUNCTION difference_of_terms(VAR left_value,right_value : REAL) : REAL;
    VAR
      result                    : REAL;
    BEGIN
      IF ((left_value < 0.0) AND (right_value > 0.0)) THEN
        IF left_value < (right_value - 1.0E37) THEN
          set_error('overflow detected during subtraction')
        ELSE
          result:=left_value-right_value
      ELSE
        IF ((left_value > 0.0) AND (right_value < 0.0)) THEN
          IF left_value > (right_value + 1.0E37) THEN
            set_error('overflow detected during subtraction')
          ELSE
            result:=left_value-right_value
        ELSE
          result:=left_value-right_value;
      difference_of_terms:=result
    END;
  FUNCTION term_operator : string_1;
    VAR
      result                    : string_1;
    BEGIN
      eat_leading_spaces;
      IF expression_index <= expression_length THEN
        BEGIN
          result:=expression[expression_index];
          IF ((result = '+')
          OR  (result = '-')) THEN
            expression_index:=expression_index+1
        END
      ELSE
        result:='';
      term_operator:=result
    END;
  FUNCTION simple_expression;
    VAR
      leading_sign              : CHAR;
      operator                  : string_1;
      operator_found            : BOOLEAN;
      result                    : REAL;
      right_value               : REAL;
      tem_char                  : CHAR;
    BEGIN
      result:=0.0;
      eat_leading_spaces;
      IF expression_index > expression_length THEN
        set_error(
       'end of expression encountered where simple expression expected')
      ELSE
        BEGIN
          leading_sign:=' ';
          tem_char:=expression[expression_index];
          IF ((tem_char = '+') OR (tem_char = '-')) THEN
            BEGIN
              leading_sign:=tem_char;
              expression_index:=expression_index+1
            END;
          result:=term;
          IF (NOT error_detected) THEN
            BEGIN
              IF leading_sign <> ' ' THEN
                BEGIN
                  IF leading_sign = '-' THEN
                    result:=-result
                END;
              operator_found:=TRUE;
              WHILE((NOT error_detected)
              AND   (operator_found)) DO
                BEGIN
                  operator:=term_operator;
                  IF LENGTH(operator) = 0 THEN
                    operator_found:=FALSE
                  ELSE
                    IF ((operator <> '+')
                    AND (operator <> '-')) THEN
                      operator_found:=FALSE
                    ELSE
                      BEGIN
                        right_value:=term;
                        IF (NOT error_detected) THEN
                          BEGIN
                            IF operator = '+' THEN
                              result:=sum_of_terms(
                               result,right_value)
                            ELSE
                              result:=difference_of_terms(
                               result,right_value)
                          END
                      END
                END
            END
        END;
      simple_expression:=result
    END;
  PROCEDURE output_value(VAR result : REAL);
    VAR
      digits_in_integer_part       : INTEGER;
      magnitude_of_result          : REAL;
    BEGIN
      WRITE(OUTPUT,'Value:  ');
      IF result >= 0.0 THEN
        magnitude_of_result:=result
      ELSE
        magnitude_of_result:=-result;
      IF magnitude_of_result >= 5.0E-3 THEN
        BEGIN
          digits_in_integer_part:=0;
          WHILE ((digits_in_integer_part <= 8)
          AND    (magnitude_of_result >= 1.0)) DO
            BEGIN
              magnitude_of_result:=magnitude_of_result/10.0;
              digits_in_integer_part:=digits_in_integer_part+1
            END;
          IF digits_in_integer_part > 8 THEN
            WRITELN(OUTPUT,result:13)
          ELSE
            WRITELN(OUTPUT,result:10:8-digits_in_integer_part)
        END
      ELSE
        WRITELN(OUTPUT,result:13)
    END;
  PROCEDURE output_error(
   error_msg : string_255;
   VAR expression : string_255;
   VAR expression_index : INTEGER);
    VAR
      error_index               : INTEGER;
    BEGIN
      WRITELN(OUTPUT,error_msg);
      WRITELN(OUTPUT,expression);
      error_index:=1;
      WHILE (error_index < expression_index) DO
        BEGIN
          WRITE(OUTPUT,' ');
          error_index:=error_index+1
        END;
      WRITELN(OUTPUT,'*')
    END;
  BEGIN
    REPEAT
      WRITELN(OUTPUT,' ');
      WRITE(OUTPUT,'Expression (RETURN to exit)?  ');
      READLN(INPUT,expression);
      expression_length:=LENGTH(expression);
      IF expression_length > 0 THEN
        BEGIN
          error_detected:=FALSE;
          expression_index:=1;
          result:=simple_expression;
          IF error_detected THEN
            output_error(error_msg,expression,expression_index)
          ELSE
            BEGIN
              eat_leading_spaces;
              IF expression_index <= expression_length THEN
                output_error(
                 'Error:  expression followed by garbage',
                 expression,expression_index)
              ELSE
                output_value(result)
            END
        END
    UNTIL (expression_length = 0)
  END.