freepascal.compiler/compiler/psub.pas

{
    $Id$
    Copyright (c) 1998-2002 by Florian Klaempfl, Daniel Mantione

    Does the parsing and codegeneration at subroutine level

    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 psub;

{$i fpcdefs.inc}

interface

    procedure compile_proc_body(make_global,parent_has_class:boolean);

    { reads the declaration blocks }
    procedure read_declarations(islibrary : boolean);

    { reads declarations in the interface part of a unit }
    procedure read_interface_declarations;


implementation

    uses
       { common }
       cutils,cclasses,
       { global }
       globtype,globals,tokens,verbose,comphook,
       systems,
       { aasm }
       cpubase,cpuinfo,aasmbase,aasmtai,
       { symtable }
       symconst,symbase,symdef,symsym,symtype,symtable,types,
       ppu,fmodule,
       { pass 1 }
       node,
       nbas,
       pass_1,
       { pass 2 }
{$ifndef NOPASS2}
       pass_2,
{$endif}
       { parser }
       scanner,
       pbase,pstatmnt,pdecl,pdecsub,pexports,
       { codegen }
       tgobj,cgbase,rgobj,rgcpu,
       ncgutil
       {$ifndef NOOPT}
         {$ifdef i386}
           ,aopt386
         {$else i386}
           ,aoptcpu
         {$endif i386}
       {$endif}
       ;


{****************************************************************************
                      PROCEDURE/FUNCTION BODY PARSING
****************************************************************************}

    function block(islibrary : boolean) : tnode;
      var
         storepos : tfileposinfo;
      begin
         { do we have an assembler block without the po_assembler?
           we should allow this for Delphi compatibility (PFV) }
         if (token=_ASM) and (m_delphi in aktmodeswitches) then
          include(aktprocdef.procoptions,po_assembler);

         { Handle assembler block different }
         if (po_assembler in aktprocdef.procoptions) then
          begin
            read_declarations(false);
            block:=assembler_block;
            exit;
          end;

         if not is_void(aktprocdef.rettype.def) then
           begin
              { if the current is a function aktprocsym is non nil }
              { and there is a local symtable set }
              storepos:=akttokenpos;
              akttokenpos:=aktprocsym.fileinfo;
              aktprocdef.funcretsym:=tfuncretsym.create(aktprocsym.name,aktprocdef.rettype);
              { insert in local symtable }
              symtablestack.insert(aktprocdef.funcretsym);
              akttokenpos:=storepos;
              if ret_in_acc(aktprocdef.rettype.def) or
                 (aktprocdef.rettype.def.deftype=floatdef) then
                procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
              { insert result also if support is on }
              if (m_result in aktmodeswitches) then
               begin
                 aktprocdef.resultfuncretsym:=tfuncretsym.create('RESULT',aktprocdef.rettype);
                 symtablestack.insert(aktprocdef.resultfuncretsym);
               end;
           end;
         read_declarations(islibrary);

         { temporary space is set, while the BEGIN of the procedure }
         if (symtablestack.symtabletype=localsymtable) then
           procinfo^.firsttemp_offset := -symtablestack.datasize
         else
           procinfo^.firsttemp_offset := 0;

         { space for the return value }
         { !!!!!   this means that we can not set the return value
         in a subfunction !!!!! }
         { because we don't know yet where the address is }
         if not is_void(aktprocdef.rettype.def) then
           begin
              if ret_in_acc(aktprocdef.rettype.def) or (aktprocdef.rettype.def.deftype=floatdef) then
                begin
                   { the space has been set in the local symtable }
                   procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
                   if ((procinfo^.flags and pi_operator)<>0) and
                      assigned(otsym) then
                     otsym.address:=-procinfo^.return_offset;
                   { eax is modified by a function }
                   include(rg.usedinproc,accumulator);
                   if (sizeof(aword) < 8) and
                      (is_64bitint(aktprocdef.rettype.def)) then
                     include(rg.usedinproc,accumulatorhigh);
                end;
           end;

         {Unit initialization?.}
         if (lexlevel=unit_init_level) and (current_module.is_unit)
            or islibrary then
           begin
             if (token=_END) then
                begin
                   consume(_END);
                   { We need at least a node, else the entry/exit code is not
                     generated and thus no PASCALMAIN symbol which we need (PFV) }
                   if islibrary then
                    block:=cnothingnode.create
                   else
                    block:=nil;
                end
              else
                begin
                   if token=_INITIALIZATION then
                     begin
                        current_module.flags:=current_module.flags or uf_init;
                        block:=statement_block(_INITIALIZATION);
                     end
                   else if (token=_FINALIZATION) then
                     begin
                        if (current_module.flags and uf_finalize)<>0 then
                          block:=statement_block(_FINALIZATION)
                        else
                          begin
                          { can we allow no INITIALIZATION for DLL ??
                            I think it should work PM }
                             block:=nil;
                             exit;
                          end;
                     end
                   else
                     begin
                        current_module.flags:=current_module.flags or uf_init;
                        block:=statement_block(_BEGIN);
                     end;
                end;
            end
         else
            block:=statement_block(_BEGIN);
      end;


{****************************************************************************
                       PROCEDURE/FUNCTION COMPILING
****************************************************************************}

    procedure compile_proc_body(make_global,parent_has_class:boolean);
      {
        Compile the body of a procedure
      }
      var
         oldexitlabel,oldexit2label : tasmlabel;
         oldfaillabel,oldquickexitlabel:tasmlabel;
         _class,hp:tobjectdef;
         { switches can change inside the procedure }
         entryswitches, exitswitches : tlocalswitches;
         oldaktmaxfpuregisters,localmaxfpuregisters : longint;
         { code for the subroutine as tree }
         code:tnode;
         { size of the local strackframe }
         stackframe:longint;
         { true when no stackframe is required }
         nostackframe:boolean;
         { number of bytes which have to be cleared by RET }
         parasize:longint;
         { filepositions }
         entrypos,
         savepos,
         exitpos   : tfileposinfo;
      begin
         { calculate the lexical level }
         inc(lexlevel);
         if lexlevel>32 then
          Message(parser_e_too_much_lexlevel);

         { static is also important for local procedures !! }
         if (po_staticmethod in aktprocdef.procoptions) then
           allow_only_static:=true
         else if (lexlevel=normal_function_level) then
           allow_only_static:=false;

         { save old labels }
         oldexitlabel:=aktexitlabel;
         oldexit2label:=aktexit2label;
         oldquickexitlabel:=quickexitlabel;
         oldfaillabel:=faillabel;
         { get new labels }
         getlabel(aktexitlabel);
         getlabel(aktexit2label);
         { exit for fail in constructors }
         if (aktprocdef.proctypeoption=potype_constructor) then
           begin
             getlabel(faillabel);
             getlabel(quickexitlabel);
           end;
         { reset break and continue labels }
         block_type:=bt_general;
         aktbreaklabel:=nil;
         aktcontinuelabel:=nil;

         { insert symtables for the class, by only if it is no nested function }
         if assigned(procinfo^._class) and not(parent_has_class) then
           begin
             { insert them in the reverse order ! }
             hp:=nil;
             repeat
               _class:=procinfo^._class;
               while _class.childof<>hp do
                 _class:=_class.childof;
               hp:=_class;
               _class.symtable.next:=symtablestack;
               symtablestack:=_class.symtable;
             until hp=procinfo^._class;
           end;

         { insert parasymtable in symtablestack}
         { only if lexlevel > 1 !!! global symtable should be right after staticsymtazble
           for checking of same names used in interface and implementation !! }
         if lexlevel>=normal_function_level then
           begin
              aktprocdef.parast.next:=symtablestack;
              symtablestack:=aktprocdef.parast;
              symtablestack.symtablelevel:=lexlevel;
           end;
         { insert localsymtable in symtablestack}
         aktprocdef.localst.next:=symtablestack;
         symtablestack:=aktprocdef.localst;
         symtablestack.symtablelevel:=lexlevel;
         { constant symbols are inserted in this symboltable }
         constsymtable:=symtablestack;

         { reset the temporary memory }
         rg.cleartempgen;
         rg.usedinproc:=[];

         { save entry info }
         entrypos:=aktfilepos;
         entryswitches:=aktlocalswitches;
         localmaxfpuregisters:=aktmaxfpuregisters;
         { parse the code ... }
         code:=block(current_module.islibrary);
         { get a better entry point }
         if assigned(code) then
           entrypos:=code.fileinfo;
         { save exit info }
         exitswitches:=aktlocalswitches;
         exitpos:=last_endtoken_filepos;
         { save current filepos }
         savepos:=aktfilepos;

         {When we are called to compile the body of a unit, aktprocsym should
          point to the unit initialization. If the unit has no initialization,
          aktprocsym=nil. But in that case code=nil. hus we should check for
          code=nil, when we use aktprocsym.}

         { set the start offset to the start of the temp area in the stack }
         tg.setfirsttemp(procinfo^.firsttemp_offset);

         { ... and generate assembler }
         { but set the right switches for entry !! }
         aktlocalswitches:=entryswitches;
         oldaktmaxfpuregisters:=aktmaxfpuregisters;
         aktmaxfpuregisters:=localmaxfpuregisters;
         if assigned(code) then
          begin
            { the procedure is now defined }
            aktprocdef.forwarddef:=false;

             { only generate the code if no type errors are found, else
               finish at least the type checking pass }
{$ifndef NOPASS2}
            if (status.errorcount=0) then
              begin
                generatecode(code);
                aktprocdef.code:=code;
{$ifdef testtemp}
                if assigned(aktprocdef) and assigned(aktprocdef.localst) then
                begin
                  stackframe:=align(tg.gettempsize+aktprocdef.localst.datasize,4);
                end
                else
                begin
                  stackframe:=tg.gettempsize;
                end;
                if lexlevel = 1 then
                  WriteLn(stackframe);
{$else}
                stackframe:=tg.gettempsize;
{                if lexlevel = 1 then
                  WriteLn(stackframe);}
{$endif}
                { first generate entry code with the correct position and switches }
                aktfilepos:=entrypos;
                aktlocalswitches:=entryswitches;
                genentrycode(procinfo^.aktentrycode,make_global,stackframe,parasize,nostackframe,false);

                { FPC_POPADDRSTACK destroys all registers (JM) }
                if (procinfo^.flags and (pi_needs_implicit_finally or pi_uses_exceptions)) <> 0 then
                 begin
                   rg.usedinproc := ALL_REGISTERS;
                 end;

                { now generate exit code with the correct position and switches }
                aktfilepos:=exitpos;
                aktlocalswitches:=exitswitches;
                genexitcode(procinfo^.aktexitcode,parasize,nostackframe,false);

                { now all the registers used are known }
                aktprocdef.usedregisters:=rg.usedinproc;
                procinfo^.aktproccode.insertlist(procinfo^.aktentrycode);
                procinfo^.aktproccode.concatlist(procinfo^.aktexitcode);
{$ifdef i386}
   {$ifndef NoOpt}
                if (cs_optimize in aktglobalswitches) and
                { do not optimize pure assembler procedures }
                   ((procinfo^.flags and pi_is_assembler)=0)  then
                  Optimize(procinfo^.aktproccode);
   {$endif NoOpt}
{$endif i386}
                { save local data (casetable) also in the same file }
                if assigned(procinfo^.aktlocaldata) and
                   (not procinfo^.aktlocaldata.empty) then
                 begin
                   procinfo^.aktproccode.concat(Tai_section.Create(sec_data));
                   procinfo^.aktproccode.concatlist(procinfo^.aktlocaldata);
                   procinfo^.aktproccode.concat(Tai_section.Create(sec_code));
                end;

                { add the procedure to the codesegment }
                if (cs_create_smart in aktmoduleswitches) then
                 codeSegment.concat(Tai_cut.Create);
                codeSegment.concatlist(procinfo^.aktproccode);
              end
            else
              do_resulttypepass(code);
{$else NOPASS2}
            do_resulttypepass(code);
{$endif NOPASS2}
          end;

         { ... remove symbol tables }
         if lexlevel>=normal_function_level then
           symtablestack:=symtablestack.next.next
         else
           symtablestack:=symtablestack.next;

         { ... check for unused symbols      }
         { but only if there is no asm block }
         if assigned(code) then
           begin
             if (Errorcount=0) then
               begin
                 { check if forwards are resolved }
                 tstoredsymtable(aktprocdef.localst).check_forwards;
                 { check if all labels are used }
                 tstoredsymtable(aktprocdef.localst).checklabels;
                 { remove cross unit overloads }
                 tstoredsymtable(aktprocdef.localst).unchain_overloaded;
               end;
             if (procinfo^.flags and pi_uses_asm)=0 then
               begin
                  { not for unit init, becuase the var can be used in finalize,
                    it will be done in proc_unit }
                  if not(aktprocdef.proctypeoption
                     in [potype_proginit,potype_unitinit,potype_unitfinalize]) then
                     tstoredsymtable(aktprocdef.localst).allsymbolsused;
                  tstoredsymtable(aktprocdef.parast).allsymbolsused;
               end;
           end;

         { the local symtables can be deleted, but the parast   }
         { doesn't, (checking definitons when calling a        }
         { function                                        }
         { not for a inline procedure !!               (PM)   }
         { at lexlevel = 1 localst is the staticsymtable itself }
         { so no dispose here !!                              }
         if assigned(code) and
            not(cs_browser in aktmoduleswitches) and
            (aktprocdef.proccalloption<>pocall_inline) then
           begin
             if lexlevel>=normal_function_level then
               aktprocdef.localst.free;
             aktprocdef.localst:=nil;
           end;

         { all registers can be used again }
         rg.resetusableregisters;
         { only now we can remove the temps }
         tg.resettempgen;

         { remove code tree, if not inline procedure }
         if assigned(code) and (aktprocdef.proccalloption<>pocall_inline) then
           code.free;

         { remove class member symbol tables }
         while symtablestack.symtabletype=objectsymtable do
           symtablestack:=symtablestack.next;

         aktmaxfpuregisters:=oldaktmaxfpuregisters;

         { restore filepos, the switches are already set }
         aktfilepos:=savepos;
         { restore labels }
         aktexitlabel:=oldexitlabel;
         aktexit2label:=oldexit2label;
         quickexitlabel:=oldquickexitlabel;
         faillabel:=oldfaillabel;

         { reset to normal non static function }
         if (lexlevel=normal_function_level) then
           allow_only_static:=false;
         { previous lexlevel }
         dec(lexlevel);
      end;


{****************************************************************************
                        PROCEDURE/FUNCTION PARSING
****************************************************************************}

    procedure checkvaluepara(p:tnamedindexitem;arg:pointer);
      var
        vs : tvarsym;
        s  : string;
      begin
        if tsym(p).typ<>varsym then
         exit;
        with tvarsym(p) do
         begin
           if copy(name,1,3)='val' then
            begin
              s:=Copy(name,4,255);
              if not(po_assembler in aktprocdef.procoptions) then
               begin
                 vs:=tvarsym.create(s,vartype);
                 vs.fileinfo:=fileinfo;
                 vs.varspez:=varspez;
                 aktprocdef.localst.insert(vs);
                 include(vs.varoptions,vo_is_local_copy);
                 vs.varstate:=vs_assigned;
                 localvarsym:=vs;
                 inc(refs); { the para was used to set the local copy ! }
                 { warnings only on local copy ! }
                 varstate:=vs_used;
               end
              else
               begin
                 aktprocdef.parast.rename(name,s);
               end;
            end;
         end;
      end;


    procedure read_proc;
      {
        Parses the procedure directives, then parses the procedure body, then
        generates the code for it
      }
      var
        oldprocsym       : tprocsym;
        oldprocdef       : tprocdef;
        oldprocinfo      : pprocinfo;
        oldconstsymtable : tsymtable;
        oldfilepos       : tfileposinfo;
        pdflags          : word;
      begin
      { save old state }
         oldprocdef:=aktprocdef;
         oldprocsym:=aktprocsym;
         oldconstsymtable:=constsymtable;
         oldprocinfo:=procinfo;
      { create a new procedure }
         codegen_newprocedure;
         with procinfo^ do
          begin
            parent:=oldprocinfo;
          { clear flags }
            flags:=0;
          { standard frame pointer }
            framepointer:=frame_pointer_reg;
          { is this a nested function of a method ? }
            if assigned(oldprocinfo) then
              _class:=oldprocinfo^._class;
          end;

         parse_proc_dec;

         procinfo^.procdef:=aktprocdef;

         { set the default function options }
         if parse_only then
          begin
            aktprocdef.forwarddef:=true;
            { set also the interface flag, for better error message when the
              implementation doesn't much this header }
            aktprocdef.interfacedef:=true;
            pdflags:=pd_interface;
          end
         else
          begin
            pdflags:=pd_body;
            if current_module.in_implementation then
             pdflags:=pdflags or pd_implemen;
            if (not current_module.is_unit) or (cs_create_smart in aktmoduleswitches) then
             pdflags:=pdflags or pd_global;
            procinfo^.exported:=false;
            aktprocdef.forwarddef:=false;
          end;

         { parse the directives that may follow }
         inc(lexlevel);
         parse_proc_directives(pdflags);
         dec(lexlevel);

         { hint directives, these can be separated by semicolons here,
           that need to be handled here with a loop (PFV) }
         while try_consume_hintdirective(aktprocsym.symoptions) do
          Consume(_SEMICOLON);

         { set aktfilepos to the beginning of the function declaration }
         oldfilepos:=aktfilepos;
         aktfilepos:=aktprocdef.fileinfo;

         { For varargs directive also cdecl and external must be defined }
         if (po_varargs in aktprocdef.procoptions) then
          begin
            { check first for external in the interface, if available there
              then the cdecl must also be there since there is no implementation
              available to contain it }
            if parse_only then
             begin
               { if external is available, then cdecl must also be available }
               if (po_external in aktprocdef.procoptions) and
                  not(aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
                Message(parser_e_varargs_need_cdecl_and_external);
             end
            else
             begin
               { both must be defined now }
               if not(po_external in aktprocdef.procoptions) or
                  not(aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
                Message(parser_e_varargs_need_cdecl_and_external);
             end;
          end;

         { search for forward declarations }
         if not proc_add_definition(aktprocsym,aktprocdef) then
           begin
             { A method must be forward defined (in the object declaration) }
             if assigned(procinfo^._class) and
                (not assigned(oldprocinfo^._class)) then
              begin
                Message1(parser_e_header_dont_match_any_member,aktprocdef.fullprocname);
                aktprocsym.write_parameter_lists(aktprocdef);
              end
             else
              begin
                { Give a better error if there is a forward def in the interface and only
                  a single implementation }
                if (not aktprocdef.forwarddef) and
                   assigned(aktprocsym.defs^.next) and
                   aktprocsym.defs^.def.forwarddef and
                   aktprocsym.defs^.def.interfacedef and
                   not(assigned(aktprocsym.defs^.next^.next)) then
                 begin
                   Message1(parser_e_header_dont_match_forward,aktprocdef.fullprocname);
                   aktprocsym.write_parameter_lists(aktprocdef);
                 end
                else
                 begin
                   { check the global flag, for delphi this is not
                     required }
                   if not(m_delphi in aktmodeswitches) and
                      ((procinfo^.flags and pi_is_global)<>0) then
                     Message(parser_e_overloaded_must_be_all_global);
                 end;
              end;
           end;

         { update procinfo, because the aktprocdef can be
           changed by check_identical_proc (PFV) }
         procinfo^.procdef:=aktprocdef;

{$ifdef i386}
         { add implicit pushes for interrupt routines }
         if (po_interrupt in aktprocdef.procoptions) then
           begin
             { we push Flags and CS as long
               to cope with the IRETD
               and we save 6 register + 4 selectors }
             inc(procinfo^.para_offset,8+6*4+4*2);
           end;
{$endif i386}

         { pointer to the return value ? }
         if ret_in_param(aktprocdef.rettype.def) then
          begin
            procinfo^.return_offset:=procinfo^.para_offset;
            inc(procinfo^.para_offset,pointer_size);
          end;
         { allows to access the parameters of main functions in nested functions }
         aktprocdef.parast.address_fixup:=procinfo^.para_offset;

         { when it is a value para and it needs a local copy then rename
           the parameter and insert a copy in the localst. This is not done
           for assembler procedures }
         if (not parse_only) and (not aktprocdef.forwarddef) then
           aktprocdef.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkvaluepara,nil);

         { restore file pos }
         aktfilepos:=oldfilepos;

         { compile procedure when a body is needed }
         if (pdflags and pd_body)<>0 then
           begin
             Message1(parser_p_procedure_start,
                      aktprocdef.fullprocname);
             aktprocdef.aliasnames.insert(aktprocdef.mangledname);
            { set _FAIL as keyword if constructor }
            if (aktprocdef.proctypeoption=potype_constructor) then
              tokeninfo^[_FAIL].keyword:=m_all;
            if assigned(aktprocdef._class) then
              tokeninfo^[_SELF].keyword:=m_all;

             compile_proc_body(((pdflags and pd_global)<>0),assigned(oldprocinfo^._class));

            { reset _FAIL as normal }
            if (aktprocdef.proctypeoption=potype_constructor) then
              tokeninfo^[_FAIL].keyword:=m_none;
            if assigned(aktprocdef._class) and (lexlevel=main_program_level) then
              tokeninfo^[_SELF].keyword:=m_none;
             consume(_SEMICOLON);
           end;
         { close }
         codegen_doneprocedure;
         { Restore old state }
         constsymtable:=oldconstsymtable;
{$ifdef notused}
         { restore the interface order to maintain CRC values PM }
         if assigned(prevdef) and assigned(aktprocdef.nextoverloaded) then
           begin
             stdef:=aktprocdef;
             aktprocdef:=stdef.nextoverloaded;
             stdef.nextoverloaded:=prevdef.nextoverloaded;
             prevdef.nextoverloaded:=stdef;
           end;
{$endif notused}
         aktprocsym:=oldprocsym;
         aktprocdef:=oldprocdef;
         procinfo:=oldprocinfo;
         otsym:=nil;
      end;


{****************************************************************************
                             DECLARATION PARSING
****************************************************************************}

    { search in symtablestack for not complete classes }
    procedure check_forward_class(p : tnamedindexitem;arg:pointer);
      begin
        if (tsym(p).typ=typesym) and
           (ttypesym(p).restype.def.deftype=objectdef) and
           (oo_is_forward in tobjectdef(ttypesym(p).restype.def).objectoptions) then
          MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
      end;


    procedure read_declarations(islibrary : boolean);

        procedure Not_supported_for_inline(t : ttoken);
        begin
           if assigned(aktprocsym) and
              (aktprocdef.proccalloption=pocall_inline) then
             Begin
                Message1(parser_w_not_supported_for_inline,tokenstring(t));
                Message(parser_w_inlining_disabled);
                aktprocdef.proccalloption:=pocall_fpccall;
             End;
        end;

      begin
         repeat
           case token of
              _LABEL:
                begin
                   Not_supported_for_inline(token);
                   label_dec;
                end;
              _CONST:
                begin
                   Not_supported_for_inline(token);
                   const_dec;
                end;
              _TYPE:
                begin
                   Not_supported_for_inline(token);
                   type_dec;
                end;
              _VAR:
                var_dec;
              _THREADVAR:
                threadvar_dec;
              _CONSTRUCTOR,_DESTRUCTOR,
              _FUNCTION,_PROCEDURE,_OPERATOR,_CLASS:
                begin
                   Not_supported_for_inline(token);
                   read_proc;
                end;
              _RESOURCESTRING:
                resourcestring_dec;
              _EXPORTS:
                begin
                   Not_supported_for_inline(token);
                   { here we should be at lexlevel 1, no ? PM }
                   if (lexlevel<>main_program_level) or
                      (current_module.is_unit) then
                     begin
                        Message(parser_e_syntax_error);
                        consume_all_until(_SEMICOLON);
                     end
                   else if islibrary or (target_info.target in [target_i386_WIN32,target_i386_wdosx,target_i386_Netware])
                   then  // AD
                     read_exports;
                end
              else break;
           end;
         until false;
         { check for incomplete class definitions, this is only required
           for fpc modes }
         if (m_fpc in aktmodeswitches) then
          symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_forward_class,nil);
      end;


    procedure read_interface_declarations;
      begin
         {Since the body is now parsed at lexlevel 1, and the declarations
          must be parsed at the same lexlevel we increase the lexlevel.}
         inc(lexlevel);
         repeat
           case token of
             _CONST :
               const_dec;
             _TYPE :
               type_dec;
             _VAR :
               var_dec;
             _THREADVAR :
               threadvar_dec;
             _RESOURCESTRING:
               resourcestring_dec;
             _FUNCTION,
             _PROCEDURE,
             _OPERATOR :
               read_proc;
             else
               break;
           end;
         until false;
         dec(lexlevel);
         { check for incomplete class definitions, this is only required
           for fpc modes }
         if (m_fpc in aktmodeswitches) then
          symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_forward_class,nil);
      end;

end.
{
  $Log$
  Revision 1.56  2002-07-07 09:52:32  florian
    * powerpc target fixed, very simple units can be compiled
    * some basic stuff for better callparanode handling, far from being finished

  Revision 1.55  2002/07/04 20:43:01  florian
    * first x86-64 patches

  Revision 1.54  2002/07/01 18:46:25  peter
    * internal linker
    * reorganized aasm layer

  Revision 1.53  2002/05/18 13:34:14  peter
    * readded missing revisions

  Revision 1.52  2002/05/16 19:46:44  carl
  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  + try to fix temp allocation (still in ifdef)
  + generic constructor calls
  + start of tassembler / tmodulebase class cleanup

  Revision 1.51  2002/05/14 19:34:49  peter
    * removed old logs and updated copyright year

  Revision 1.50  2002/05/12 16:53:09  peter
    * moved entry and exitcode to ncgutil and cgobj
    * foreach gets extra argument for passing local data to the
      iterator function
    * -CR checks also class typecasts at runtime by changing them
      into as
    * fixed compiler to cycle with the -CR option
    * fixed stabs with elf writer, finally the global variables can
      be watched
    * removed a lot of routines from cga unit and replaced them by
      calls to cgobj
    * u32bit-s32bit updates for and,or,xor nodes. When one element is
      u32bit then the other is typecasted also to u32bit without giving
      a rangecheck warning/error.
    * fixed pascal calling method with reversing also the high tree in
      the parast, detected by tcalcst3 test

  Revision 1.49  2002/04/20 21:32:24  carl
  + generic FPC_CHECKPOINTER
  + first parameter offset in stack now portable
  * rename some constants
  + move some cpu stuff to other units
  - remove unused constents
  * fix stacksize for some targets
  * fix generic size problems which depend now on EXTEND_SIZE constant

  Revision 1.48  2002/04/19 15:46:02  peter
    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
      in most cases and not written to the ppu
    * add mangeledname_prefix() routine to generate the prefix of
      manglednames depending on the current procedure, object and module
    * removed static procprefix since the mangledname is now build only
      on demand from tprocdef.mangledname

  Revision 1.47  2002/04/15 19:01:28  carl
  + target_info.size_of_pointer -> pointer_Size

  Revision 1.46  2002/04/04 18:45:19  carl
  + added wdosx support (patch from Pavel)

  Revision 1.45  2002/03/31 20:26:36  jonas
    + a_loadfpu_* and a_loadmm_* methods in tcg
    * register allocation is now handled by a class and is mostly processor
      independent (+rgobj.pas and i386/rgcpu.pas)
    * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
    * some small improvements and fixes to the optimizer
    * some register allocation fixes
    * some fpuvaroffset fixes in the unary minus node
    * push/popusedregisters is now called rg.save/restoreusedregisters and
      (for i386) uses temps instead of push/pop's when using -Op3 (that code is
      also better optimizable)
    * fixed and optimized register saving/restoring for new/dispose nodes
    * LOC_FPU locations now also require their "register" field to be set to
      R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
    - list field removed of the tnode class because it's not used currently
      and can cause hard-to-find bugs

  Revision 1.44  2002/01/19 15:37:24  peter
    * commited the wrong file :(

  Revision 1.43  2002/01/19 15:20:09  peter
    * also check at the end of the implementation for incomplete classes

  Revision 1.42  2002/01/19 15:12:34  peter
    * check for unresolved forward classes in the interface

}