fpc/compiler/new/symtable/symtablt.pas

{
    $Id$

    This unit implements the different types of symbol tables

    Copyright (C) 1999 by Daniel Mantione,
     member of the Free Pascal development team

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 ****************************************************************************
}
{$ifdef TP}
  {$N+,E+,F+}
{$endif}

unit symtablt;

interface

uses    objects,cobjects,symtable,globtype;


type    Pglobalsymtable=^Tglobalsymtable;
        Pinterfacesymtable=^Tinterfacesymtable;
        Pimplsymtable=^Tsymtable;
        Pprocsymtable=^Tprocsymtable;
        Punitsymtable=^Tunitsymtable;
        Pobjectsymtable=^Tobjectsymtable;

        Tglobalsymtable=object(Tcontainingsymtable)
            constructor init;
            {Checks if all used units are used.}
            procedure check_units;
            function tconstsymtodata(sym:Psym;len:longint):longint;virtual;
            function varsymtodata(sym:Psym;len:longint):longint;virtual;
        end;

        Tinterfacesymtable=object(Tglobalsymtable)
            unitid:word;
            function varsymprefix:string;virtual;
        end;

        Timplsymtable=object(Tglobalsymtable)
            unitid:word;
            function varsymprefix:string;virtual;
        end;

        Tabstractrecordsymtable=object(Tcontainingsymtable)
            procedure insert(sym:Psym);virtual;
            function varsymtodata(sym:Psym;len:longint):longint;virtual;
        end;

        Precordsymtable=^Trecordsymtable;
        Trecordsymtable=object(Tabstractsymtable)
        end;

        Tobjectsymtable=object(Tabstractrecordsymtable)
            defowner:Pobjectsymtable;
            function speedsearch(const s:stringid;
                                 speedvalue:longint):Psym;virtual;
        end;

        Tprocsymtable=object(Tcontainingsymtable)
            {Replaces the old local and paramsymtables.}
            lexlevel:byte;
            paramdatasize:longint;
            {If this is a method, this points to the objectdef. It is
             possible to make another Tmethodsymtable and move this field
             to it, but I think the advantage is not worth it. (DM)}
            method:Pdef;
            procedure insert(sym:Psym);virtual;
            function speedsearch(const s:stringid;
                                 speedvalue:longint):Psym;virtual;
            function varsymtodata(sym:Psym;len:longint):longint;virtual;
        end;

        Tunitsymtable=object(Tcontainingsymtable)
            unittypecount:word;
            unitsym:Psym;
            constructor init(const n:string);
            {Checks if all used units are used.}
            procedure check_units;
            function speedsearch(const s:stringid;
                                 speedvalue:longint):Psym;virtual;
            function tconstsymtodata(sym:Psym;len:longint):longint;virtual;
            function varsymprefix:string;virtual;
            destructor done;virtual;
        end;

        Twithsymtable=object(Tsymtable)
            link:Pcontainingsymtable;
            constructor init(Alink:Pcontainingsymtable);
            function speedsearch(const s:stringid;
                                 speedvalue:longint):Psym;virtual;
        end;

implementation

uses    symbols,files,globals,aasm,systems,defs,verbose;

function data_align(length:longint):longint;

begin
    if length>2 then
        data_align:=4
    else if length>1 then
        data_align:=2
    else
        data_align:=1;
end;

{****************************************************************************
                              Tglobalsymtable
****************************************************************************}

constructor Tglobalsymtable.init;

begin
    inherited init;
    index_growsize:=128;
end;

procedure Tglobalsymtable.check_units;

begin
end;

function Tglobalsymtable.tconstsymtodata(sym:Psym;len:longint):longint;

var ali:longint;
    segment:Paasmoutput;

begin
    if Ptypedconstsym(sym)^.is_really_const then
        segment:=consts
    else
        segment:=datasegment;
    if (cs_smartlink in aktmoduleswitches) then
        segment^.concat(new(Pai_cut,init));
    ali:=data_align(len);
    align(datasize,ali);
{$ifdef GDB}
    if cs_debuginfo in aktmoduleswitches then
        concatstabto(segment);
{$endif GDB}
    segment^.concat(new(Pai_symbol,initname_global(sym^.mangledname)));
end;

function Tglobalsymtable.varsymtodata(sym:Psym;len:longint):longint;

var ali:longint;

