dws2symbols.pas

script language

begin
  Assert(Typ.Size = 1);
  SetLength(FDefaultValue,1);
  VarCopy(FDefaultValue[0],Value);
end;

{ TVarParamSymbol }

constructor TVarParamSymbol.Create(Name: string; Typ: TSymbol; IsWritable: Boolean);
begin
  inherited Create(Name, Typ);
  FSize := 1;
  FIsWritable := IsWritable;
end;

function TVarParamSymbol.GetDescription: string;
begin
  if FIsWritable then
    Result := 'var '
  else
    Result := 'const ';
  Result := Result + inherited GetDescription;  
end;

{ TSymbolTable }

function TSymbolTable.AddSymbol(Sym: TSymbol): Integer;
begin
  Result := FSymbols.Add(sym);
  if (sym is TDataSymbol) and (FAddrGenerator <> nil) then
  begin
    TDataSymbol(sym).Level := FAddrGenerator.Level;
    TDataSymbol(sym).StackAddr := FAddrGenerator.GetStackAddr(sym.Size);
  end;
end;

constructor TSymbolTable.Create(Parent: TSymbolTable; AddrGenerator: TAddrGenerator);
begin
  FSymbols := TList.Create;
  FParents := TList.Create;
  FDestructionList := TList.Create;
  FAddrGenerator := AddrGenerator;
  if Assigned(Parent) then
    AddParent(Parent);
end;

destructor TSymbolTable.Destroy;
var
  x: Integer;
begin
  FObjects.Free;
  for x := 0 to FSymbols.Count - 1 do
    TSymbol(FSymbols[x]).Free;
  for x := 0 to FDestructionList.Count - 1 do
    TSymbol(FDestructionList[x]).Free;
  FSymbols.Free;
  FDestructionList.Free;
  ClearParents;
  FParents.Free;
  inherited;
end;

function TSymbolTable.FindLocal(const Name: string): TSymbol;
var
  x: Integer;
begin
  Result := nil;
  // Lookup in Hot-list
  for x := 0 to SymbolCacheSize - 1 do
    if Assigned(FHot[x]) and (SameText(FHot[x].Name, Name)) then
    begin
      Result := FHot[x];
      Exit;
    end;

  // Lookup in symbol table
  for x := FSymbols.Count - 1 downto 0 do
    if SameText(TSymbol(FSymbols[x]).Name, Name) then
    begin
      Result := FSymbols[x];
      FHot[FCurrHot] := Result;
      Inc(FCurrHot);
      FCurrHot := FCurrHot mod SymbolCacheSize;
      Exit;
    end;
end;

function TSymbolTable.FindSymbol(const Name: string): TSymbol;
var
  x: Integer;
begin
  // Find Symbol in the local List
  Result := FindLocal(Name);
  if Assigned(Result) then
    Exit;

  // Find Symbol in all parent lists
  x := 0;
  while not Assigned(Result) and (x < ParentCount) do
  begin
    Result := Parents[x].FindSymbol(Name);
    Inc(x);
  end;
end;

function TSymbolTable.GetCount: Integer;
begin
  Result := FSymbols.Count;
end;

function TSymbolTable.GetSymbol(Index: Integer): TSymbol;
begin
  Result := TSymbol(FSymbols[Index])
end;

procedure TSymbolTable.Initialize;
var
  x: Integer;
begin
  for x := 0 to FSymbols.Count - 1 do
    TSymbol(FSymbols[x]).Initialize;
end;

function TSymbolTable.Remove(Sym: TSymbol): Integer;
begin
  ClearHotList;
  Result := FSymbols.Remove(Sym);
end;

procedure TSymbolTable.AddParent(Parent: TSymbolTable);
begin
  InsertParent(ParentCount,Parent);
end;

procedure TSymbolTable.SetSymbol(Index: Integer; Value: TSymbol);
begin
  FSymbols[Index] := Value;
end;

procedure TSymbolTable.InsertParent(Index: Integer; Parent: TSymbolTable);
begin
  FParents.Insert(Index,Parent);
end;

function TSymbolTable.RemoveParent(Parent: TSymbolTable): Integer;
begin
  Result := FParents.Remove(Parent);
end;

procedure TSymbolTable.ClearParents;
begin
  while ParentCount > 0 do
    RemoveParent(Parents[0]);
end;

procedure TSymbolTable.ReplaceSymbol(OldSym, NewSym: TSymbol);
var
  i: Integer;
begin
  ClearHotList;
  i := FSymbols.IndexOf(OldSym);
  if (i >= 0) then
    FSymbols[i] := newSym
  else if Assigned(newSym) then
    AddSymbol(newSym);
  OldSym.Free;
