base_code.pas

来自「Delphi脚本控件」· PAS 代码 · 共 2,451 行 · 第 1/5 页

    procedure FOperNE2;

    procedure FOperCall;

    property Terminated: Boolean read fTerminated write fTerminated;
  end;

implementation

uses
  BASE_SCRIPTER, BASE_EVENT, BASE_PARSER, BASE_REGEXP;

procedure TPAXDebugInfo.PopProc;
begin
{ Pop; // SubID
  Pop; // N
  ParamCount := Pop;
  for I:=1 to ParamCount do
    Pop;
}
  Dec(Card, 2);
  Dec(Card, fItems[Card] + 1);
end;

constructor TPAXBreakpoint.Create(LineNumber: Integer;
                               const Condition: String;
                               PassCount: Integer);
begin
  Self.LineNumber := LineNumber;
  Self.Condition := Condition;
  Self.PassCount := PassCount;
  CurrPassCount := -1;
end;

function TPAXBreakpointList.GetBreakpoint(I: Integer): TPAXBreakpoint;
begin
  result := TPAXBreakpoint(Objects[I]);
end;

procedure TPAXBreakpointList.InitCurrPassCounts;
var
  I: Integer;
begin
  for I:=0 to Count - 1 do
    Breakpoints[I].CurrPassCount := -1;
end;

procedure TPAXBreakpointList.AddBreakpoint(LineNumber: Integer;
                                        const Condition: String;
                                        PassCount: Integer);
begin
  AddObject(LineNumber, TPAXBreakpoint.Create(LineNumber, Condition, PassCount));
end;

function TPAXBreakpointList.RemoveBreakpoint(LineNumber: Integer): Boolean;
var
  I: Integer;
begin
  result := false;
  for I:=0 to Count - 1 do
    if Breakpoints[I].LineNumber = LineNumber then
    begin
      result := true;
      DeleteObject(I);
      Exit;
    end;
end;

constructor TPAXTryStack.Create;
begin
  Clear;
  inherited;
end;

procedure TPAXTryStack.Clear;
begin
  Card := 0;
end;

procedure TPAXTryStack.Push(N1, N2: Integer);
begin
  Inc(Card);
  with A[Card] do
  begin
    B1 := N1;
    B2 := N2;
  end;
end;

procedure TPAXTryStack.Pop;
begin
  Dec(Card);
end;

function TPAXTryStack.Legal(N: Integer): boolean;
begin
  with A[Card] do
    result := (N >= B1 ) and (N <= B2);
end;

