unit P10Build;

{.$DEFINE DEBUG}
{$IFNDEF DEBUG}
  {$D-} {$L-} {$Q-} {$R-} {$S-}
{$ENDIF}

{$IFDEF Win32}
  {$LONGSTRINGS ON}
  {$S-}
{$ENDIF}

{$I+} { I/O checking is always on }

interface

uses
  Parser10,
  SysUtils, Classes;


procedure ParseFunction( FunctionString: string; { the unparsed string }
                         Variables: TStringlist; { list of variables }

                         { lists of available functions }
                         FunctionOne,               { functions with ONE argument, e.g. exp() }
                         FunctionTwo: TStringList;  { functions with TWO arguments, e.g. max(,) }

                         UsePascalNumbers: boolean; { true: -> Val; false: StrToFloat }

                         { return pointer to tree, number of performed operations and error state }
                         var FirstOP : POperation;

                         var Error : boolean);
                         { error actually is superfluous as we are now using exceptions }



implementation

{$IFDEF VER100}
resourcestring
{$ELSE}
const
{$ENDIF}
  msgErrBlanks = 'Expression has blanks';
  msgMissingBrackets = 'Missing brackets in expression';
  msgParseError = 'Error parsing expression:';
  msgNestings = 'Expression contains too many nestings';
  msgTooComplex = 'Expression is too complex';
  msgInternalError = 'TParser internal error';

const
  TokenOperators = [ sum, diff, prod, divis, modulo, IntDiv,
                     integerpower, realpower];

type
  TermString = {$IFDEF Win32} string {$ELSE} PString {$ENDIF};