end;

procedure TSymbolTable.Clear;
begin
  ClearHotList;
  FSymbols.Clear;
end;

function TSymbolTable.HasSymbol(const Name: string): Boolean;
begin
  Result := Assigned(FindSymbol(Name));
end;

procedure TSymbolTable.AddToDestructionList(sym: TSymbol);
begin
  FDestructionList.Add(sym);
end;

procedure TSymbolTable.ClearHotList;
var
  x: Integer;
begin
  for x := 0 to SymbolCacheSize - 1 do
    FHot[x] := nil;
  FCurrHot := 0;
end;

function TSymbolTable.GetParentCount: Integer;
begin
  Result := FParents.Count;
end;

function TSymbolTable.GetParents(Index: Integer): TSymbolTable;
begin
  Result := TSymbolTable(FParents[Index]);
end;

function TSymbolTable.IndexOfParent(Parent: TSymbolTable): Integer;
begin
  Result := FParents.IndexOf(Parent);
end;

procedure TSymbolTable.AddObjectOwner(AOwner: IObjectOwner);
begin
  if not Assigned(FObjects) then
    FObjects := TInterfaceList.Create;
  FObjects.Add(AOwner);
end;

procedure TSymbolTable.BeforeDestruction;
var
  O : IObjectOwner;
begin
  if Assigned(FObjects) then begin
    while FObjects.Count > 0 do
    begin
      O := IObjectOwner(FObjects[0]);
      FObjects.Delete(0);
      O.ReleaseObject;
    end;
  end;
  inherited;
end;

procedure TSymbolTable.MoveParent(CurIndex, NewIndex: Integer);
begin
  FParents.Move(CurIndex,NewIndex);
end;

{ TExternalVarSymbol }

destructor TExternalVarSymbol.Destroy;
begin
  FReadFunc.Free;
  FWriteFunc.Free;
  inherited;
end;

function TExternalVarSymbol.GetReadFunc: TFuncSymbol;
begin
  Result := FReadFunc;
end;

function TExternalVarSymbol.GetWriteFunc: TFuncSymbol;
begin
  Result := FWriteFunc;
end;

{ TUnitSymbol }

constructor TUnitSymbol.Create(Name: string; Table: TSymbolTable;
  IsTableOwner: Boolean = False);
begin
  inherited Create(Name, nil);
  FIsTableOwner := IsTableOwner;
  FTable := Table;
end;

destructor TUnitSymbol.Destroy;
begin
  if FIsTableOwner then
    FTable.Free;
  inherited;
end;

procedure TUnitSymbol.Initialize;
begin
  if FIsTableOwner then
    FTable.Initialize;
end;

{ TAddrGenerator }

constructor TAddrGenerator.Create;
begin
  FLevel := Level;
  FMode := Mode;
  FDataSize := InitialSize;
end;

function TAddrGenerator.GetDataSize: Integer;
begin
  if FMode = agmPositive then
    Result := FDataSize
  else
    Result := -FDataSize;
end;

function TAddrGenerator.GetStackAddr(Size: Integer): Integer;
begin
  if FMode = agmPositive then
  begin
    Result := FDataSize;
    Inc(FDataSize, Size);
  end
  else
  begin
    Dec(FDataSize, Size);
    Result := FDataSize;
  end;
end;

{ TDynamicArraySymbol }

constructor TDynamicArraySymbol.Create(Name: string; Typ: TSymbol);
begin
  inherited Create(Name, Typ);
  FSize := 1; // ADR
end;

function TDynamicArraySymbol.GetCaption: string;
begin
  Result := 'array of ' + FTyp.Caption
end;

procedure TDynamicArraySymbol.InitData(Dat: TData; Offset: Integer);
begin
  Dat[Offset] := Null; // ADR
end;

function TDynamicArraySymbol.IsCompatible(typSym: TSymbol): Boolean;
begin
  typSym := typSym.BaseType;
  Result := (typSym is TCustomArraySymbol) and Typ.IsCompatible(typSym.Typ);
end;

{ TOpenArrayConstructorSymbol }

constructor TOpenArrayConstructorSymbol.Create(Name: string;
  Typ: TStaticArraySymbol);
begin
  inherited Create(Name, Typ);
end;

destructor TOpenArrayConstructorSymbol.Destroy;
begin
  FreeAndNil(FTyp);
  inherited;
end;

procedure TOpenArrayConstructorSymbol.UpdateSize;
begin
  FSize := Typ.Size;
end;

{ TElementSymbol }

constructor TElementSymbol.Create(Name: string; Typ: TSymbol;
  Value: Integer; IsUserDef: Boolean);
