sparsarr.pas

TxQuery is an SQL engine implemented in a TDataSet descendant component, that can parse SQL syntax,

      While ( j < FSectionSize ) And ( Result = 0 ) Do
      Begin
        item := PPointer( itemP )^;
        If item <> Nil Then
          { ret := ApplyFunction(index, item.Ptr); }
          Asm
            mov   eax,index
            mov   edx,item
            push  callerBP
            call  ApplyFunction
            pop   ecx
            mov   @Result,eax
          End;
        Inc( itemP, SizeOf( Pointer ) );
        Inc( j );
        Inc( index )
      End
    End;
    Inc( i )
  End;
End;

Procedure TSparsePointerArray.ResetHighBound;
Var
  NewHighBound: Integer;

  Function Detector( TheIndex: Integer; TheItem: Pointer ): Integer; Far;
  Begin
    If TheIndex > FHighBound Then
      Result := 1
    Else
    Begin
      Result := 0;
      If TheItem <> Nil Then
        NewHighBound := TheIndex
    End
  End;

Begin
  NewHighBound := -1;
  ForAll( @Detector );
  FHighBound := NewHighBound
End;

{ TSparseList }

Constructor TSparseList.Create( Quantum: TSPAQuantum );
Begin
  NewList( Quantum )
End;

Destructor TSparseList.Destroy;
Begin
  If FList <> Nil Then
    FList.Destroy
End;

Function TSparseList.Add( Item: Pointer ): Integer;
Begin
  Result := FCount;
  FList[Result] := Item;
  Inc( FCount )
End;

Procedure TSparseList.Clear;
Begin
  FList.Destroy;
  NewList( FQuantum );
  FCount := 0
End;

Procedure TSparseList.Delete( Index: Integer );
Var
  I: Integer;
Begin
  If ( Index < 0 ) Or ( Index >= FCount ) Then
    Exit;
  For I := Index To FCount - 1 Do
    FList[I] := FList[I + 1];
  FList[FCount] := Nil;
  Dec( FCount );
End;

Procedure TSparseList.Error;
Begin
  Raise EListError.Create( 'List Index Error!' )
End;

Procedure TSparseList.Exchange( Index1, Index2: Integer );
Var
  temp: Pointer;
Begin
  temp := Get( Index1 );
  Put( Index1, Get( Index2 ) );
  Put( Index2, temp );
End;

Function TSparseList.First: Pointer;
Begin
  Result := Get( 0 )
End;

{ Jump to TSparsePointerArray.ForAll so that it looks like it was called
  from our caller, so that the BP trick works. }

Function TSparseList.ForAll( ApplyFunction: Pointer {TSPAApply} ): Integer; Assembler;
Asm
        MOV     EAX,[EAX].TSparseList.FList
        JMP     TSparsePointerArray.ForAll
End;

Function TSparseList.Get( Index: Integer ): Pointer;
Begin
  If Index < 0 Then
    Error;
  Result := FList[Index]
End;

Function TSparseList.IndexOf( Item: Pointer ): Integer;
Var
  MaxIndex, Index: Integer;

  Function IsTheItem( TheIndex: Integer; TheItem: Pointer ): Integer; Far;
  Begin
    If TheIndex > MaxIndex Then
      Result := -1 { Bail out }
    Else If TheItem <> Item Then
      Result := 0
    Else
    Begin
      Result := 1; { Found it, stop traversal }
      Index := TheIndex
    End
  End;

Begin
  Index := -1;
  MaxIndex := FList.HighBound;
  FList.ForAll( @IsTheItem );
  Result := Index
End;

Procedure TSparseList.Insert( Index: Integer; Item: Pointer );
Var
  i: Integer;
Begin
  If Index < 0 Then
    Error;
  I := FCount;
  While I > Index Do
  Begin
    FList[i] := FList[i - 1];
    Dec( i )
  End;
  FList[Index] := Item;
  If Index > FCount Then
    FCount := Index;
  Inc( FCount )
End;

Function TSparseList.Last: Pointer;
Begin
  Result := Get( FCount - 1 );
End;

Procedure TSparseList.Move( CurIndex, NewIndex: Integer );
Var
  Item: Pointer;
