dxjs_list.pas

Well known and usefull component for delphi 7

////////////////////////////////////////////////////////////////////////////
//    Component: DXJS_LIST
//       Author: Alexander Baranovsky ([e-mail])
//               G.E. Ozz Nixon Jr. ([e-mail])
// ========================================================================
// Source Owner: DX, Inc. 2002, 2004
//    Copyright: All code is the property of DX, Inc. Licensed for
//               resell by Brain Patchwork DX (tm) and part of the
//               DX (r) product lines, which are (c) 1999-2002
//               DX, Inc. Source may not be distributed without
//               written permission from both Brain Patchwork DX,
//               and DX, Inc.
//      License: (Reminder), None of this code can be added to other
//               developer products without permission. This includes
//               but not limited to DCU's, DCP's, DLL's, OCX's, or
//               any other form of merging our technologies. All of
//               your products released to a public consumer be it
//               shareware, freeware, commercial, etc. must contain a
//               license notification somewhere visible in the
//               application.
// Code Version: (3rd Generation)
// ========================================================================
//  Description: Memory Stack, Call Stack, and Hash management
// ========================================================================
////////////////////////////////////////////////////////////////////////////

unit DXJS_LIST;
interface
{$I DXJavaScript.def}

uses
  Classes,
  DXBinaryTree,
  DXJS_SHARE;

type
 TScriptStack = class
   Card: Integer;
   A: array of Integer;
   ASize:Integer;
   constructor Create; virtual;
   destructor Destroy; override;
   procedure Push(I: Integer);
   procedure Pop(var I: Integer);
   function Top: Integer;
   procedure Swap;
   procedure SaveToStream(f: TStream);
   procedure LoadFromStream(f: TStream);
   procedure Clear;
 end;

 TCallObject = class
   SubID: Integer;
   Arguments: array of Variant;
   N: Integer;
   destructor Destroy; override;
   function ParamCount: Integer;
 end;

 TCallStack = class(TList)
   procedure Push(SubID: Integer );
   procedure Pop(var SubID: Integer);
   function TopObject: TCallObject;
 end;

 TEntryRec = record
   BreakLabel, ContinueLabel: Integer;
   StringLabel: String;
 end;

 TEntryStack = class
   Card: Integer;
   A: array[1..100] of TEntryRec;
   constructor Create;
   procedure Push(ABreakLabel, AContinueLabel: Integer;
                  var AStringLabel: String);
   procedure Pop;
   function TopBreakLabel(const AStringLabel: String = ''): Integer;
   function TopContinueLabel(const AStringLabel: String = ''): Integer;
 end;

 TWithStack = class
   Card: Integer;
   A: array[1..100] of Variant;
   constructor Create;
   procedure Push(const V: Variant);
   procedure Pop;
   procedure Clear;
 end;

 THostObjectList = class(TStringList)
   constructor Create;
 end;

 THostConstructorList = class(THostObjectList);

 TTryStackRec = record
   B1, B2: Integer;
 end;

 TTryStack = class
   Card: Integer;
   A: array[1..MaxTryStack] of TTryStackRec;
   constructor Create;
   procedure Clear;
   procedure Push(N1, N2: Integer);
   procedure Pop;
   function Legal(N: Integer): boolean;
 end;

 TBreakpointList = TList;

 TRemovePropList = TStringList;

  THashArray = class
    A: array[0..MaxHash] of TList;
    constructor Create;
    destructor Destroy; override;
    function AddName(const Name: String; ID: Integer): Integer;
  end;


implementation

constructor THashArray.Create;
var
  I: Integer;
begin
  for I:=0 to MaxHash do
    A[I] := TList.Create;
end;

destructor THashArray.Destroy;
var
  I: Integer;
begin
  for I:=0 to MaxHash do
    A[I].Free;
end;

function THashArray.AddName(const Name: String; ID: Integer): Integer;
begin
  result := HashNumber(Name);
  if result = -1 then Exit;
//    raise TScriptFailure.Create(peLabelNotFound);
  with A[result] do
try
    if IndexOf(Pointer(ID)) = -1 then Begin
       Add(Pointer(ID));
    end;
except
   result:=-1;
end;
end;

constructor TScriptStack.Create;
begin
  inherited;
  Card := 0;
  SetLength(A, FirstStackSize);
  ASize:=FirstStackSize;
