fcl-passrc: resolver: eval set of integer range

git-svn-id: trunk@36819 -
2025-04-08 09:28:19 +02:00 · 2017-08-03 09:28:29 +00:00 · 2017-08-03 09:28:29 +00:00 · 37c9dc2c3f
commit 37c9dc2c3f
parent 936fac3a33
3 changed files with 246 additions and 36 deletions
--- a/packages/fcl-passrc/src/pasresolveeval.pas
+++ b/packages/fcl-passrc/src/pasresolveeval.pas
@ -47,9 +47,15 @@ Works:
  - error on duplicate in const set

 ToDo:
- set of 1..7
 - arrays
-  - length(), low(), high(), []
+  - length(), [], [a..b], [a,b], +
+  - array of int
+  - of char
+  - of enum
+  - of bool
+  - of record
+  - of string
+- enum ranges: type f=(a,b,c,d); g=b..c;
 }
 unit PasResolveEval;

@ -303,6 +309,33 @@ const
  reitAllSigned = [reitNone,reitShortInt,reitSmallInt,reitIntSingle,reitLongInt,reitIntDouble];
  reitAllUnsigned = [reitByte,reitWord,reitUIntSingle,reitLongWord,reitUIntDouble];

+  reitLow: array[TResEvalTypedInt] of MaxPrecInt = (
+    low(MaxPrecInt), // reitNone,
+    low(Byte), // reitByte,
+    low(ShortInt), // reitShortInt,
+    low(Word), // reitWord,
+    low(SmallInt), // reitSmallInt,
+    0, // reitUIntSingle,
+    MinSafeIntSingle, // reitIntSingle,
+    low(LongWord), // reitLongWord,
+    low(LongInt), // reitLongInt,
+    0, // reitUIntDouble,
+    MinSafeIntDouble // reitIntDouble)
+    );
+  reitHigh: array[TResEvalTypedInt] of MaxPrecInt = (
+    high(MaxPrecInt), // reitNone,
+    high(Byte), // reitByte,
+    high(ShortInt), // reitShortInt,
+    high(Word), // reitWord,
+    high(SmallInt), // reitSmallInt,
+    MaxSafeIntSingle, // reitUIntSingle,
+    MaxSafeIntSingle, // reitIntSingle,
+    high(LongWord), // reitLongWord,
+    high(LongInt), // reitLongInt,
+    MaxSafeIntDouble, // reitUIntDouble,
+    MaxSafeIntDouble // reitIntDouble)
+    );
+
 type
  { TResEvalInt }

@ -338,6 +371,7 @@ type
    constructor CreateValue(const aValue: MaxPrecFloat);
    function Clone: TResEvalValue; override;
    function AsString: string; override;
+    function IsInt(out Int: MaxPrecInt): boolean;
  end;

  { TResEvalString - Kind=revkString }