begin
  inherited Create(Name, Typ, Value);
  FIsUserDef := IsUserDef;
  FUserDefValue := Value;
end;

function TElementSymbol.GetDescription: string;
begin
  if FIsUserDef then
    Result := FName + ' = ' + IntToStr(Data[0])
  else
    Result := FName;  //inherited GetDescription; <= can cause stack overflow
end;

{ TEnumerationSymbol }

procedure TEnumerationSymbol.AddElement(Element: TElementSymbol);
begin
  FElements.AddSymbol(Element);
end;

constructor TEnumerationSymbol.Create(Name: string; BaseType: TTypeSymbol);
begin
  inherited Create(Name, BaseType);
  FElements := TSymbolTable.Create;
end;

destructor TEnumerationSymbol.Destroy;
begin
  FElements.Clear;
  FElements.Free;
  inherited;
end;

function TEnumerationSymbol.GetCaption: string;
begin
  Result := Name;
end;

function TEnumerationSymbol.GetDescription: string;
var
  x: Integer;
begin
  Result := '(';
  for x := 0 to FElements.Count - 1 do
  begin
    if x <> 0 then
      Result := Result + ', ';
    Result := Result + FElements[x].GetDescription;
  end;
  Result := Result + ')';
end;

{ TStaticSymbolTable }

constructor TStaticSymbolTable.Create(Parent: TStaticSymbolTable; Reference: Boolean);
begin
  inherited Create(Parent);
  FInitialized := False;
  FRefCount := 0;
  if Reference then
    _AddRef;
end;

procedure TStaticSymbolTable._AddRef;
begin
  InterlockedIncrement(FRefCount);
end;

procedure TStaticSymbolTable._Release;
begin
  if InterlockedDecrement(FRefCount) = 0 then
    Free;
end;

procedure TStaticSymbolTable.InsertParent(Index: Integer; Parent: TSymbolTable);
var
  staticSymbols: TStaticSymbolTable;
begin
  // accept only static parents
  if Parent is TLinkedSymbolTable then
    staticSymbols := TLinkedSymbolTable(Parent).Parent
  else if Parent is TStaticSymbolTable then
    staticSymbols := TStaticSymbolTable(Parent)
  else
    staticSymbols := nil;

  if Assigned(StaticSymbols) then
  begin
    staticSymbols._AddRef;
    inherited InsertParent(Index, staticSymbols);
  end
  else
    raise Exception.Create(CPE_NoStaticSymbols);
end;

function TStaticSymbolTable.RemoveParent(Parent: TSymbolTable): Integer;
begin
  Result := inherited RemoveParent(Parent);
  (Parent as TStaticSymbolTable)._Release;
end;

destructor TStaticSymbolTable.Destroy;
begin
  Assert(FRefCount = 0);
  inherited;
end;

procedure TStaticSymbolTable.Initialize;
begin
  if not FInitialized then
  begin
    inherited;
    FInitialized := True;
  end;
end;

{ TLinkedSymbolTable }

constructor TLinkedSymbolTable.Create(Parent: TStaticSymbolTable;
  AddrGenerator: TAddrGenerator);
begin
  inherited Create(nil,AddrGenerator);
  FParent := Parent;
  FParent._AddRef;
end;

destructor TLinkedSymbolTable.Destroy;
begin
  FParent._Release;
  inherited;
end;

function TLinkedSymbolTable.FindLocal(const Name: string): TSymbol;
begin
  Result := FParent.FindLocal(Name);
  if not Assigned(Result) then
    Result := inherited FindLocal(Name);
end;

function TLinkedSymbolTable.FindSymbol(const Name: string): TSymbol;
begin
  Result := FParent.FindSymbol(Name);
  if not Assigned(Result) then
    Result := inherited FindSymbol(Name);
end;

procedure TLinkedSymbolTable.Initialize;
begin
  FParent.Initialize;
  inherited;
end;

{ TAliasSymbol }

function TAliasSymbol.BaseType: TTypeSymbol;
begin
  result := Typ.BaseType;
end;

constructor TAliasSymbol.Create(Name: string; Typ: TTypeSymbol);
begin
  Assert(Assigned(Typ));
  inherited Create(Name,Typ);
end;

function TAliasSymbol.IsCompatible(typSym: TSymbol): Boolean;
begin
  result := BaseType.IsCompatible(typSym);
end;

{ TTypeSymbol }

function TTypeSymbol.BaseType: TTypeSymbol;
begin
  result := Self;
end;

function TTypeSymbol.IsCompatible(typSym: TSymbol): Boolean;
begin
  result := BaseType = typSym.BaseType;
end;

end.