procedure ParseFunction( FunctionString: string;
                         Variables: TStringList;

                         FunctionOne,
                         FunctionTwo: TStringList;

                         UsePascalNumbers: boolean;

                         var FirstOP: POperation;

                         var Error: boolean);


          function CheckNumberBrackets(const s: string): boolean; forward;
          { checks whether number of ( = number of ) }

          function CheckNumber(const s: string; var FloatNumber: ParserFloat): boolean; forward;
          { checks whether s is a number }

          function CheckVariable(const s: string; var VariableID: integer): boolean; forward;
          { checks whether s is a variable string }

          function CheckTerm(var s1: string): boolean; forward;
          { checks whether s is a valid term }

          function CheckBracket(const s: string; var s1: string): boolean; forward;
          { checks whether s =(...(s1)...) and s1 is a valid term }



          function CheckNegate(const s: string; var s1: string): boolean; forward;
          {checks whether s denotes the negative value of a valid operation}



          function CheckAdd(const s: string; var s1, s2: string): boolean; forward;
          {checks whether + is the primary operation in s}

          function CheckSubtract(const s: string; var s1, s2: string): boolean; forward;
          {checks whether - is the primary operation in s}

          function CheckMultiply(const s: string; var s1, s2: string): boolean; forward;
          {checks whether * is the primary operation in s}

          function CheckIntegerDiv(const s: string; var s1, s2: string): boolean; forward;
          {checks whether DIV is the primary TOperation in s}

          function CheckModulo(const s: string; var s1, s2: string): boolean; forward;
          {checks whether MOD is the primary TOperation in s}

          function CheckRealDivision(const s: string; var s1, s2: string): boolean;  forward;
          {checks whether / is the primary operation in s}



          function CheckFuncTwoVar(const s: string; var s1, s2: string): boolean; forward;
          {checks whether s=f(s1,s2); s1,s2 being valid terms}

          function CheckFuncOneVar(const s: string; var s1: string): boolean; forward;
          {checks whether s denotes the evaluation of a function fsort(s1)}


          function CheckPower(const s: string; var s1, s2: string; var AToken: TToken): boolean; forward;


          function CheckNumberBrackets(const s: string):boolean;
          {checks whether # of '(' equ. # of ')'}
          var
            counter,
            bracket : integer;
          begin
            bracket := 0;

            counter := length(s);
            while counter <> 0 do
            begin
              case s[counter] of
                '(': inc(bracket);
                ')': dec(bracket);
              end;
              dec(counter);
            end;

            Result := bracket = 0;
          end;


          function CheckNumber(const s: string; var FloatNumber: ParserFloat):boolean;
          {checks whether s is a number}
          var
            code: integer;
          {$IFDEF Debug} { prevent debugger from showing conversion errors }
            SaveClass : TClass;
          {$ENDIF}
            //Tolik 24/01/2022 --
            function StrToFloat_My(const S: string; const AFormatSettings: TFormatSettings): Extended;
            var ss: string;
            begin              
              ss := s;
              
              if formatSettings.DecimalSeparator = ',' then
                StringReplace(ss, '.', formatSettings.DecimalSeparator, [rfReplaceAll])              
              else
              if formatSettings.DecimalSeparator = '.' then
                StringReplace(ss, ',', formatSettings.DecimalSeparator, [rfReplaceAll]);

              Result := StrToFloat(ss, AFormatSettings);
            end;
            //
          begin
            if s = 'PI' then
            begin
              FloatNumber := Pi;
              Result := true;
            end
            else
            if s = '-PI' then
            begin
              FloatNumber := -Pi;
              Result := true;
            end
            else
            begin
              if UsePascalNumbers then
              begin
                val(s, FloatNumber, code);
                Result := code = 0;
              end
              else
              begin
                {$IFDEF Debug}
                  SaveClass := ExceptionClass;
                  ExceptionClass := nil;
                  try
                {$ENDIF}
                  try
                    FloatNumber := StrToFloat_My(s, FormatSettings);
                    Result := true
                  except
                    on E: Exception do
                    begin
                      Result := false;
                    end;
                  end;
                {$IFDEF Debug}
                  finally
                    ExceptionClass := SaveClass;
                  end;
                {$ENDIF}
              end;
            end; 
          end;


          function CheckVariable(const s: string; var VariableID: integer): boolean;
          {checks whether s is a variable string}
          begin
            Result := Variables.Find(s, VariableID);
          end;


          function CheckTerm(var s1: string) :boolean;
          { checks whether s is a valid term }
          var
            s2, s3: TermString;
            FloatNumber: ParserFloat;
            fsort: TToken;
            VariableID: integer;
          begin
            Result := false;

            if length(s1) = 0 then
              exit;

            {$IFNDEF Win32}
              new(s2);
              new(s3);
              try
            {$ENDIF}

            if CheckNumber(s1, FloatNumber) or
               CheckVariable(s1, VariableID) or
               CheckNegate(s1, s2{$IFNDEF Win32}^{$ENDIF}) or
               CheckAdd(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}) or
               CheckSubtract(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}) or
               CheckMultiply(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}) or
               CheckIntegerDiv(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}) or
               CheckModulo(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}) or
               CheckRealDivision(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}) or
               CheckPower(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}, fsort) or
               CheckFuncTwoVar(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}) or
               CheckFuncOneVar(s1, s2{$IFNDEF Win32}^{$ENDIF})
            then
              Result := true
            else
              if CheckBracket(s1, s2{$IFNDEF Win32}^{$ENDIF}) then
              begin
                s1 := s2{$IFNDEF Win32}^{$ENDIF};
                Result := true
              end;

            {$IFNDEF Win32}
              finally
                dispose(s2);
                dispose(s3);
              end;
            {$ENDIF}
          end;

          function CheckBracket(const s: string; var s1: string): boolean;
          {checks whether s =(...(s1)...) and s1 is a valid term}
          var
            SLen : integer;
          begin
            Result := false;

            SLen := Length(s);
            if (SLen > 0) and (s[SLen] = ')') and (s[1] = '(') then
            begin
              s1 := copy(s, 2, SLen-2);
              Result := CheckTerm(s1);
            end;
          end;


          function CheckNegate(const s: string; var s1: string) :boolean;
          {checks whether s denotes the negative value of a valid TOperation}
          var
            s2, s3: TermString;
            fsort: TToken;
            VariableID: integer;
          begin
            Result := false;

            if (length(s) <> 0) and (s[1] = '-') then
            begin
              {$IFNDEF Win32}
                new(s2);
                new(s3);
                try
              {$ENDIF}

              s1 := copy(s, 2, length(s)-1);
              if CheckBracket(s1, s2{$IFNDEF Win32}^{$ENDIF}) then
              begin
                s1 := s2{$IFNDEF Win32}^{$ENDIF};
                Result := true;
              end
              else
                Result :=
                  CheckVariable(s1, VariableID) or
                  CheckPower(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}, fsort) or
                  CheckFuncOneVar(s1, s2{$IFNDEF Win32}^{$ENDIF}) or
                  CheckFuncTwoVar(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF});

              {$IFNDEF Win32}
                finally
                  dispose(s2);
                  dispose(s3);
                end;
              {$ENDIF}
            end;
          end;


          function CheckAdd(const s: string; var s1, s2: string): boolean;
          {checks whether '+' is the primary TOperation in s}
          var
            s3, s4: TermString;
            i, j: integer;
            FloatNumber: ParserFloat;
            fsort: TToken;
            VariableID: integer;
          begin
            Result := false;

            i := 0;
            j := length(s);
            repeat

              while i <> j do
              begin
                inc(i);
                if s[i] = '+' then
                  break;
              end;

              if (i > 1) and (i < j) then
              begin
                s1 := copy(s, 1, i-1);
                s2 := copy(s, i+1, j-i);

                Result := CheckNumberBrackets(s1) and CheckNumberBrackets(s2);

                if Result then
                begin
                  Result := CheckVariable(s1, VariableID) or CheckNumber(s1, FloatNumber);

                  {$IFNDEF Win32}
                    new(s3);
                    new(s4);
                    try
                  {$ENDIF}

                  if not Result then
                  begin
                    Result := CheckBracket(s1, s3{$IFNDEF Win32}^{$ENDIF});
                    if Result then
                      s1 := s3{$IFNDEF Win32}^{$ENDIF};
                  end;

                  if not Result then
                    Result := CheckNegate(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                              CheckSubtract(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckMultiply(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckIntegerDiv(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckModulo(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckRealDivision(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckPower(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}, fsort) or
                              CheckFuncOneVar(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                              CheckFuncTwoVar(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});

                  if Result then
                  begin
                    Result := CheckVariable(s2, VariableID) or CheckNumber(s2, FloatNumber);

                    if not Result then
                    begin
                      Result := CheckBracket(s2, s3{$IFNDEF Win32}^{$ENDIF});
                      if Result then
                        s2 := s3{$IFNDEF Win32}^{$ENDIF}
                      else
                        Result := CheckAdd(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckSubtract(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckMultiply(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckIntegerDiv(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckModulo(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckRealDivision(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckPower(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}, fsort) or
                                  CheckFuncOneVar(s2, s3{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckFuncTwoVar(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});
                    end;
                  end;

                  {$IFNDEF Win32}
                    finally
                      dispose(s3);
                      dispose(s4);
                    end;
                  {$ENDIF}

                end;
              end
              else
                break;

            until Result;
          end;



          function CheckSubtract(const s: string; var s1, s2: string): boolean;
          {checks whether '-' is the primary TOperation in s}
          var
            s3, s4: TermString;
            i, j: integer;
            FloatNumber: ParserFloat;
            fsort: TToken;
            VariableID: integer;
          begin
            Result := false;

            i := 0;
            j := length(s);

            repeat

              while i <> j do
              begin
                inc(i);
                if s[i] = '-' then
                  break;
              end;

              if (i > 1) and (i < j) then
              begin
                s1 := copy(s, 1, i-1);
                s2 := copy(s, i+1, j-i);

                Result := CheckNumberBrackets(s1) and CheckNumberBrackets(s2);

                if Result then
                begin
                  Result := CheckVariable(s1, VariableID) or CheckNumber(s1, FloatNumber);

                  {$IFNDEF Win32}
                    new(s3);
                    new(s4);
                    try
                  {$ENDIF}

                  if not Result then
                  begin
                    Result := CheckBracket(s1, s3{$IFNDEF Win32}^{$ENDIF});
                    if Result then
                      s1 := s3{$IFNDEF Win32}^{$ENDIF};
                  end;
                  if not Result then
                    Result := CheckNegate(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                              CheckSubtract(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckMultiply(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckIntegerDiv(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckModulo(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckRealDivision(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckPower(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}, fsort) or
                              CheckFuncOneVar(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                              CheckFuncTwoVar(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});

                  if Result then
                  begin
                    Result := CheckVariable(s2, VariableID) or CheckNumber(s2, FloatNumber);

                    if not Result then
                    begin
                       Result := CheckBracket(s2, s3{$IFNDEF Win32}^{$ENDIF});
                       if Result then
                         s2 := s3{$IFNDEF Win32}^{$ENDIF}
                       else
                         Result := CheckMultiply(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                 CheckIntegerDiv(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                 CheckModulo(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                 CheckRealDivision(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                 CheckPower(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}, fsort) or
                                 CheckFuncOneVar(s2, s3{$IFNDEF Win32}^{$ENDIF}) or
                                 CheckFuncTwoVar(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});
                    end;
                  end;

                  {$IFNDEF Win32}
                    finally
                      dispose(s3);
                      dispose(s4);
                    end;
                  {$ENDIF}

                end;
              end
              else
                break;

            until Result;

          end;


          function CheckMultiply(const s: string; var s1, s2: string): boolean;
          {checks whether '*' is the primary TOperation in s}
          var
            s3, s4: TermString;
            i, j: integer;
            FloatNumber: ParserFloat;
            fsort: TToken;
            VariableID: integer;
          begin
            Result := false;

            i := 0;
            j := length(s);

            repeat
              while i <> j do
              begin
                inc(i);
                if s[i] = '*' then
                  break;
              end;

              if (i > 1) and (i < j) then
              begin
                s1 := copy(s, 1, i-1);
                s2 := copy(s, i+1, j-i);

                Result := CheckNumberBrackets(s1) and CheckNumberBrackets(s2);

                if Result then
                begin
                  Result := CheckVariable(s1, VariableID) or
                            CheckNumber(s1, FloatNumber);

                  {$IFNDEF Win32}
                    new(s3);
                    new(s4);
                    try
                  {$ENDIF}

                  if not Result then
                  begin
                    Result := CheckBracket(s1, s3{$IFNDEF Win32}^{$ENDIF});
                    if Result then
                      s1 := s3{$IFNDEF Win32}^{$ENDIF};
                  end;

                  if not Result then
                    Result := CheckNegate(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                              CheckIntegerDiv(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckModulo(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckRealDivision(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckPower(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}, fsort) or
                              CheckFuncOneVar(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                              CheckFuncTwoVar(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});

                  if Result then
                  begin
                    Result := CheckVariable(s2, VariableID) or
                              CheckNumber(s2, FloatNumber);

                    if not Result then
                    begin
                      Result := CheckBracket(s2, s3{$IFNDEF Win32}^{$ENDIF});
                      if Result then
                        s2 := s3{$IFNDEF Win32}^{$ENDIF}
                      else
                        Result := CheckMultiply(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckIntegerDiv(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckModulo(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckRealDivision(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckPower(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}, fsort) or
                                  CheckFuncOneVar(s2, s3{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckFuncTwoVar(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});
                    end;
                  end;

                  {$IFNDEF Win32}
                    finally
                      dispose(s3);
                      dispose(s4);
                    end;
                  {$ENDIF}

                end;
              end
              else
                break;

            until Result;
          end;


          function CheckIntegerDiv(const s: string; var s1, s2: string): boolean;
          {checks whether 'DIV' is the primary TOperation in s}
          var
            s3, s4: TermString;
            i, j: integer;
            VariableID: integer;
            FloatNumber: ParserFloat;
            fsort: TToken;
          begin
            Result := false;

            i := 0;

            repeat

              j := pos('DIV', copy(s, i+1, length(s)-i));
              if j > 0 then
              begin

                inc(i, j);
                if (i > 1) and (i < length(s)) then
                begin
                  s1 := copy(s, 1, i-1);
                  s2 := copy(s, i+3, length(s)-i-2);

                  Result := CheckNumberBrackets(s1) and CheckNumberBrackets(s2);

                  if Result then
                  begin
                    Result := CheckVariable(s1, VariableID) or
                              CheckNumber(s1, FloatNumber);

                    {$IFNDEF Win32}
                      new(s3);
                      new(s4);
                      try
                    {$ENDIF}

                    if not Result then
                    begin
                      Result := CheckBracket(s1, s3{$IFNDEF Win32}^{$ENDIF});
                      if Result then
                        s1 := s3{$IFNDEF Win32}^{$ENDIF};
                    end;

                    if not Result then
                      Result := CheckNegate(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                                CheckIntegerDiv(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                CheckModulo(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                CheckRealDivision(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                CheckPower(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}, fsort) or
                                CheckFuncOneVar(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                                CheckFuncTwoVar(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});
                    if Result then
                    begin
                      Result := CheckVariable(s2,VariableID) or
                                CheckNumber(s2,FloatNumber);

                      if not Result then
                      begin
                        Result := CheckBracket(s2, s3{$IFNDEF Win32}^{$ENDIF});
                        if Result then
                          s2 := s3{$IFNDEF Win32}^{$ENDIF}
                        else
                          Result := CheckPower(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}, fsort) or
                                    CheckFuncOneVar(s2, s3{$IFNDEF Win32}^{$ENDIF}) or
                                    CheckFuncTwoVar(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});
                      end;
                    end;

                    {$IFNDEF Win32}
                      finally
                        dispose(s3);
                        dispose(s4);
                      end;
                    {$ENDIF}

                  end;
                end;
              end;

            until Result or (j = 0) or (i >= length(s));
          end;

          function CheckModulo(const s: string; var s1, s2: string): boolean;
          {checks whether 'MOD' is the primary TOperation in s}
          var
            s3, s4: TermString;
            i, j: integer;
            VariableID: integer;
            FloatNumber: ParserFloat;
            fsort: TToken;
          begin
            Result := false;

            i := 0;
            repeat
              j := pos('MOD', copy(s, i+1, length(s)-i));
              if j > 0 then
              begin

                inc(i, j);
                if (i > 1) and (i < length(s)) then
                begin
                  s1 := copy(s, 1, i-1);
                  s2 := copy(s, i+3, length(s)-i-2);

                  Result := CheckNumberBrackets(s1) and CheckNumberBrackets(s2);

                  if Result then
                  begin
                    Result := CheckVariable(s1, VariableID) or
                              CheckNumber(s1, FloatNumber);

                    {$IFNDEF Win32}
                      new(s3);
                      new(s4);
                      try
                    {$ENDIF}

                    if not Result then
                    begin
                      Result := CheckBracket(s1, s3{$IFNDEF Win32}^{$ENDIF});
                      if Result then
                        s1 := s3{$IFNDEF Win32}^{$ENDIF};
                    end;
                    if not Result then
                      Result := CheckNegate(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                                CheckIntegerDiv(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                CheckModulo(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                CheckRealDivision(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                CheckPower(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}, fsort) or
                                CheckFuncOneVar(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                                CheckFuncTwoVar(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});

                    if Result then
                    begin
                      Result := CheckVariable(s2, VariableID) or
                                CheckNumber(s2, FloatNumber);

                      if not Result then
                      begin
                        Result := CheckBracket(s2, s3{$IFNDEF Win32}^{$ENDIF});
                        if Result then
                          s2 := s3{$IFNDEF Win32}^{$ENDIF}
                        else
                          Result := CheckPower(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}, fsort) or
                                    CheckFuncOneVar(s2, s3{$IFNDEF Win32}^{$ENDIF}) or
                                    CheckFuncTwoVar(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});

                      end
                    end;

                    {$IFNDEF Win32}
                      finally
                        dispose(s3);
                        dispose(s4);
                      end;
                    {$ENDIF}

                  end;
                end;
              end;
            until Result or (j = 0) or (i >= length(s));
          end;

          function CheckRealDivision(const s: string; var s1, s2: string): boolean;
          {checks whether '/' is the primary TOperation in s}
          var
            s3, s4: TermString;
            i, j: integer;
            VariableID: integer;
            FloatNumber: ParserFloat;
            fsort: TToken;
          begin
            Result := false;

            i := 0;
            j := length(s);

            repeat

              while i <> j do
              begin
                inc(i);
                if s[i] = '/' then
                  break;
              end;

              if (i > 1) and (i < j) then
              begin
                s1 := copy(s, 1, i-1);
                s2 := copy(s, i+1, j-i);

                Result := CheckNumberBrackets(s1) and CheckNumberBrackets(s2);

                if Result then
                begin
                  Result := CheckVariable(s1, VariableID) or
                            CheckNumber(s1, FloatNumber);

                  {$IFNDEF Win32}
                    new(s3);
                    new(s4);
                    try
                  {$ENDIF}

                  if not Result then
                  begin
                    Result := CheckBracket(s1, s3{$IFNDEF Win32}^{$ENDIF});
                    if Result then
                      s1 := s3{$IFNDEF Win32}^{$ENDIF};
                  end;

                  if not Result then
                    Result := CheckNegate(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                              CheckIntegerDiv(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckModulo(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckRealDivision(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckPower(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}, fsort) or
                              CheckFuncOneVar(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                              CheckFuncTwoVar(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});

                  if Result then
                  begin
                    Result := CheckVariable(s2, VariableID) or
                              CheckNumber(s2, FloatNumber);

                    if not Result then
                    begin
                      Result := CheckBracket(s2, s3{$IFNDEF Win32}^{$ENDIF});
                      if Result then
                        s2 := s3{$IFNDEF Win32}^{$ENDIF}
                      else
                        Result := CheckPower(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}, fsort) or
                                  CheckFuncOneVar(s2, s3{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckFuncTwoVar(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});

                    end;
                  end;

                  {$IFNDEF Win32}
                    finally
                      dispose(s3);
                      dispose(s4);
                    end;
                  {$ENDIF}

                end;
              end
              else
                break;

            until Result;
          end;


          function CheckFuncTwoVar(const s: string; var s1, s2: string): boolean;
          {checks whether s=f(s1,s2); s1,s2 being valid terms}

            function CheckComma(const s: string; var s1, s2: string): boolean;
            var
              i, j: integer;
            begin
              Result := false;

              i := 0;
              j := length(s);
              repeat

                while i <> j do
                begin
                  inc(i);
                  if s[i] = ',' then
                    break;
                end;

                if (i > 1) and (i < j) then
                begin
                  s1 := copy(s, 1, i-1);
                  if CheckTerm(s1) then
                  begin
                    s2 := copy(s, i+1, j-i);
                    Result := CheckTerm(s2);
                  end;

                end
                else
                  break;

              until Result;
            end;

          var
            SLen,
            counter : integer;
          begin

            Result := false;

            SLen := Pos('(', s);
            dec(SLen);

            if (SLen > 0) and (s[length(s)] = ')') then
            begin
              if FunctionTwo.Find(copy(s, 1, SLen), counter) then
              begin
                inc(SLen, 2);
                Result := CheckComma( copy(s, SLen, length(s)-SLen), s1, s2);
              end;
            end;
          end;


          function CheckFuncOneVar(const s: string; var s1: string): boolean;
          {checks whether s denotes the evaluation of a function fsort(s1)}
          var
          {$IFNDEF Win32}
            s2: TermString;
          {$ENDIF}
            counter: integer;
            SLen: integer;
          begin
            Result := false;

            SLen := Pos('(', s);
            dec(SLen);

            if (SLen > 0) then
            begin
              if FunctionOne.Find(copy(s, 1, SLen), counter) then
              begin
              {$IFNDEF Win32}
                new(s2);
                try
                  s2^ := copy(s, SLen+1, length(s)-SLen);
                  Result := CheckBracket(s2^, s1);
                finally
                  dispose(s2);
                end;
              {$ELSE}
                Result := CheckBracket(copy(s, SLen+1, length(s)-SLen), s1);
              {$ENDIF}
              end;
            end;
          end;



          function CheckPower(const s: string; var s1, s2: string; var AToken: TToken): boolean;
          var
            s3, s4: TermString;
            i, j: integer;
            FloatNumber: ParserFloat;
            VariableID: integer;
          begin
            Result := false;

            i := 0;
            j := length(s);
            repeat

              while i <> j do
              begin
                inc(i);
                if s[i] = '^' then
                  break;
              end;

              if (i > 1) and (i < j) then
              begin
                s1 := copy(s, 1, i-1);
                s2 := copy(s, i+1, j-i);

                Result := CheckNumberBrackets(s1) and CheckNumberBrackets(s2);

                if Result then
                begin
                  Result := CheckVariable(s1, VariableID) or CheckNumber(s1, FloatNumber);

                  {$IFNDEF Win32}
                    new(s3);
                    new(s4);
                    try
                  {$ENDIF}

                  if not Result then
                  begin
                    Result := CheckBracket(s1, s3{$IFNDEF Win32}^{$ENDIF});
                    if Result then
                      s1 := s3{$IFNDEF Win32}^{$ENDIF};
                  end;

                  if not Result then
                    Result := CheckFuncOneVar(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                              CheckFuncTwoVar(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});

                  if Result then
                  begin

                    if CheckNumber(s2, FloatNumber) then
                    begin
                      i := trunc(FloatNumber);

                      if (i <> FloatNumber) then
                      begin
                        { this is a real number }
                        AToken := realpower;
                      end
                      else
                      begin
                        case i of
                          2: AToken := square;
                          3: AToken := third;
                          4: AToken := fourth;
                        else
                          AToken := integerpower;
                        end;
                      end;
                    end
                    else
                    begin
                      Result := CheckVariable(s2, VariableID);

                      if not Result then
                      begin
                        Result := CheckBracket(s2, s3{$IFNDEF Win32}^{$ENDIF});
                        if Result then
                          s2 := s3{$IFNDEF Win32}^{$ENDIF};
                      end;

                      if not Result then
                      begin
                        Result := CheckFuncOneVar(s2, s3{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckFuncTwoVar(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});
                      end;

                      if Result then
                        AToken := realPower;
                    end;
                  end;

                  {$IFNDEF Win32}
                    finally
                      dispose(s3);
                      dispose(s4);
                    end;
                  {$ENDIF}

                end;
              end
              else
                break;

            until Result;
          end;

          function CreateOperation(const Term: TToken; const Proc: Pointer): POperation;
          begin
            new(Result);
            with Result^ do
            begin
              Arg1 := nil;
              Arg2 := nil;
              Dest := nil;

              NextOperation := nil;

              Token := Term;

              Operation := TMathProcedure(Proc);
            end;
          end;

const
  BlankString = ' ';

type
  PTermRecord = ^TermRecord;
  TermRecord = record
                 { this usage of string is a bit inefficient,
                   as in 16bit always 256 bytes are consumed.
                   But since we
                   a) are allocating memory dynamically and
                   b) this will be released immediately when
                      finished with parsing
                   this seems to be OK

                   One COULD create a "TermClass" where this is handled }
                 StartString: string;
                 LeftString, RightString: string;

                 Token: TToken;

                 Position: array[1..3] of integer;

                 Next1,
                 Next2,
                 Previous: PTermRecord;
               end;

const
  { side effect: for each bracketing level added
      SizeOf(integer) bytes additional stack usage
      maxLevelWidth*SizeOf(Pointer) additional global memory used }
  maxBracketLevels = 20;

  { side effect: for each additional (complexity) level width
      maxBracketLevels*SizeOf(Pointer) additional global memory used }
  maxLevelWidth = 50;
type
  LevelArray = array[0..maxBracketLevels] of integer;

  OperationPointerArray = array[0..maxBracketLevels, 1..maxLevelWidth] of POperation;
  POperationPointerArray = ^OperationPointerArray;
var
  Matrix: POperationPointerArray;

  { bracket positions }
  CurrentBracket,
  i,
  CurBracketLevels: integer;

  BracketLevel: LevelArray;

  LastOP: POperation;
  FloatNumber: ParserFloat;
  VariableID: integer;


  ANewTerm, { need this particlar pointer to guarantee a good, flawless memory cleanup in except }

  FirstTerm,
  Next1Term,
  Next2Term,
  LastTerm: PTermRecord;

  counter1,
  counter2: integer;
begin
  { initialize local variables for safe checking in try..finally..end}

  { FirstTerm := nil; } { not necessary since not freed in finally }
  LastTerm := nil;
  ANewTerm := nil;
  Next1Term := nil;
  Next2Term := nil;

  Error := false;

  FillChar(BracketLevel, SizeOf(BracketLevel), 0); { initialize bracket array }
  BracketLevel[0] := 1;
  CurBracketLevels := 0;

  new(Matrix);

  try { this block protects the whole of ALL assignments...}
    FillChar(Matrix^, SizeOf(Matrix^), 0);

    new(ANewTerm);
    with ANewTerm^ do
    begin

      StartString := UpperCase(FunctionString);

      { remove leading and trailing spaces }
      counter1 := 1;
      counter2 := length(StartString);
      while counter1 <= counter2 do
        if StartString[counter1] <> ' ' then
          break
        else
          inc(counter1);

      counter2 := length(StartString);
      while counter2 > counter1 do
        if StartString[counter2] <> ' ' then
          break
        else
          dec(counter2);

      StartString := Copy(StartString, counter1, counter2 - counter1 + 1);

      if Pos(' ', StartString) > 0 then
        raise EExpressionHasBlanks.Create(msgErrBlanks);
      {
      Old code:

         StartString := RemoveBlanks(UpperCase(FunctionString));

      ...do not use! Using it would create the following situation:

         Passed string:   "e xp(12)"
         Modified string: "exp(12)"

      This MAY or may not be the desired meaning - there may well exist
      a variable "e" and a function "xp" and just the operator would be missing.

      Conclusion: the above line has the potential of changing the meaning
                  of an expression.
      }

      if not CheckNumberBrackets(StartString) then
        raise EMissMatchingBracket.Create(msgMissingBrackets);

      { remove enclosing brackets, e.g. ((pi)) }
      while CheckBracket(StartString, FunctionString) do
        StartString := FunctionString;

      LeftString := BlankString;
      RightString := BlankString;

      Token := variab;

      Next1 := nil;
      Next2 := nil;
      Previous := nil;
    end;

    Matrix^[0,1] := CreateOperation(variab, nil);

    LastTerm := ANewTerm;
    FirstTerm := ANewTerm;
    ANewTerm := nil;

    with LastTerm^ do
    begin
      Position[1] := 0;
      Position[2] := 1;
      Position[3] := 1;
    end;

    repeat

      repeat

        with LastTerm^ do
        begin

          CurrentBracket := Position[1];
          i := Position[2];

          if Next1 = nil then
          begin
            if CheckVariable(StartString, VariableID) then
            begin
              Token := variab;

              if Position[3] = 1 then
                Matrix^[CurrentBracket, i]^.Arg1 := PParserFloat(Variables.Objects[VariableID])
              else
                Matrix^[CurrentBracket, i]^.Arg2 := PParserFloat(Variables.Objects[VariableID])
            end
            else
            begin
              if CheckNumber(StartString, FloatNumber) then
              begin
                Token := constant;
                if Position[3] = 1 then
                begin
                  new(Matrix^[CurrentBracket, i]^.Arg1);
                  Matrix^[CurrentBracket, i]^.Arg1^ := FloatNumber;
                end
                else
                begin
                  new(Matrix^[CurrentBracket, i]^.Arg2);
                  Matrix^[CurrentBracket, i]^.Arg2^ := FloatNumber;
                end;
              end
              else
              begin
                if CheckNegate(StartString, LeftString) then
                  Token := minus
                else
                begin
                  if CheckAdd(StartString, LeftString, RightString) then
                    Token := sum
                  else
                  begin
                    if CheckSubtract(StartString, LeftString, RightString) then
                      Token := diff
                    else
                    begin
                      if CheckMultiply(StartString, LeftString, RightString) then
                        Token := prod
                      else
                      begin
                        if CheckIntegerDiv(StartString, LeftString, RightString) then
                          Token := IntDiv
                        else
                        begin
                          if CheckModulo(StartString, LeftString, RightString) then
                            Token := modulo
                          else
                          begin
                            if CheckRealDivision(StartString, LeftString, RightString) then
                              Token := divis
                            else
                            begin
                              if not CheckPower(StartString, LeftString, RightString, Token) then
                              begin
                                if CheckFuncOneVar(StartString, LeftString) then
                                  Token := FuncOneVar
                                else
                                begin
                                  if CheckFuncTwoVar(StartString, LeftString, RightString) then
                                    Token := FuncTwoVar
                                  else
                                  begin
                                    Error := true; {with an exception raised this is meaningless...}
                                    if (LeftString = BlankString) and (RightString = BlankString) then
                                      raise ESyntaxError.CreateFmt(
                                         msgParseError+#13'%s', [StartString]
                                                                   )
                                    else
                                      raise ESyntaxError.CreateFmt(
                                         msgParseError+#13'%s'#13'%s', [Leftstring, RightString]
                                                                   )
                                  end;
                                end;
                              end;
                            end;
                          end;
                        end;
                      end;
                    end;
                  end;
                end;
              end;
            end;
          end;
        end; { with LastTerm^ }


        if LastTerm^.Token in ( [minus, square, third, fourth, FuncOneVar, FuncTwoVar] + TokenOperators) then
        begin
          if LastTerm^.Next1 = nil then
          begin
            try
              Next1Term := nil;
              new(Next1Term);

              inc(CurrentBracket);
              if CurrentBracket > maxBracketLevels then
              begin
                Error := true;
                raise ETooManyNestings.Create(msgNestings);
              end;

              if CurBracketLevels < CurrentBracket then
                CurBracketLevels := CurrentBracket;

              i := BracketLevel[CurrentBracket] + 1;
              if i > maxLevelWidth then
              begin
                Error := true;
                raise EExpressionTooComplex.Create(msgTooComplex);
              end;

              with Next1Term^ do
              begin
                StartString := LastTerm^.LeftString;
                LeftString := BlankString;
                RightString := BlankString;

                Position[1] := CurrentBracket;
                Position[2] := i;
                Position[3] := 1;

                Token := variab;

                Previous := LastTerm;
                Next1 := nil;
                Next2 := nil;
              end;

              with LastTerm^ do
              begin
                case Token of
                  FuncOneVar:
                    with FunctionOne do
                      Matrix^[CurrentBracket, i] := CreateOperation(
                                       Token,
                                       Objects[IndexOf(copy(StartString, 1, pos('(', StartString)-1))]
                                                                   );

                  FuncTwoVar:
                    with FunctionTwo do
                      Matrix^[CurrentBracket, i] := CreateOperation(
                                       Token,
                                       Objects[IndexOf(copy(StartString, 1, pos('(', StartString)-1))]
                                                                  );
                else
                  Matrix^[CurrentBracket, i] := CreateOperation(Token, nil);
                end;

                new(Matrix^[CurrentBracket, i]^.Dest);
                Matrix^[CurrentBracket, i]^.Dest^ := 0;

                if Position[3] = 1 then
                  Matrix^[Position[1], Position[2]]^.Arg1 := Matrix^[CurrentBracket, i]^.Dest
                else
                  Matrix^[Position[1], Position[2]]^.Arg2 := Matrix^[CurrentBracket, i]^.Dest;

                Next1 := Next1Term;
                Next1Term := nil;
              end;

              if LastTerm^.Token in [minus, square, third, fourth, FuncOneVar] then
                inc(BracketLevel[CurrentBracket]);

            except
              on E: Exception do
              begin
                if assigned(Next1Term) then
                begin
                  dispose(Next1Term);
                  Next1Term := nil;
                end;

                raise;
              end;
            end;

          end

          else
          begin
            if LastTerm^.Token in (TokenOperators + [FuncTwoVar]) then
            begin
              try
                Next2Term := nil;
                new(Next2Term);

                inc(CurrentBracket);
                if CurrentBracket > maxBracketLevels then
                begin
                  Error := true;
                  raise ETooManyNestings.Create(msgNestings);
                end;

                if CurBracketLevels < CurrentBracket then
                  CurBracketLevels := CurrentBracket;

                i := BracketLevel[CurrentBracket] + 1;
                if i > maxLevelWidth then
                begin
                  Error := true;
                  raise EExpressionTooComplex.Create(msgTooComplex);
                end;

                with Next2Term^ do
                begin
                  StartString := LastTerm^.RightString;

                  LeftString := BlankString;
                  RightString := BlankString;

                  Token := variab;

                  Position[1] := CurrentBracket;
                  Position[2] := i;
                  Position[3] := 2;

                  Previous := LastTerm;
                  Next1 := nil;
                  Next2 := nil;
                end;

                LastTerm^.Next2 := Next2Term;
                Next2Term := nil;
                inc(BracketLevel[CurrentBracket]);

              except
                on E: Exception do
                begin
                  if assigned(Next2Term) then
                  begin
                    dispose(Next2Term);
                    Next2Term := nil;
                  end;
                end;
              end;
            end
            else
              raise EParserInternalError.Create(msgInternalError);
          end;
        end;


        with LastTerm^ do
          if Next1 = nil then
          begin
          { we are done with THIS loop }
            break;
          end
          else
            if Next2 = nil then
              LastTerm := Next1
            else
              LastTerm := Next2;

      until false; { endless loop, break'ed 7 lines above }

      if LastTerm = FirstTerm then
      begin
        dispose(LastTerm);
        FirstTerm := nil;
        break; { OK - that is it, we did not find any more terms}
      end;

      repeat
        with LastTerm^ do { cannot use "with LastTerm^" OUTSIDE loop }
        begin
          if Next1 <> nil then
          begin
            dispose(Next1);
            Next1 := nil;
          end;

          if Next2 <> nil then
          begin
            dispose(Next2);
            Next2 := nil;
          end;

          LastTerm := Previous;
        end;
      until ((LastTerm^.Token in (TokenOperators + [FuncTwoVar])) and (LastTerm^.Next2 = nil)) or
            (LastTerm = FirstTerm);

      with FirstTerm^ do
      if (LastTerm = FirstTerm) and
            (  (Token in [minus, square, third, fourth, FuncOneVar]) or
               ((Token in (TokenOperators + [FuncTwoVar])) and Assigned(Next2))
            ) then
      begin
        break;
      end;


    until false;


    { after having built the expression matrix, translate it into a tree/list }

    with FirstTerm^ do
      if FirstTerm <> nil then
      begin
        if Next1 <> nil then
        begin
          dispose(Next1);
          Next1 := nil;
        end;

        if Next2 <> nil then
        begin
          dispose(Next2);
          Next2 := nil;
        end;

        dispose(FirstTerm);
      end;

    BracketLevel[0] := 1;

    if CurBracketLevels = 0 then
    begin
      FirstOP := Matrix^[0,1];
      Matrix^[0,1] := nil;
      FirstOP^.Dest := FirstOP^.Arg1;
    end
    else
    begin

      FirstOP := Matrix^[CurBracketLevels, 1];
      LastOP := FirstOP;

      for counter2 := 2 to BracketLevel[CurBracketLevels] do
      begin
        LastOP^.NextOperation := Matrix^[CurBracketLevels, counter2];
        LastOP := LastOP^.NextOperation;
      end;


      for counter1 := CurBracketLevels-1 downto 1 do
        for counter2 := 1 to BracketLevel[counter1] do
        begin
          LastOP^.NextOperation := Matrix^[counter1, counter2];
          LastOP := LastOP^.NextOperation;
        end;


      with Matrix^[0,1]^ do
      begin
        Arg1 := nil;
        Arg2 := nil;
        Dest := nil;
      end;

      dispose(Matrix^[0,1]);
    end;

    dispose(Matrix);

  except

    on E: Exception do
    begin
      if Assigned(Matrix) then
      begin
        if assigned(Matrix^[0,1]) then
          dispose(Matrix^[0,1]);

        for counter1 := CurBracketLevels downto 1 do
          for counter2 := 1 to BracketLevel[counter1] do
            if Assigned(Matrix^[counter1, counter2]) then

              dispose(Matrix^[counter1, counter2]);

        dispose(Matrix);
      end;

      if Assigned(Next1Term) then
        dispose(Next1Term);

      if Assigned(Next2Term) then
        dispose(Next2Term);

  {   do NOT kill this one at it is possibly the same as LastTerm (see below)!
      if Assigned(FirstTerm) then
        dispose(FirstTerm);

      instead, DO kill ANewTerm, which will only be <> nil if it has NOT passed
      its value to some other pointer already so it can safely be freed
  }
      if Assigned(ANewTerm) then
        dispose(ANewTerm);

      if Assigned(LastTerm) and (LastTerm <> Next2Term) and (LastTerm <> Next1Term) then
        dispose(LastTerm);

      FirstOP := nil;

      raise; { re-raise exception }

    end; { on E:Exception do }
  end;
end;



end.