freepascal.compiler/compiler/new/nmem.pas

{
    $Id$
    Copyright (C) 1993-99 by Florian Klaempfl

    This unit implements load nodes etc.

    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.

 ****************************************************************************
}
unit nmem;

  interface

    uses
       tree,symtable;

    type
       ploadnode = ^tloadnode;
       tloadnode = object(tnode)
          symtableentry : psym;
          symtable : psymtable;
          is_absolute,is_first,is_methodpointer : boolean;
          constructor init(v : pvarsym;st : psymtable);
          destructor done;virtual;

          procedure secondpass;virtual;
       end;

    var
       { this is necessary for the const section }
       simple_loadn : boolean;

  implementation

    uses
       cobjects,aasm,cgbase,cgobj
{$I cpuunit.inc}
{$I tempgen.inc}
       ;

{****************************************************************************
                                 TLOADNODE
 ****************************************************************************}

    constructor tloadnode.init(v : pvarsym;st : psymtable);

      var
         p : ptree;

      begin
         inherited init;
         treetype:=loadn;
         resulttype:=v^.definition;
         symtableentry:=v;
         symtable:=st;
         is_first := False;
         is_methodpointer:=false;

         { method pointer load nodes can use the left subtree }
         { !!!!! left:=nil; }
      end;

    destructor tloadnode.done;

      begin
         inherited done;
         { method pointer load nodes can use the left subtree }
         { !!!!! dispose(left,done); }
      end;

    procedure tloadnode.secondpass;

      var
         hregister : tregister;
         symtabletype : tsymtabletype;
         i : longint;
         hp : preference;

      begin
         simple_loadn:=true;
         reset_reference(location.reference);
         case symtableentry^.typ of
              { this is only for toasm and toaddr }
              absolutesym :
                 begin
                    if (pabsolutesym(symtableentry)^.abstyp=toaddr) then
                     begin
{$ifdef i386}
                       { absseg is go32v2 target specific }
                       if pabsolutesym(symtableentry)^.absseg then
                        location.reference.segment:=R_FS;
{$endif i386}
                       location.reference.offset:=pabsolutesym(symtableentry)^.address;
                     end
                    else
                     location.reference.symbol:=stringdup(symtableentry^.mangledname);
                    maybe_concat_external(symtableentry^.owner,symtableentry^.mangledname);
                 end;
              varsym :
                 begin
                    hregister:=R_NO;
                    { C variable }
                    if (pvarsym(symtableentry)^.var_options and vo_is_C_var)<>0 then
                      begin
                         location.reference.symbol:=stringdup(symtableentry^.mangledname);
                         if (pvarsym(symtableentry)^.var_options and vo_is_external)<>0 then
                           maybe_concat_external(symtableentry^.owner,symtableentry^.mangledname);
                      end