constructor TPAXCode.Create(AScripter: Pointer);
begin
  SetLength(Prog, FirstProgCard);

  Scripter := AScripter;
  SymbolTable := TPaxBaseScripter(Scripter).SymbolTable;
  ClassList := TPAXBaseScripter(Scripter).ClassList;
  Stack := TPAXFastStack.Create;

  UsingList := TPAXUsingList.Create;
  WithStack := TPAXWithStack.Create;
  TryStack := TPAXTryStack.Create;
  BreakpointList := TPAXBreakpointList.Create;
  LevelStack := TPAXFastStack.Create;
  LevelStack.Push(0);

  DebugState := true;
  DebugInfo := TPAXDebugInfo.Create;
  StateStack := TPAXStack.Create;
  RefStack := TPAXFastStack.Create;
  FinalizationList := TPaxIds.Create(true);
  InitializationList := TPaxIds.Create(true);
  AssignedUndeclaredList := TPAXIds.Create(true);

  SignVBARRAYS := false;

  Card := 0;
  N := 0;
  SubRunCount := 0;

  fTerminated := false;

  DeclareON := true;
  SignFOP := true;
  SignRETURN := false;
  SignInitStage := false;
  SignHaltGlobal := false;

  ArrProc[OP_DECLARE] := OperNop;

  ArrProc[OP_HALT] := OperHalt;
  ArrProc[OP_HALT_GLOBAL] := OperHaltGlobal;
  ArrProc[OP_HALT_OR_NOP] := OperHaltOrNop;
  ArrProc[OP_NOP] := OperNop;
  ArrProc[OP_SKIP] := OperSkip;
  ArrProc[OP_PRINT] := OperPrint;
  ArrProc[OP_PRINT_HTML] := OperPrint;

  ArrProc[OP_PUT_PROPERTY] := OperPutProperty;
  ArrProc[OP_CALL] := OperCall;
  ArrProc[OP_CALL_CONSTRUCTOR] := OperCall; // will be replaced with OP_CALL or OP_TYPE_CAST
  ArrProc[OP_TYPE_CAST] := OperTypeCast;
  ArrProc[OP_PUSH] := OperPush;
  ArrProc[OP_RET] := OperRet;
  ArrProc[OP_EXIT0] := OperExit0;
  ArrProc[OP_EXIT] := OperExit;
  ArrProc[OP_RETURN] := OperReturn;
  ArrProc[OP_SET_LABEL] := OperSetLabel;
  ArrProc[OP_GET_PARAM_COUNT] := OperGetParamCount;
  ArrProc[OP_GET_PARAM] := OperGetParam;
  ArrProc[OP_GET_PUBLISHED_PROPERTY] := OperGetPublishedProperty;
  ArrProc[OP_PUT_PUBLISHED_PROPERTY] := OperPutPublishedProperty;
  ArrProc[OP_RET_OPERATOR] := OperRetOperator;

  ArrProc[OP_BEGIN_METHOD] := OperNop;
  ArrProc[OP_CREATE_ARRAY] := OperCreateArray;
  ArrProc[OP_CREATE_DYNAMIC_ARRAY_TYPE] := OperNop;
  ArrProc[OP_DO_NOT_DESTROY] := OperDoNotDestroy;
  ArrProc[OP_GET_ITEM] := OperGetItem;
  ArrProc[OP_PUT_ITEM] := OperPutItem;
  ArrProc[OP_GET_ITEM_EX] := OperGetItemEx;
  ArrProc[OP_PUT_ITEM_EX] := OperPutItemEx;

  ArrProc[OP_CREATE_SHORT_STRING] := OperCreateShortString;

  ArrProc[OP_GET_FIELD] := OperGetField;

  ArrProc[OP_GET_STRING_ELEMENT] := OperGetStringElement;
  ArrProc[OP_PUT_STRING_ELEMENT] := OperPutStringElement;

  ArrProc[OP_CREATE_OBJECT] := OperCreateObject;
  ArrProc[OP_CREATE_RESULT] := OperCreateObject;
  ArrProc[OP_CHECK_CLASS] := OperNop;
  ArrProc[OP_SET_TYPE] := OperNop;
  ArrProc[OP_DESTROY_HOST] := OperDestroyHost;
  ArrProc[OP_DESTROY_OBJECT] := OperDestroyObject;
  ArrProc[OP_DESTROY_LOCAL_VAR] := OperDestroyLocalVar;
  ArrProc[OP_DESTROY_INTF] := OperDestroyIntf;
  ArrProc[OP_RELEASE] := OperRelease;
  ArrProc[OP_CREATE_REF] := OperCreateRef;
  ArrProc[OP_USE_NAMESPACE] := OperUseNamespace;
  ArrProc[OP_USE_LANGUAGE_NAMESPACE] := OperNop;
  ArrProc[OP_END_OF_NAMESPACE] := OperEndOfNamespace;
  ArrProc[OP_BEGIN_WITH] := OperBeginWith;
  ArrProc[OP_END_WITH] := OperEndWith;
  ArrProc[OP_EVAL_WITH] := OperEvalWith;
  ArrProc[OP_IN] := OperIn;
  ArrProc[OP_IN_SET] := OperInSet;
  ArrProc[OP_INSTANCEOF] := OperInstanceOf;
  ArrProc[OP_TYPEOF] := OperTypeOf;
  ArrProc[OP_GET_NEXT_PROP] := OperGetNextProp;
  ArrProc[OP_SAVE_RESULT] := OperSaveResult;
  ArrProc[OP_GET_ANCESTOR_NAME] := OperGetAncestorName;

  ArrProc[OP_EXIT_ON_ERROR] := OperExitOnError;
  ArrProc[OP_DISCARD_ERROR] := OperDiscardError;
  ArrProc[OP_FINALLY] := OperFinally;
  ArrProc[OP_CATCH] := OperCatch;
  ArrProc[OP_TRY_ON] := OperTryOn;
  ArrProc[OP_TRY_OFF] := OperTryOff;
  ArrProc[OP_THROW] := OperThrow;

  ArrProc[OP_GO] := OperGo;
  ArrProc[OP_GO_FALSE] := OperGoFalse;
  ArrProc[OP_GO_FALSE_EX] := OperGoFalseEx;
  ArrProc[OP_GO_TRUE] := OperGoTrue;
  ArrProc[OP_GO_TRUE_EX] := OperGoTrueEx;

  ArrProc[OP_ASSIGN] := OperAssign;
  ArrProc[OP_ASSIGN_SIMPLE] := OperAssign;
  ArrProc[OP_ASSIGN_RESULT] := OperAssignResult;

  ArrProc[OP_ASSIGN_ADDRESS] := OperAssignAddress;
  ArrProc[OP_GET_TERMINAL] := OperGetTerminal;

  ArrProc[OP_LEFT_SHIFT] := OperLeftShift;
  ArrProc[OP_LEFT_SHIFT_EX] := OperLeftShift_Ex;

  ArrProc[OP_RIGHT_SHIFT] := OperRightShift;
  ArrProc[OP_RIGHT_SHIFT_EX] := OperRightShift_Ex;

  ArrProc[OP_UNSIGNED_RIGHT_SHIFT] := OperUnsignedRightShift;
  ArrProc[OP_UNSIGNED_RIGHT_SHIFT_EX] := OperUnsignedRightShift_Ex;

  ArrProc[OP_AND] := OperAnd;
  ArrProc[OP_OR] := OperOr;
  ArrProc[OP_XOR] := OperXor;
  ArrProc[OP_NOT] := OperNot;

  ArrProc[OP_PLUS] := OperPlus;
  ArrProc[OP_PLUS_EX] := OperPlus_Ex;

  ArrProc[OP_MINUS] := OperMinus;
  ArrProc[OP_MINUS_EX] := OperMinus_Ex;

  ArrProc[OP_UNARY_MINUS] := OperUnaryMinus;
  ArrProc[OP_UNARY_MINUS_EX] := OperUnaryMinusEx;

  ArrProc[OP_UNARY_PLUS] := OperUnaryPlus;

  ArrProc[OP_MULT] := OperMult;
  ArrProc[OP_MULT_EX] := OperMult_Ex;

  ArrProc[OP_DIV] := OperDiv;
  ArrProc[OP_DIV_EX] := OperDiv_Ex;

  ArrProc[OP_INT_DIV] := OperIntDiv;

  ArrProc[OP_MOD] := OperMod;
  ArrProc[OP_MOD_EX] := OperMod_Ex;

  ArrProc[OP_POWER] := OperPower;

  ArrProc[OP_LT] := OperLT;
  ArrProc[OP_LT_EX] := OperLT_Ex;

  ArrProc[OP_GT] := OperGT;
  ArrProc[OP_GT_EX] := OperGT_Ex;

  ArrProc[OP_LE] := OperLE;
  ArrProc[OP_LE_EX] := OperLE_Ex;

  ArrProc[OP_GE] := OperGE;
  ArrProc[OP_GE_EX] := OperGE_Ex;

  ArrProc[OP_EQ] := OperEQ;
  ArrProc[OP_EQ_EX] := OperEQ_Ex;

  ArrProc[OP_NE] := OperNE;
  ArrProc[OP_NE_EX] := OperNE_Ex;

  ArrProc[OP_ID] := OperID;
  ArrProc[OP_ID_EX] := OperID_Ex;

  ArrProc[OP_NI] := OperNI;
  ArrProc[OP_NI_EX] := OperNI_Ex;

  ArrProc[OP_TO_INTEGER] := OperToInteger;
  ArrProc[OP_TO_STRING] := OperToString;
  ArrProc[OP_TO_BOOLEAN] := OperToBoolean;

  ArrProc[OP_DEFINE] := OperDefine;

  ArrProc[OP_DECLARE_ON] := OperDeclareOn;
  ArrProc[OP_DECLARE_OFF] := OperDeclareOff;

  ArrProc[OP_UPCASE_ON] := OperUpcaseOn;
  ArrProc[OP_UPCASE_OFF] := OperUpcaseOff;

  ArrProc[OP_OPTIMIZATION_ON] := OperOptimizationOn;
  ArrProc[OP_OPTIMIZATION_OFF] := OperOptimizationOff;

  ArrProc[OP_JS_OPERS_ON] := OperNop;
  ArrProc[OP_JS_OPERS_OFF] := OperNop;

  ArrProc[OP_ZERO_BASED_STRINGS_ON] := OperZeroBasedStringsOn;
  ArrProc[OP_ZERO_BASED_STRINGS_OFF] := OperZeroBasedStringsOff;

  ArrProc[OP_VBARRAYS_ON] := OperVBArraysOn;
  ArrProc[OP_VBARRAYS_OFF] := OperVBArraysOff;

  ArrProc[OP_IS] := OperIS;
  ArrProc[OP_AS] := OperAS;