@ -492,6 +526,8 @@ type
    function EvalParamsExpr(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
    function EvalArrayParamsExpr(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
    function EvalSetParamsExpr(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalSet;
+    function EvalSetExpr(Expr: TPasExpr; ExprArray: TPasExprArray; Flags: TResEvalFlags): TResEvalSet;
+    function EvalArrayValuesExpr(Expr: TArrayValues; Flags: TResEvalFlags): TResEvalSet;
    function ExprStringToOrd(Value: TResEvalValue; PosEl: TPasElement): longword; virtual;
    function EvalPrimitiveExprString(Expr: TPrimitiveExpr): TResEvalValue; virtual;
    procedure PredBool(Value: TResEvalBool; ErrorEl: TPasElement);
@ -904,32 +940,65 @@ end;

 function TResExprEvaluator.EvalUnaryExpr(Expr: TUnaryExpr; Flags: TResEvalFlags
  ): TResEvalValue;
+var
+  Int: MaxPrecInt;
+  UInt: MaxPrecUInt;
 begin
  Result:=Eval(Expr.Operand,Flags);
  if Result=nil then exit;
+  {$IFDEF VerbosePasResEval}
+  writeln('TResExprEvaluator.EvalUnaryExpr ',OpcodeStrings[Expr.OpCode],' Value=',Result.AsDebugString);
+  {$ENDIF}
  case Expr.OpCode of
    eopAdd: ;
    eopSubtract:
      case Result.Kind of
      revkInt:
        begin
-        if TResEvalInt(Result).Int=0 then exit;
+        Int:=TResEvalInt(Result).Int;
+        if Int=0 then exit;
        if Result.Element<>nil then
          Result:=Result.Clone;
-        if TResEvalInt(Result).Int=0 then exit;
-        if not (TResEvalInt(Result).Typed in reitAllSigned) then
+        if (TResEvalInt(Result).Typed in reitAllSigned) then
          begin
-          // switch to untyped
+          if Int=reitLow[TResEvalInt(Result).Typed] then
+            begin
+            // need higher precision
+            if TResEvalInt(Result).Typed<>reitNone then
+              // unsigned -> switch to untyped
+              TResEvalInt(Result).Typed:=reitNone
+            else
+              begin
+              // switch to float
+              ReleaseEvalValue(Result);
+              Result:=TResEvalFloat.CreateValue(-MaxPrecFloat(low(MaxPrecInt)));
+              exit;
+              end;
+            end;
+          end
+        else
+          begin
+          // unsigned -> switch to untyped
          TResEvalInt(Result).Typed:=reitNone;
-          end;
-        TResEvalInt(Result).Int:=-TResEvalInt(Result).Int
+          end ;
+        // negate
+        TResEvalInt(Result).Int:=-Int;
        end;
      revkUInt:
        begin
-        if TResEvalUInt(Result).UInt=0 then exit;
-        if Result.Element<>nil then
-          Result:=Result.Clone;
-        TResEvalUInt(Result).UInt:=-TResEvalUInt(Result).UInt;
+        UInt:=TResEvalUInt(Result).UInt;
+        if UInt=0 then exit;
+        if UInt<=High(MaxPrecInt) then
+          begin
+          ReleaseEvalValue(Result);
+          Result:=TResEvalInt.CreateValue(-MaxPrecInt(UInt));
+          end
+        else
+          begin
+          // switch to float
+          ReleaseEvalValue(Result);
+          Result:=TResEvalFloat.CreateValue(-MaxPrecFloat(UInt));
+          end;
        end;
      revkFloat:
        begin
@ -2810,6 +2879,15 @@ end;

 function TResExprEvaluator.EvalSetParamsExpr(Expr: TParamsExpr;
  Flags: TResEvalFlags): TResEvalSet;
+begin
+  {$IFDEF VerbosePasResEval}
+  writeln('TResExprEvaluator.EvalSetParamsExpr length(Expr.Params)=',length(Expr.Params));
+  {$ENDIF}
+  Result:=EvalSetExpr(Expr,Expr.Params,Flags);
+end;
+
+function TResExprEvaluator.EvalSetExpr(Expr: TPasExpr;
+  ExprArray: TPasExprArray; Flags: TResEvalFlags): TResEvalSet;
 var
  i: Integer;
  RangeStart, RangeEnd: MaxPrecInt;
@ -2818,18 +2896,18 @@ var
  El: TPasExpr;
 begin
  {$IFDEF VerbosePasResEval}
-  writeln('TResExprEvaluator.EvalSetParamsExpr length(Expr.Params)=',length(Expr.Params));
+  writeln('TResExprEvaluator.EvalSetExpr Expr=',GetObjName(Expr),' length(ExprArray)=',length(ExprArray));
  {$ENDIF}
  Result:=TResEvalSet.Create;
  Value:=nil;
  OnlyConstElements:=true;
  ok:=false;
  try
-    for i:=0 to length(Expr.Params)-1 do
+    for i:=0 to length(ExprArray)-1 do
      begin
-      El:=Expr.Params[i];
+      El:=ExprArray[i];
      {$IFDEF VerbosePasResEval}
-      writeln('TResExprEvaluator.EvalSetParamsExpr ',i,' of ',length(Expr.Params),' El=',GetObjName(El));
+      writeln('TResExprEvaluator.EvalSetExpr ',i,' of ',length(ExprArray),' El=',GetObjName(El));
      {$ENDIF}
      Value:=Eval(El,Flags);
      if Value=nil then
@ -2839,7 +2917,7 @@ begin
        continue;
        end;
      {$IFDEF VerbosePasResEval}
-      //writeln('TResExprEvaluator.EvalSetParamsExpr ',i,' of ',length(Expr.Params),' Value=',Value.AsDebugString);
+      //writeln('TResExprEvaluator.EvalSetExpr ',i,' of ',length(ExprArray),' Value=',Value.AsDebugString);
      {$ENDIF}
      case Value.Kind of
      revkBool:
@ -2904,7 +2982,7 @@ begin
          end
        else if Result.ElKind<>revskEnum then
          RaiseNotYetImplemented(20170713143559,El)
-        else if Result.ElType<>Value.IdentEl.Parent then
+        else if Result.ElType<>TResEvalEnum(Value).ElType then
          RaiseNotYetImplemented(20170713201021,El);
        RangeStart:=TResEvalEnum(Value).Index;
        RangeEnd:=RangeStart;
@ -2937,7 +3015,7 @@ begin
        end
      else
        {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
-        writeln('TResExprEvaluator.EvalSetParamsExpr Result.ElKind=',Result.ElKind,' Value.Kind=',Value.Kind);
+        writeln('TResExprEvaluator.EvalSetExpr Result.ElKind=',Result.ElKind,' Value.Kind=',Value.Kind);
        {$ENDIF}
        RaiseNotYetImplemented(20170713143422,El);
      end;
@ -2945,7 +3023,7 @@ begin
      if Result.Intersects(RangeStart,RangeEnd)>=0 then
        begin
        {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
-        writeln('TResExprEvaluator.EvalSetParamsExpr Value=',Value.AsDebugString,' Range=',RangeStart,'..',RangeEnd,' Result=',Result.AsDebugString);
+        writeln('TResExprEvaluator.EvalSetExpr Value=',Value.AsDebugString,' Range=',RangeStart,'..',RangeEnd,' Result=',Result.AsDebugString);
        {$ENDIF}
        RaiseMsg(20170714141326,nRangeCheckInSetConstructor,
          sRangeCheckInSetConstructor,[],El);
@ -2960,6 +3038,15 @@ begin
  end;
 end;

+function TResExprEvaluator.EvalArrayValuesExpr(Expr: TArrayValues;
+  Flags: TResEvalFlags): TResEvalSet;
+begin
+  {$IFDEF VerbosePasResEval}
+  writeln('TResExprEvaluator.EvalArrayValuesExpr length(Expr.Values)=',length(Expr.Values));
+  {$ENDIF}
+  Result:=EvalSetExpr(Expr,Expr.Values,Flags);
+end;
+
 function TResExprEvaluator.EvalBinaryPowerExpr(Expr: TBinaryExpr; LeftValue,
  RightValue: TResEvalValue): TResEvalValue;
 var
@ -3276,7 +3363,7 @@ begin
      pekIdent:
        begin
        Result:=OnEvalIdentifier(Self,TPrimitiveExpr(Expr),Flags);
-        writeln('TResExprEvaluator.Eval primitiv result=',Result<>nil,' ',dbgs(Result));
+        //writeln('TResExprEvaluator.Eval primitiv result=',Result<>nil,' ',dbgs(Result));
        end;
      pekNumber:
        begin
@ -3284,6 +3371,11 @@ begin
        val(TPrimitiveExpr(Expr).Value,Int,Code);
        if Code=0 then
          begin
+          {$IFDEF VerbosePasResEval}
+          writeln('TResExprEvaluator.Eval Int=',Int,' Value="',TPrimitiveExpr(Expr).Value,'"');
+          {$ENDIF}
+          if (Int<0) and (Pos('-',TPrimitiveExpr(Expr).Value)<1) then
+            RaiseInternalError(20170802141254,'bug in FPC str()');
          Result:=TResEvalInt.CreateValue(Int);
          exit;
          end;
@ -3292,6 +3384,9 @@ begin
        if Code=0 then
          begin
          Result:=TResEvalUInt.CreateValue(UInt);
+          {$IFDEF VerbosePasResEval}
+          writeln('TResExprEvaluator.Eval UInt=',UInt,' Value="',TPrimitiveExpr(Expr).Value,'"');
+          {$ENDIF}
          exit;
          end;
        // try float
@ -3299,6 +3394,9 @@ begin
        if Code=0 then
          begin
          Result:=TResEvalFloat.CreateValue(Flo);
+          {$IFDEF VerbosePasResEval}
+          writeln('TResExprEvaluator.Eval Float=',Flo,' Value="',TPrimitiveExpr(Expr).Value,'"');
+          {$ENDIF}
          exit;
          end;
        RaiseRangeCheck(20170518202252,Expr);
@ -3323,6 +3421,8 @@ begin
    Result:=EvalBinaryExpr(TBinaryExpr(Expr),Flags)
  else if C=TParamsExpr then
    Result:=EvalParamsExpr(TParamsExpr(Expr),Flags)
+  else if C=TArrayValues then
+    Result:=EvalArrayValuesExpr(TArrayValues(Expr),Flags)
  else if refConst in Flags then
    RaiseConstantExprExp(20170518213800,Expr);
  writeln('TResExprEvaluator.Eval END ',Expr.ClassName,' result=',Result<>nil,' ',dbgs(Result));
@ -4225,6 +4325,16 @@ begin
  str(FloatValue,Result);
 end;

+function TResEvalFloat.IsInt(out Int: MaxPrecInt): boolean;
+begin
+  Int:=0;
+  if Frac(FloatValue)<>0 then exit(false);
+  if FloatValue<MaxPrecFloat(low(MaxPrecInt)) then exit(false);
+  if FloatValue>MaxPrecFloat(high(MaxPrecInt)) then exit(false);
+  Int:=Trunc(FloatValue);
+  Result:=true;
+end;
+
 { TResEvalString }

 constructor TResEvalString.Create;
--- a/packages/fcl-passrc/src/pasresolver.pp
+++ b/packages/fcl-passrc/src/pasresolver.pp
@ -137,9 +137,7 @@ Works:
 - dotted unitnames
 - eval:
  - nil, true, false
-
-ToDo:
- range checking:
+  - range checking:
  - integer ranges
  - boolean ranges
  - enum ranges
@ -148,12 +146,16 @@ ToDo:
  - =, <>, <, <=, >, >=
  - ord(), low(), high(), pred(), succ(), length()
  - string[index]
-  - arr[index]
  - call(param)
-  - indexedprop[param]
  - a:=value
-  - set+set, set*set, set-set
+
+ToDo:
+- range checking:
+  - arr[index]
+  - indexedprop[param]
  - case-of unique
+  - defaultvalue
+  - stored
 - @@
 - fail to write a loop var inside the loop
 - warn: create class with abstract methods
@ -1367,7 +1369,7 @@ type
    function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
    function IsTypeCast(Params: TParamsExpr): boolean;
    function ProcNeedsParams(El: TPasProcedureType): boolean;
-    function GetRangeLength(RangeResolved: TPasResolverResult): integer;
+    function GetRangeLength(const RangeResolved: TPasResolverResult): MaxPrecInt;
    function HasTypeInfo(El: TPasType): boolean; virtual;
    function GetActualBaseType(bt: TResolverBaseType): TResolverBaseType; virtual;
    function GetCombinedBoolean(Bool1, Bool2: TResolverBaseType; ErrorEl: TPasElement): TResolverBaseType; virtual;
@ -1652,6 +1654,8 @@ procedure SetResolverIdentifier(out ResolvedType: TPasResolverResult;
  BaseType: TResolverBaseType; IdentEl: TPasElement; TypeEl: TPasType;
  Flags: TPasResolverResultFlags);
 begin
+  if IdentEl is TPasExpr then
+    raise Exception.Create('20170729101017');
  ResolvedType.BaseType:=BaseType;
  ResolvedType.SubType:=btNone;
  ResolvedType.IdentEl:=IdentEl;
@ -6437,6 +6441,7 @@ begin
          ResolvedEl:=LeftResolved;
          ResolvedEl.SubType:=ResolvedEl.BaseType;
          ResolvedEl.BaseType:=btRange;
+          ResolvedEl.ExprEl:=Bin;
          exit;
          end;
        end;
@ -10977,7 +10982,22 @@ begin
            or (MaxVal<MaxPrecInt(TResEvalUInt(RValue).UInt)) then
          fExprEvaluator.EmitRangeCheckConst(20170530093616,
            IntToStr(TResEvalUInt(RValue).UInt),IntToStr(MinVal),IntToStr(MaxVal),RHS);
+      revkFloat:
+        if TResEvalFloat(RValue).IsInt(Int) then
+          begin
+          if (MinVal>Int) or (MaxVal<Int) then
+            fExprEvaluator.EmitRangeCheckConst(20170802133307,
+              IntToStr(Int),MinVal,MaxVal,RHS,mtError);
+          end
+        else
+          begin
+          writeln('AAA1 TPasResolver.CheckAssignExprRange ',Frac(TResEvalFloat(RValue).FloatValue),' ',TResEvalFloat(RValue).FloatValue<MaxPrecFloat(low(MaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue>MaxPrecFloat(high(MaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue,' ',high(MaxPrecInt));
+          RaiseRangeCheck(20170802133750,RHS);
+          end;
      else
+        {$IFDEF VerbosePasResEval}
+        writeln('TPasResolver.CheckAssignExprRange ',RValue.AsDebugString);
+        {$ENDIF}
        RaiseNotYetImplemented(20170530092731,RHS);
      end
    else if LeftResolved.BaseType=btQWord then
@ -11283,23 +11303,28 @@ begin
      Result:=CheckAssignCompatibilityArrayType(LHS,RHS,ErrorEl,RaiseOnIncompatible);
    end;

-  {$IFDEF VerbosePasResolver}
-  writeln('TPasResolver.CheckAssignResCompatibility incompatible LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
-  {$ENDIF}
  if (Result>=0) and (Result<cIncompatible) then
    begin
    // type fits -> check readable
    if not (rrfReadable in RHS.Flags) then
      begin
      if RaiseOnIncompatible then
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.CheckAssignResCompatibility RHS not readable. LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
+        {$ENDIF}
        RaiseMsg(20170318235637,nVariableIdentifierExpected,
          sVariableIdentifierExpected,[],ErrorEl);
+        end;
      exit(cIncompatible);
      end;
    exit;
    end;

  // incompatible
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CheckAssignResCompatibility incompatible LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
+  {$ENDIF}
  if not RaiseOnIncompatible then
    exit(cIncompatible);

@ -12046,7 +12071,7 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
    if IsLastRange then
      begin
      ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
-      ElTypeResolved.IdentEl:=Range;
+      ElTypeResolved.ExprEl:=Range;
      Include(ElTypeResolved.Flags,rrfWritable);
      end
    else
@ -12997,6 +13022,8 @@ begin
    begin
    ComputeElement(TPasRangeType(El).RangeExpr,ResolvedEl,[rcConstant],StartEl);
    ResolvedEl.IdentEl:=El;
+    if ResolvedEl.ExprEl=nil then
+      ResolvedEl.ExprEl:=TPasRangeType(El).RangeExpr;
    ResolvedEl.Flags:=[];
    end
  else if ElClass=TPasSetType then
@ -13380,17 +13407,57 @@ begin
  Result:=(El.Args.Count>0) and (TPasArgument(El.Args[0]).ValueExpr=nil);
 end;

-function TPasResolver.GetRangeLength(RangeResolved: TPasResolverResult
-  ): integer;
+function TPasResolver.GetRangeLength(const RangeResolved: TPasResolverResult
+  ): MaxPrecInt;
+var
+  TypeEl: TPasType;
+  {$IFDEF EnablePasResRangeCheck}
+  Value: TResEvalValue;
+  {$ENDIF}
 begin
  Result:=0;
  if RangeResolved.BaseType=btContext then
    begin
-    if RangeResolved.IdentEl is TPasEnumType then
-      Result:=TPasEnumType(RangeResolved.IdentEl).Values.Count;
+    if RangeResolved.IdentEl is TPasType then
+      begin
+      TypeEl:=ResolveAliasType(TPasType(RangeResolved.IdentEl));
+      if TypeEl<>nil then
+        begin
+        if TypeEl.ClassType=TPasEnumType then
+          Result:=TPasEnumType(TypeEl).Values.Count;
+        end;
+      end;
+    end
+  else if RangeResolved.ExprEl<>nil then
+    begin
+    {$IFDEF EnablePasResRangeCheck}
+    Value:=Eval(RangeResolved.ExprEl,[]);
+    if Value=nil then
+      RaiseMsg(20170729094135,nIncompatibleTypesGotExpected,
+        sIncompatibleTypesGotExpected,
+        [GetResolverResultDescription(RangeResolved),'range'],RangeResolved.ExprEl);
+    try
+      case Value.Kind of
+        revkRangeInt:
+          Result:=TResEvalRangeInt(Value).RangeEnd-TResEvalRangeInt(Value).RangeStart+1;
+      else
+        RaiseMsg(20170729093823,nIncompatibleTypesGotExpected,
+          sIncompatibleTypesGotExpected,
+          [GetResolverResultDescription(RangeResolved),'range'],RangeResolved.ExprEl);
+      end;
+    finally
+      ReleaseEvalValue(Value);
+    end;
+    {$ELSE}
+    Result:=2;
+    {$ENDIF}
    end
  else if RangeResolved.BaseType in btAllBooleans then
    Result:=2;
+  {$IFDEF VerbosePasResolver}
+  //if Result=0 then
+    writeln('TPasResolver.GetRangeLength ',GetResolverResultDbg(RangeResolved),' Result=',Result);
+  {$ENDIF}
 end;

 function TPasResolver.HasTypeInfo(El: TPasType): boolean;
--- a/packages/fcl-passrc/tests/tcresolver.pas
+++ b/packages/fcl-passrc/tests/tcresolver.pas
@ -237,6 +237,7 @@ type
    Procedure TestEnumSet_AnonymousEnumtype;
    Procedure TestEnumSet_AnonymousEnumtypeName;
    Procedure TestEnumSet_Const;
+    Procedure TestSet_IntRange_Const;

    // operators
    Procedure TestPrgAssignment;
@ -552,6 +553,7 @@ type
    Procedure TestArray_TypeCastWrongElTypeFail;
    Procedure TestArray_ConstDynArrayWrite;
    Procedure TestArray_ConstOpenArrayWriteFail;
+    Procedure TestArray_Static_Const;

    // static arrays
    Procedure TestArrayIntRange_OutOfRange;
@ -3022,6 +3024,21 @@ begin
  CheckResolverUnexpectedHints;
 end;

+procedure TTestResolver.TestSet_IntRange_Const;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TIntRg = 2..6;',
+  '  TSevenSet = set of TIntRg;',
+  'const',
+  '  a: TSevenSet = [2..3,5]+[4];',
+  '  b = low(TIntRg)+high(TIntRg);',
+  'begin']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
 procedure TTestResolver.TestPrgAssignment;
 var
  El: TPasElement;
@ -8916,6 +8933,22 @@ begin
  CheckResolverException('Variable identifier expected',nVariableIdentifierExpected);
 end;

+procedure TTestResolver.TestArray_Static_Const;
+begin
+  {$IFDEF EnablePasResRangeCheck}
+  StartProgram(false);
+  Add([
+  'type',
+  '  TIntArr = array[1..3] of longint;',
+  'const',
+  '  a = low(TIntArr)+high(TIntArr);',
+  '  b: array[1..3] of longint = (10,11,12);',
+  'begin']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+  {$ENDIF}
+end;
+
 procedure TTestResolver.TestArrayIntRange_OutOfRange;
 begin
  StartProgram(false);