{$ifdef i386}
                    { DLL variable, DLL variables are onyl available on the win32 target }
                    { maybe we've to add this later for the alpha WinNT                  }
                    else if (pvarsym(symtableentry)^.var_options and vo_is_dll_var)<>0 then
                      begin
                         hregister:=getregister32;
                         stringdispose(location.reference.symbol);
                         location.reference.symbol:=stringdup(symtableentry^.mangledname);
                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(location.reference),hregister)));
                         stringdispose(location.reference.symbol);
                         location.reference.base:=hregister;
                         if (pvarsym(symtableentry)^.var_options and vo_is_external)<>0 then
                           maybe_concat_external(symtableentry^.owner,symtableentry^.mangledname);
                      end
{$endif i386}
                    else
                      begin
                         symtabletype:=symtable^.symtabletype;
                         { in case it is a register variable: }
                         if pvarsym(symtableentry)^.reg<>R_NO then
                           begin
                              location.loc:=LOC_CREGISTER;
                              location.register:=pvarsym(symtableentry)^.reg;
                              unused:=unused-[pvarsym(symtableentry)^.reg];
                           end
                         else
                           begin
                              { first handle local and temporary variables }
                              if (symtabletype in [parasymtable,inlinelocalsymtable,
                                                   inlineparasymtable,localsymtable]) then
                                begin
                                   location.reference.base:=procinfo.framepointer;
                                   location.reference.offset:=pvarsym(symtableentry)^.address;
                                   if (symtabletype=localsymtable) or (symtabletype=inlinelocalsymtable) then
                                     location.reference.offset:=-location.reference.offset;
                                   if (symtabletype=parasymtable) or (symtabletype=inlineparasymtable) then
                                     inc(location.reference.offset,symtable^.call_offset);
                                   if (lexlevel>(symtable^.symtablelevel)) then
                                     begin
                                        hregister:=getregister32;

                                        { make a reference }
                                        hp:=new_reference(procinfo.framepointer,
                                          procinfo.framepointer_offset);


                                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));

                                        simple_loadn:=false;
                                        i:=lexlevel-1;
                                        while i>(symtable^.symtablelevel) do
                                          begin
                                             { make a reference }
                                             hp:=new_reference(hregister,8);
                                             exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));
                                             dec(i);
                                          end;
                                        location.reference.base:=hregister;
                                     end;
                                end
                              else
                                case symtabletype of
                                   unitsymtable,globalsymtable,
                                   staticsymtable : begin
                                                       stringdispose(location.reference.symbol);
                                                       location.reference.symbol:=stringdup(symtableentry^.mangledname);
                                                       if symtabletype=unitsymtable then
                                                         concat_external(symtableentry^.mangledname,EXT_NEAR);
                                                    end;
                                   stt_exceptsymtable:
                                     begin
                                        location.reference.base:=procinfo.framepointer;
                                        location.reference.offset:=pvarsym(symtableentry)^.address;
                                     end;
                                   objectsymtable:
                                     begin
                                        if (pvarsym(symtableentry)^.properties and sp_static)<>0 then
                                          begin
                                             stringdispose(location.reference.symbol);
                                             location.reference.symbol:=
                                                stringdup(symtableentry^.mangledname);
                                             if symtable^.defowner^.owner^.symtabletype=unitsymtable then
                                               concat_external(symtableentry^.mangledname,EXT_NEAR);
                                          end
                                        else
                                          begin
                                             location.reference.base:=self_pointer;
                                             location.reference.offset:=pvarsym(symtableentry)^.address;
                                          end;
                                     end;
                                   withsymtable:
                                     begin
                                        hregister:=getregister32;
                                        location.reference.base:=hregister;
                                        { make a reference }
                                        { symtable datasize field
                                          contains the offset of the temp
                                          stored }
                                        hp:=new_reference(procinfo.framepointer,
                                          symtable^.datasize);

                                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));

                                        location.reference.offset:=
                                          pvarsym(symtableentry)^.address;
                                     end;
                                end;
                           end;
                         { in case call by reference, then calculate: }
                         if (pvarsym(symtableentry)^.varspez=vs_var) or
                            ((pvarsym(symtableentry)^.varspez=vs_const) and
{$ifndef VALUEPARA}
                             dont_copy_const_param(pvarsym(symtableentry)^.definition)) or
                             { call by value open arrays are also indirect addressed }
                             is_open_array(pvarsym(symtableentry)^.definition) then
{$else}
                             push_addr_param(pvarsym(symtableentry)^.definition)) then
{$endif}
                           begin
                              simple_loadn:=false;
                              if hregister=R_NO then
                                hregister:=getregister32;
                              if is_open_array(pvarsym(symtableentry)^.definition) or
                                 is_open_string(pvarsym(symtableentry)^.definition) then
                                begin
                                   if (location.reference.base=procinfo.framepointer) then
                                     begin
                                        highframepointer:=location.reference.base;
                                        highoffset:=location.reference.offset;
                                     end
                                   else
                                     begin
                                        highframepointer:=R_EDI;
                                        highoffset:=location.reference.offset;
                                        exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
                                          location.reference.base,R_EDI)));
                                     end;
                                end;
                              if location.loc=LOC_CREGISTER then
                                begin
                                   exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
                                     location.register,hregister)));
                                   location.loc:=LOC_REFERENCE;
                                end
                              else
                                begin
                                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
                                     newreference(location.reference),
                                     hregister)));
                                end;
                              clear_reference(location.reference);
                              location.reference.base:=hregister;
                          end;
                      end;
                 end;
              procsym:
                 begin
                    if is_methodpointer then
                      begin
                         secondpass(left);
                         stringdispose(location.reference.symbol);
                         { virtual method ? }
                         if (pprocsym(symtableentry)^.definition^.options and povirtualmethod)<>0 then
                           begin
                           end
                         else
                           begin
                              location.reference.symbol:=stringdup(pprocsym(symtableentry)^.definition^.mangledname);
                              maybe_concat_external(symtable,symtableentry^.mangledname);
                           end;
                      end
                    else
                      begin
                         {!!!!! Be aware, work on virtual methods too }
                         stringdispose(location.reference.symbol);
                         location.reference.symbol:=stringdup(pprocsym(symtableentry)^.definition^.mangledname);
                         maybe_concat_external(symtable,symtableentry^.mangledname);
                      end;
                 end;
              typedconstsym :
                 begin
                    stringdispose(location.reference.symbol);
                    location.reference.symbol:=stringdup(symtableentry^.mangledname);
                    maybe_concat_external(symtable,symtableentry^.mangledname);
                 end;
              else internalerror(4);
         end;
      end;

      end;

end.
{
  $Log$
  Revision 1.1  1999-01-24 22:32:36  florian
    * well, more changes, especially parts of secondload ported

}