//--------------------------------------------


  ArrProc[FOP_GO_FALSE1] := FOperGoFalse1;
  ArrProc[FOP_GO_FALSE2] := FOperGoFalse2;

  ArrProc[FOP_GO_TRUE1] := FOperGoTrue1;
  ArrProc[FOP_GO_TRUE2] := FOperGoTrue2;

  ArrProc[FOP_ASSIGN] := FOperAssign;

  ArrProc[FOP_INC1] := FOperInc1;
  ArrProc[FOP_INC2] := FOperInc2;

  ArrProc[FOP_PLUS_INTEGER1] := FOperPlusInteger1;
  ArrProc[FOP_PLUS_INTEGER2] := FOperPlusInteger2;
  ArrProc[FOP_PLUS_DOUBLE1] := FOperPlusDouble1;
  ArrProc[FOP_PLUS_DOUBLE2] := FOperPlusDouble2;
  ArrProc[FOP_PLUS_STRING1] := FOperPlusString1;
  ArrProc[FOP_PLUS_STRING2] := FOperPlusString2;

  ArrProc[FOP_MINUS_INTEGER1] := FOperMinusInteger1;
  ArrProc[FOP_MINUS_INTEGER2] := FOperMinusInteger2;
  ArrProc[FOP_MINUS_DOUBLE1] := FOperMinusDouble1;
  ArrProc[FOP_MINUS_DOUBLE2] := FOperMinusDouble2;

  ArrProc[FOP_MULT_INTEGER1] := FOperMultInteger1;
  ArrProc[FOP_MULT_INTEGER2] := FOperMultInteger2;
  ArrProc[FOP_MULT_DOUBLE1] := FOperMultDouble1;
  ArrProc[FOP_MULT_DOUBLE2] := FOperMultDouble2;

  ArrProc[FOP_DIV_INTEGER1] := FOperDivInteger1;
  ArrProc[FOP_DIV_INTEGER2] := FOperDivInteger2;
  ArrProc[FOP_DIV_DOUBLE1] := FOperDivDouble1;
  ArrProc[FOP_DIV_DOUBLE2] := FOperDivDouble2;

  ArrProc[FOP_MOD1] := FOperMod1;
  ArrProc[FOP_MOD2] := FOperMod2;

  ArrProc[FOP_LT_INTEGER1] := FOperLTInteger1;
  ArrProc[FOP_LT_INTEGER2] := FOperLTInteger2;
  ArrProc[FOP_LT_DOUBLE1] := FOperLTDouble1;
  ArrProc[FOP_LT_DOUBLE2] := FOperLTDouble2;

  ArrProc[FOP_LE_INTEGER1] := FOperLEInteger1;
  ArrProc[FOP_LE_INTEGER2] := FOperLEInteger2;
  ArrProc[FOP_LE_DOUBLE1] := FOperLEDouble1;
  ArrProc[FOP_LE_DOUBLE2] := FOperLEDouble2;

  ArrProc[FOP_GT_INTEGER1] := FOperGTInteger1;
  ArrProc[FOP_GT_INTEGER2] := FOperGTInteger2;
  ArrProc[FOP_GT_DOUBLE1] := FOperGTDouble1;
  ArrProc[FOP_GT_DOUBLE2] := FOperGTDouble2;

  ArrProc[FOP_GE_INTEGER1] := FOperGEInteger1;
  ArrProc[FOP_GE_INTEGER2] := FOperGEInteger2;
  ArrProc[FOP_GE_DOUBLE1] := FOperGEDouble1;
  ArrProc[FOP_GE_DOUBLE2] := FOperGEDouble2;

  ArrProc[FOP_EQ_INTEGER1] := FOperEQInteger1;
  ArrProc[FOP_EQ_INTEGER2] := FOperEQInteger2;
  ArrProc[FOP_EQ_DOUBLE1] := FOperEQDouble1;
  ArrProc[FOP_EQ_DOUBLE2] := FOperEQDouble2;

  ArrProc[FOP_NE_INTEGER1] := FOperNEInteger1;
  ArrProc[FOP_NE_INTEGER2] := FOperNEInteger2;
  ArrProc[FOP_NE_DOUBLE1] := FOperNEDouble1;
  ArrProc[FOP_NE_DOUBLE2] := FOperNEDouble2;

  ArrProc[FOP_BITWISE_AND1] := FOperBitwiseAND1;
  ArrProc[FOP_BITWISE_AND2] := FOperBitwiseAND2;

  ArrProc[FOP_BITWISE_OR1] := FOperBitwiseOR1;
  ArrProc[FOP_BITWISE_OR2] := FOperBitwiseOR2;

  ArrProc[FOP_BITWISE_XOR1] := FOperBitwiseXOR1;
  ArrProc[FOP_BITWISE_XOR2] := FOperBitwiseXOR2;

  ArrProc[FOP_LOGICAL_AND1] := FOperLogicalAND1;
  ArrProc[FOP_LOGICAL_AND2] := FOperLogicalAND2;

  ArrProc[FOP_LOGICAL_OR1] := FOperLogicalOR1;
  ArrProc[FOP_LOGICAL_OR2] := FOperLogicalOR2;

  ArrProc[FOP_LOGICAL_XOR1] := FOperLogicalXOR1;
  ArrProc[FOP_LOGICAL_XOR2] := FOperLogicalXOR2;

  ArrProc[FOP_BITWISE_NOT1] := FOperBitwiseNOT1;
  ArrProc[FOP_BITWISE_NOT2] := FOperBitwiseNOT2;

  ArrProc[FOP_LOGICAL_NOT1] := FOperLogicalNOT1;
  ArrProc[FOP_LOGICAL_NOT2] := FOperLogicalNOT2;

  ArrProc[FOP_UNARY_MINUS_INTEGER1] := FOperUnaryMinusInteger1;
  ArrProc[FOP_UNARY_MINUS_INTEGER2] := FOperUnaryMinusInteger2;
  ArrProc[FOP_UNARY_MINUS_DOUBLE1] := FOperUnaryMinusDouble1;
  ArrProc[FOP_UNARY_MINUS_DOUBLE2] := FOperUnaryMinusDouble2;

  ArrProc[FOP_SHL1] := FOperSHL1;
  ArrProc[FOP_SHL2] := FOperSHL2;

  ArrProc[FOP_SHR1] := FOperSHR1;
  ArrProc[FOP_SHR2] := FOperSHR2;

  ArrProc[FOP_USHR1] := FOperUSHR1;
  ArrProc[FOP_USHR2] := FOperUSHR2;