Begin
  If CurIndex <> NewIndex Then
  Begin
    Item := Get( CurIndex );
    Delete( CurIndex );
    Insert( NewIndex, Item );
  End;
End;

Procedure TSparseList.NewList( Quantum: TSPAQuantum );
Begin
  FQuantum := Quantum;
  FList := TSparsePointerArray.Create( Quantum )
End;

Procedure TSparseList.Pack;
Var
  i: Integer;
Begin
  For i := FCount - 1 Downto 0 Do
    If Items[i] = Nil Then
      Delete( i )
End;

Procedure TSparseList.Put( Index: Integer; Item: Pointer );
Begin
  If Index < 0 Then Error;
  FList[Index] := Item;
  FCount := FList.HighBound + 1
End;

Function TSparseList.Remove( Item: Pointer ): Integer;
Begin
  Result := IndexOf( Item );
  If Result <> -1 Then
    Delete( Result )
End;

{ TAggSparseList }

Constructor TAggSparseList.Create( Capacity: Integer );
Var
  quantum: TSPAQuantum;
Begin
  If Capacity > 256 Then
    quantum := SPALarge
  Else
    quantum := SPASmall;
  FList := TSparseList.Create( Quantum );
End;

Destructor TAggSparseList.Destroy;
Begin
  If FList <> Nil Then
  Begin
    Clear;
    FList.Destroy
  End
End;

Function TAggSparseList.HasData( Index: Integer ): Boolean;
Begin
  Result:= FList[Index] <> Nil;
End;

Function TAggSparseList.Get( Index: Integer ): Variant;
Var
  p: PAggItem;
Begin
  p := PAggItem( FList[Index] );
  If p = Nil Then
    Result := 0.0
  Else
    Result := p^.FValue;
End;

Function TAggSparseList.GetSqr( Index: Integer ): Double;
Var
  p: PAggItem;
Begin
  p := PAggItem( FList[Index] );
  If p = Nil Then
    Result := 0
  Else
    Result := p^.FSqrValue;
End;

Function TAggSparseList.GetCount( Index: Integer ): Integer;
Var
  p: PAggItem;
Begin
  p := PAggItem( FList[Index] );
  If p = Nil Then
    Result := 0
  Else
    Result := p^.FCount
End;

Procedure TAggSparseList.Put( Index: Integer; Const Value: Variant );
Var
  p: PAggItem;
Begin
  p := PAggItem( FList[Index] );
  If p = Nil Then
    FList[Index] := NewAggItem( Value, 0, 0 )
  Else
    p^.FValue := Value;
End;

Procedure TAggSparseList.PutSqr( Index: Integer; Const Value: Double );
Var
  p: PAggItem;
Begin
  p := PAggItem( FList[Index] );
  If p = Nil Then
    FList[Index] := NewAggItem( 0, Value, 0 )
  Else
    p^.FSqrValue := Value;
End;

Procedure TAggSparseList.PutCount( Index: Integer; Value: Integer );
Var
  p: PAggItem;
Begin
  p := PAggItem( FList[Index] );
  If p = Nil Then
    FList[Index] := NewAggItem( 0, 0, Value )
  Else
    p^.FCount := Value;
End;

Procedure TAggSparseList.Error;
Begin
  Raise EAggregateSparseListError.Create( 'Put Counts Error!' )
End;

Procedure TAggSparseList.Delete( Index: Integer );
Var
  p: PAggItem;
Begin
  p := PAggItem( FList[Index] );
  If p <> Nil Then
    DisposeAggItem( p );
  FList.Delete( Index );
End;

Procedure TAggSparseList.Exchange( Index1, Index2: Integer );
Begin
  FList.Exchange( Index1, Index2 );
End;

Procedure TAggSparseList.Insert( Index: Integer; Const Value: Variant );
Begin
  FList.Insert( Index, NewAggItem( Value, 0, 0 ) );
End;

Procedure TAggSparseList.Clear;

  Function ClearItem( TheIndex: Integer; TheItem: Pointer ): Integer; Far;
  Begin
    DisposeAggItem( PAggItem( TheItem ) ); { Item guaranteed non-nil }
    Result := 0
  End;

Begin
  FList.ForAll( @ClearItem );
  FList.Clear;
End;

End.