begin
    if (cs_smartlink in aktmoduleswitches) then
        bsssegment^.concat(new(Pai_cut,init));
    ali:=data_align(len);
    align(datasize,ali);
{$ifdef GDB}
    if cs_debuginfo in aktmoduleswitches then
        concatstabto(bsssegment);
{$endif GDB}
    bsssegment^.concat(new(Pai_datablock,
     init_global(sym^.mangledname,len)));
    varsymtodata:=inherited varsymtodata(sym,len);
    {This symbol can't be loaded to a register.}
    exclude(Pvarsym(sym)^.properties,vo_regable);
end;

{****************************************************************************
                               Timplsymtable
****************************************************************************}


function Timplsymtable.varsymprefix:string;

begin
    varsymprefix:='U_'+name^+'_';
end;

{****************************************************************************
                            Tinterfacesymtable
****************************************************************************}

function Tinterfacesymtable.varsymprefix:string;

begin
    varsymprefix:='_'+name^+'$$$'+'_';
end;

{****************************************************************************
                        Tabstractrecordsymtable
****************************************************************************}

procedure Tabstractrecordsymtable.insert(sym:Psym);

begin
{   if typeof(sym)=typeof(Tenumsym) then
        if owner<>nil then
            owner^.insert(sym)
        else
            internalerror($990802)
    else}
        inherited insert(sym);
end;

function Tabstractrecordsymtable.varsymtodata(sym:Psym;
                                             len:longint):longint;

begin
    datasize:=(datasize+(aktpackrecords-1)) and (not aktpackrecords-1);
    varsymtodata:=inherited varsymtodata(sym,len);
end;

{****************************************************************************
                             Trecordsymtable
****************************************************************************}

{****************************************************************************
                             Tobjectsymtable
****************************************************************************}

function Tobjectsymtable.speedsearch(const s:stringid;
                                     speedvalue:longint):Psym;

var r:Psym;

begin
    r:=inherited speedsearch(s,speedvalue);
    if (r<>nil) and (sp_static in Pprocdef(r)^.objprop) and
     allow_only_static then
        begin
            message(sym_e_only_static_in_static);
            speedsearch:=nil;
        end
    else
        speedsearch:=r;
end;

{****************************************************************************
                             Tprocsymsymtable
****************************************************************************}

procedure Tprocsymtable.insert(sym:Psym);

begin
{   if (method<>nil) and (method^.search(sym^.name)<>nil) then}
        inherited insert(sym)
{   else
        duplicatesym(sym)};
end;

function Tprocsymtable.speedsearch(const s:stringid;
                                   speedvalue:longint):Psym;

begin
    speedsearch:=inherited speedsearch(s,speedvalue);
end;

function Tprocsymtable.varsymtodata(sym:Psym;
                                    len:longint):longint;

var modulo:longint;

begin
    if typeof(sym^)=typeof(Tparamsym) then
        begin
            varsymtodata:=paramdatasize;
            paramdatasize:=align(datasize+len,target_os.stackalignment);
        end
    else
        begin
            {Sym must be a varsym.}
            {Align datastructures >=4 on a dword.}
            if len>=4 then
                align(len,4)
            else
{$ifdef m68k}
                {Align datastructures with size 1,2,3 on a word.}
                align(len,2);
{$else}
                {Align datastructures with size 2 or 3 on a word.}
                if len>=2 then
                    align(len,2);
{$endif}
            varsymtodata:=inherited varsymtodata(sym,len);
        end;
end;

{****************************************************************************
                               Tunitsymtable
****************************************************************************}

constructor Tunitsymtable.init(const n:string);

begin
    inherited init;
    name:=stringdup(n);
    index_growsize:=128;
end;

procedure Tunitsymtable.check_units;

begin
end;

function Tunitsymtable.speedsearch(const s:stringid;
                                   speedvalue:longint):Psym;

var r:Psym;

begin
    r:=inherited speedsearch(s,speedvalue);
{   if unitsym<>nil then
        Punitsym(unitsym)^.refs;}
{   if (r^.typ=unitsym) and assigned(current_module) and
     (current_module^.interfacesymtable<>@self) then
        r:=nil;}
    speedsearch:=r;
end;

function Tunitsymtable.tconstsymtodata(sym:Psym;len:longint):longint;

var ali:longint;
    segment:Paasmoutput;

begin
    if Ptypedconstsym(sym)^.is_really_const then
        segment:=consts
    else
        segment:=datasegment;
    if (cs_smartlink in aktmoduleswitches) then
        segment^.concat(new(Pai_cut,init));
    ali:=data_align(len);
    align(datasize,ali);
{$ifdef GDB}
    if cs_debuginfo in aktmoduleswitches then
        concatstabto(segment);
{$endif GDB}
    if (cs_smartlink in aktmoduleswitches) then
        segment^.concat(new(Pai_symbol,initname_global(sym^.mangledname)))
    else
        segment^.concat(new(Pai_symbol,initname(sym^.mangledname)));
end;

function Tunitsymtable.varsymprefix:string;

begin
    varsymprefix:='U_'+name^+'_';
end;

destructor Tunitsymtable.done;

begin
    stringdispose(name);
    inherited done;
end;

{****************************************************************************
                               Twithsymtable
****************************************************************************}

constructor Twithsymtable.init(Alink:Pcontainingsymtable);

begin
    inherited init;
    link:=Alink;
end;

function Twithsymtable.speedsearch(const s:stringid;speedvalue:longint):Psym;

begin
    speedsearch:=link^.speedsearch(s,speedvalue);
end;

end.