//======================================================================

  ArrProc[FOP_PUSH] := FOperPush;
  ArrProc[FOP_CALL] := FOperCall;

  ArrProc[FOP_PLUS1] := FOperPlus1;
  ArrProc[FOP_PLUS2] := FOperPlus2;

  ArrProc[FOP_MINUS1] := FOperMinus1;
  ArrProc[FOP_MINUS2] := FOperMinus2;

  ArrProc[FOP_MULT1] := FOperMult1;
  ArrProc[FOP_MULT2] := FOperMult2;

  ArrProc[FOP_DIV1] := FOperDiv1;
  ArrProc[FOP_DIV2] := FOperDiv2;

  ArrProc[FOP_LT1] := FOperLT1;
  ArrProc[FOP_LT2] := FOperLT2;

  ArrProc[FOP_LE1] := FOperLE1;
  ArrProc[FOP_LE2] := FOperLE2;

  ArrProc[FOP_GT1] := FOperGT1;
  ArrProc[FOP_GT2] := FOperGT2;

  ArrProc[FOP_GE1] := FOperGE1;
  ArrProc[FOP_GE2] := FOperGE2;

  ArrProc[FOP_EQ1] := FOperEQ1;
  ArrProc[FOP_EQ2] := FOperEQ2;

  ArrProc[FOP_NE1] := FOperNE1;
  ArrProc[FOP_NE2] := FOperNE2;

  ArrProc[OP_ON_USES] := OperNop;
end;

destructor TPAXCode.Destroy;
begin
  UsingList.Free;
  WithStack.Free;
  TryStack.Free;
  BreakPointList.Free;
  LevelStack.Free;
  DebugInfo.Free;
  StateStack.Free;
  RefStack.Free;
  Stack.Free;
  InitializationList.Free;
  FinalizationList.Free;
  AssignedUndeclaredList.Free;

  inherited;
end;

function TPAXCode.NextOp(var NewN: Integer): Integer;
begin
  NewN := N + 1;
  while Prog[NewN].Op = OP_SEPARATOR do
    Inc(NewN);
  result := Prog[NewN].Op;
end;

procedure TPAXCode.SetRef(ID: Integer; const V: Variant; ma: TPAXMemberAccess);
var
  O: Variant;
  ClassRec: TPAXClassRec;
begin