end;

destructor TScriptStack.Destroy;
begin
  SetLength(A, 0);
  inherited;
end;

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

procedure TScriptStack.Push(I: Integer);
begin
  if Card = {Length(A)} ASize-1 then Begin
    SetLength(A, Card + GrowStackSize);
    ASize:=Card+GrowStackSize;
  End;

  // 713 Card:=Card+1;
  Inc(Card);
  A[Card] := I;
end;

procedure TScriptStack.Pop(var I: Integer);
begin
  I := A[Card];
  //713 Card:=Card-1;
  Dec(Card);
end;

function TScriptStack.Top: Integer;
begin
  result := A[Card];
end;

procedure TScriptStack.Swap;
var
  temp: Integer;
begin
  temp := A[Card];
  A[Card] := A[Card - 1];
  A[Card - 1] := temp;
end;

procedure TScriptStack.SaveToStream(f: TStream);
begin
  f.Write(Card, SizeOf(Card));
  f.Write(A[1], Card*SizeOf(Integer));
end;

procedure TScriptStack.LoadFromStream(f: TStream);
begin
  f.Read(Card, SizeOf(Card));
  SetLength(A, Card + GrowStackSize);
  ASize:=Card+GrowStackSize;
  f.Read(A[1], Card*SizeOf(Integer));
end;

constructor TEntryStack.Create;
begin
  Card := 0;
end;

procedure TEntryStack.Push(ABreakLabel, AContinueLabel: Integer;
                                   var AStringLabel: String);
begin
  //713 Card:=Card+1;
  Inc(Card);
  with A[Card] do begin
    BreakLabel := ABreakLabel;
    ContinueLabel := AContinueLabel;
    StringLabel := AStringLabel;
  end;
  AStringLabel := '';
end;

procedure TEntryStack.Pop;
begin
  //713 Card:=Card-1;
  Dec(Card);
end;

function TEntryStack.TopBreakLabel(const AStringLabel: String = ''): Integer;
var
  I: Integer;
begin
  if AStringLabel <> '' then
  begin
    for I:=Card downto 1 do
      if A[I].StringLabel = AStringLabel then
      begin
        result := A[I].BreakLabel;
        Exit;
      end;
    raise TScriptFailure.Create(peLabelNotFound);
  end
  else
    result := A[Card].BreakLabel;
end;

function TEntryStack.TopContinueLabel(const AStringLabel: String = ''): Integer;
var
  I: Integer;
begin
  if AStringLabel <> '' then begin
    for I:=Card downto 1 do
      if A[I].StringLabel = AStringLabel then begin
        result := A[I].ContinueLabel;
        Exit;
      end;
    raise TScriptFailure.Create(peLabelNotFound);
  end
  else
    result := A[Card].ContinueLabel;
end;

constructor TWithStack.Create;
begin
  inherited;
  Card := 0;
end;

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

procedure TWithStack.Push(const V: Variant);
begin
  //713 Card:=Card+1;
  Inc(Card);
  A[Card] := V;
end;

procedure TWithStack.Pop;
begin
  Card:=Card-1;
end;

destructor TCallObject.Destroy;
begin
  SetLength(Arguments, 0);
end;

function TCallObject.ParamCount: Integer;
begin
  result := Length(Arguments);
end;

procedure TCallStack.Push(SubID: Integer );
var
  X: TCallObject;
begin
  X := TCallObject.Create;
  X.SubID := SubID;
  Add(X);
end;

procedure TCallStack.Pop(var SubID: Integer);
var
  X: TCallObject;
begin
  X := TCallObject(Items[Count - 1]);
  SubID := X.SubID;
  X.Free;
  Delete(Count - 1);
end;

function TCallStack.TopObject: TCallObject;
begin
  if Count = 0 then result := nil
  else result := TCallObject(Items[Count - 1]);
end;

constructor THostObjectList.Create;
begin
  inherited;
  Sorted := true;
  Duplicates := dupIgnore;
end;

constructor TTryStack.Create;
begin
  Card := 0;
end;

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

procedure TTryStack.Push(N1, N2: Integer);
begin
  //713 Card:=Card+1;
  Inc(Card);
  with A[Card] do begin
    B1 := N1;
    B2 := N2;
  end;
end;

procedure TTryStack.Pop;
begin
  Card:=Card-1;
end;

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

end.