freepascal.compiler/compiler/pmodules.pas

{
    Copyright (c) 1998-2008 by Florian Klaempfl

    Handles the parsing and loading of the modules (ppufiles)

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

{$i fpcdefs.inc}

interface

uses fmodule;

    function proc_unit(curr: tmodule):boolean;
    function parse_unit_interface_declarations(curr : tmodule) : boolean;
    function proc_unit_implementation(curr: tmodule):boolean;
    procedure proc_package(curr: tmodule);
    procedure proc_program(curr: tmodule; islibrary : boolean);
    procedure proc_program_declarations(curr : tmodule; islibrary : boolean);

implementation

    uses
       SysUtils,
       globtype,systems,tokens,
       cutils,cfileutl,cclasses,comphook,
       globals,verbose,finput,fppu,globstat,fpcp,fpkg,
       symconst,symbase,symtype,symdef,symsym,symtable,defutil,symcreat,
       wpoinfo,
       aasmtai,aasmdata,aasmbase,aasmcpu,
       cgbase,ngenutil,
       nbas,nutils,ncgutil,
       link,assemble,import,export,gendef,ppu,comprsrc,dbgbase,
       cresstr,procinfo,
       objcgutl,
       pkgutil,
       wpobase,
       scanner,pbase,pexpr,psystem,psub,pgenutil,pparautl,ncgvmt,ncgrtti,
       cpuinfo;


    procedure create_objectfile(curr : tmodule);
      var
        DLLScanner      : TDLLScanner;
        s               : string;
        KeepShared      : TCmdStrList;
      begin
        { try to create import entries from system dlls }
        if (tf_has_dllscanner in target_info.flags) and
           (not curr.linkOtherSharedLibs.Empty) then
         begin
           { Init DLLScanner }
           if assigned(CDLLScanner[target_info.system]) then
            DLLScanner:=CDLLScanner[target_info.system].Create
           else
            internalerror(200104121);
           KeepShared:=TCmdStrList.Create;
           { Walk all shared libs }
           While not curr.linkOtherSharedLibs.Empty do
            begin
              S:=curr.linkOtherSharedLibs.Getusemask(link_always);
              if not DLLScanner.scan(s) then
               KeepShared.Concat(s);
            end;
           DLLscanner.Free;
           { Recreate import section }
           if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
            begin
              if assigned(current_asmdata.asmlists[al_imports]) then
               current_asmdata.asmlists[al_imports].clear
              else
               current_asmdata.asmlists[al_imports]:=TAsmList.Create;
              importlib.generatelib;
            end;
           { Readd the not processed files }
           while not KeepShared.Empty do
            begin
              s:=KeepShared.GetFirst;
              curr.linkOtherSharedLibs.add(s,link_always);
            end;
           KeepShared.Free;
         end;

        { allow a target-specific pass over all assembler code (used by LLVM
          to insert type definitions }
        cnodeutils.InsertObjectInfo;

        { Start and end module debuginfo, at least required for stabs
          to insert n_sourcefile lines }
        if (cs_debuginfo in current_settings.moduleswitches) or
           (cs_use_lineinfo in current_settings.globalswitches) then
          current_debuginfo.insertmoduleinfo;

        { create the .s file and assemble it }
        if not(create_smartlink_library) or not(tf_no_objectfiles_when_smartlinking in target_info.flags) then
          GenerateAsm(false);

        { Also create a smartlinked version ? }
        if create_smartlink_library then
         begin
           GenerateAsm(true);
           if (af_needar in target_asm.flags) then
             Linker.MakeStaticLibrary;
         end;

        { resource files }
        CompileResourceFiles;
      end;


    procedure insertobjectfile(curr : tmodule);
    { Insert the used object file for this unit in the used list for this unit }
      begin
        curr.linkunitofiles.add(curr.objfilename,link_static);
        curr.headerflags:=curr.headerflags or uf_static_linked;

        if create_smartlink_library then
          begin
            curr.linkunitstaticlibs.add(curr.staticlibfilename ,link_smart);
            curr.headerflags:=curr.headerflags or uf_smart_linked;
          end;
        if cs_lto in current_settings.moduleswitches then
          begin
            curr.linkunitofiles.add(ChangeFileExt(curr.objfilename,LTOExt),link_lto);
            curr.headerflags:=curr.headerflags or uf_lto_linked;
          end;
      end;


    procedure create_dwarf_frame;
      begin
        { Dwarf conflicts with smartlinking in separate .a files }
        if create_smartlink_library then
          exit;
        { Call frame information }
        { MWE: we write our own info, so dwarf asm support is not really needed }
        { if (af_supports_dwarf in target_asm.flags) and }
        { CFI is currently broken for Darwin }
        if not(target_info.system in systems_darwin) and
           (
            (tf_needs_dwarf_cfi in target_info.flags) or
            (target_dbg.id in [dbg_dwarf2, dbg_dwarf3])
           ) then
          begin
            current_asmdata.asmlists[al_dwarf_frame].Free;
            current_asmdata.asmlists[al_dwarf_frame] := TAsmList.create;
            current_asmdata.asmcfi.generate_code(current_asmdata.asmlists[al_dwarf_frame]);
          end;
      end;

    Function CheckResourcesUsed(curr : tmodule) : boolean;
      var
        hp           : tused_unit;
        found        : Boolean;
      begin
        CheckResourcesUsed:=tf_has_winlike_resources in target_info.flags;
        if not CheckResourcesUsed then exit;

        hp:=tused_unit(usedunits.first);
        found:=mf_has_resourcefiles in curr.moduleflags;
        while Assigned(hp) and not found do
          begin
            found:=mf_has_resourcefiles in hp.u.moduleflags;
            hp:=tused_unit(hp.next);
          end;
        CheckResourcesUsed:=found;
      end;

    function AddUnit(curr : tmodule; const s:string;addasused:boolean): tppumodule;
      var
        hp : tppumodule;
        unitsym : tunitsym;

      begin
        { load unit }
        hp:=registerunit(curr,s,'');
        hp.loadppu(curr);
        hp.adddependency(curr,curr.in_interface);
        { add to symtable stack }
        symtablestack.push(hp.globalsymtable);
        if (m_mac in current_settings.modeswitches) and
           assigned(hp.globalmacrosymtable) then
          macrosymtablestack.push(hp.globalmacrosymtable);
        { insert unitsym }
        unitsym:=cunitsym.create(hp.modulename^,hp);
        inc(unitsym.refs);
        tabstractunitsymtable(curr.localsymtable).insertunit(unitsym);
        if addasused then
          { add to used units }
          curr.addusedunit(hp,false,unitsym);
        result:=hp;
      end;


    function AddUnit(curr :tmodule; const s:string):tppumodule;
      begin
        result:=AddUnit(curr,s,true);
      end;


    procedure maybeloadvariantsunit(curr : tmodule);
      var
        hp : tmodule;
        addsystemnamespace : Boolean;
      begin
        { Do we need the variants unit? Skip this
          for VarUtils unit for bootstrapping }
        if not(mf_uses_variants in curr.moduleflags) or
           (curr.modulename^='VARUTILS') or
           (curr.modulename^='SYSTEM.VARUTILS') then
          exit;
        { Variants unit already loaded? }
        hp:=tmodule(loaded_units.first);
        while assigned(hp) do
          begin
            if (hp.modulename^='VARIANTS') or (hp.modulename^='SYSTEM.VARIANTS') then
              exit;
            hp:=tmodule(hp.next);
          end;
        { Variants unit is not loaded yet, load it now }
        Message(parser_w_implicit_uses_of_variants_unit);
        addsystemnamespace:=namespacelist.Find('System')=Nil;
        if addsystemnamespace then
          namespacelist.concat('System');
        AddUnit(curr,'variants');
        if addsystemnamespace then
          namespacelist.Remove('System');
      end;


    function MaybeRemoveResUnit(curr : tmodule) : boolean;
      var
        resources_used : boolean;
        hp : tmodule;
        uu : tused_unit;
        unitname : shortstring;
      begin
        { We simply remove the unit from:
           - usedunit list, so that things like init/finalization table won't
              contain references to this unit
           - loaded_units list, so that the unit object file doesn't get linked
             with the executable. }
        { Note: on windows we always need resources! }
        resources_used:=(target_info.system in systems_all_windows)
                         or CheckResourcesUsed(curr);
        if (not resources_used) and (tf_has_winlike_resources in target_info.flags) then
          begin
            { resources aren't used, so we don't need this unit }
            if target_res.id=res_ext then
              unitname:='FPEXTRES'
            else
              unitname:='FPINTRES';
            Message1(unit_u_unload_resunit,unitname);
            { find the module }
            hp:=tmodule(loaded_units.first);
            while assigned(hp) do
              begin
                if hp.is_unit and (hp.modulename^=unitname) then break;
                hp:=tmodule(hp.next);
              end;
            if not assigned(hp) then
              internalerror(200801071);
            { find its tused_unit in the global list }
            uu:=tused_unit(usedunits.first);
            while assigned(uu) do
              begin
                if uu.u=hp then break;
                uu:=tused_unit(uu.next);
              end;
            if not assigned(uu) then
              internalerror(200801072);
           { remove the tused_unit }
            usedunits.Remove(uu);
            uu.Free;
           { remove the module }
            loaded_units.Remove(hp);
            unloaded_units.Concat(hp);
          end;
        MaybeRemoveResUnit:=resources_used;
      end;


    procedure loadsystemunit(curr : tmodule);
      var
        state: tglobalstate;

      begin
        { we are going to rebuild the symtablestack, clear it first }
        symtablestack.clear;
        macrosymtablestack.clear;

        { macro symtable }
        macrosymtablestack.push(initialmacrosymtable);

        { are we compiling the system unit? }
        if (cs_compilesystem in current_settings.moduleswitches) then
         begin
           systemunit:=tglobalsymtable(curr.localsymtable);
           { create system defines }
           create_intern_types;
           create_intern_symbols;
           { Set the owner of errorsym and errortype to symtable to
             prevent crashes when accessing .owner }
           generrorsym.owner:=systemunit;
           generrordef.owner:=systemunit;
           exit;
         end;

        { insert the system unit, it is allways the first. Load also the
          internal types from the system unit }
        AddUnit(curr,'system');
        systemunit:=tglobalsymtable(symtablestack.top);

        { load_intern_types resets the scanner... }
        current_scanner.tempcloseinputfile;
        state:=tglobalstate.create(true);
        load_intern_types;
        state.restore(true);
        FreeAndNil(state);
        current_scanner.tempopeninputfile;

        { Set the owner of errorsym and errortype to symtable to
          prevent crashes when accessing .owner }
        generrorsym.owner:=systemunit;
        generrordef.owner:=systemunit;
        // Implicitly enable unicode strings in unicode RTL in modes objfpc/delphi.
        { TODO: Check if we should also do this for mode macpas }
        if not (cs_compilesystem in current_settings.moduleswitches) then
          if ([m_objfpc,m_delphi] * current_settings.modeswitches)<>[] then
            if is_systemunit_unicode then
              Include(current_settings.modeswitches,m_default_unicodestring);
      end;


    procedure loaddefaultunits(curr :tmodule);
      begin
        { Units only required for main module }
        if not(curr.is_unit) then
         begin
           { Heaptrc unit, load heaptrace before any other units especially objpas }
           if (cs_use_heaptrc in current_settings.globalswitches) then
             AddUnit(curr,'heaptrc');
           { Valgrind requires c memory manager }
           if (cs_gdb_valgrind in current_settings.globalswitches) or
              (([cs_sanitize_address]*current_settings.moduleswitches)<>[]) then
             AddUnit(curr,'cmem');
           { Lineinfo unit }
           if (cs_use_lineinfo in current_settings.globalswitches) then begin
             case target_dbg.id of
               dbg_stabs:
                 AddUnit(curr,'lineinfo');
               dbg_stabx:
                 AddUnit(curr,'lnfogdb');
               else
                 AddUnit(curr,'lnfodwrf');
             end;
           end;
{$ifdef cpufpemu}
           { Floating point emulation unit?
             softfpu must be in the system unit anyways (FK)
           if (cs_fp_emulation in current_settings.moduleswitches) and not(target_info.system in system_wince) then
             AddUnit('softfpu');
           }
{$endif cpufpemu}
           { Which kind of resource support?
             Note: if resources aren't used this unit will be removed later,
             otherwise we need it here since it must be loaded quite early }
           if (tf_has_winlike_resources in target_info.flags) then
             if target_res.id=res_ext then
               AddUnit(curr,'fpextres')
             else
               AddUnit(curr,'fpintres');
         end
        else if (cs_checkpointer in current_settings.localswitches) then
          AddUnit(curr,'heaptrc');
        { Objpas unit? }
        if m_objpas in current_settings.modeswitches then
          AddUnit(curr,'objpas');

        { Macpas unit? }
        if m_mac in current_settings.modeswitches then
          AddUnit(curr,'macpas');

        if m_iso in current_settings.modeswitches then
          AddUnit(curr,'iso7185');

        if m_extpas in current_settings.modeswitches then
          begin
            { basic procedures for Extended Pascal are for now provided by the iso unit }
            AddUnit(curr,'iso7185');
            AddUnit(curr,'extpas');
          end;

        { blocks support? }
        if m_blocks in current_settings.modeswitches then
          AddUnit(curr,'blockrtl');

        { Determine char size. }

        // Ansi RTL ?
        if not is_systemunit_unicode then
          begin
          if m_default_unicodestring in current_settings.modeswitches then
            AddUnit(curr,'uuchar'); // redefines char as widechar
          end
        else
          begin
          // Unicode RTL
          if not (m_default_ansistring in current_settings.modeswitches) then
            if not (curr.modulename^<>'UACHAR') then
              AddUnit(curr,'uachar'); // redefines char as ansichar
          end;

        { Objective-C support unit? }
        if (m_objectivec1 in current_settings.modeswitches) then
          begin
            { interface to Objective-C run time }
            AddUnit(curr,'objc');
            loadobjctypes;
            { NSObject }
            if not(curr.is_unit) or
               (curr.modulename^<>'OBJCBASE') then
              AddUnit(curr,'objcbase');
          end;
        { Profile unit? Needed for go32v2 only }
        if (cs_profile in current_settings.moduleswitches) and
           (target_info.system in [system_i386_go32v2,system_i386_watcom]) then
          AddUnit(curr,'profile');
        if (cs_load_fpcylix_unit in current_settings.globalswitches) then
          begin
            AddUnit(curr,'fpcylix');
            AddUnit(curr,'dynlibs');
          end;
{$push}
{$warn 6018 off} { Unreachable code due to compile time evaluation }
        { CPU targets with microcontroller support can add a controller specific unit }
        if ControllerSupport and (target_info.system in (systems_embedded+systems_freertos)) and
          (current_settings.controllertype<>ct_none) and
          (embedded_controllers[current_settings.controllertype].controllerunitstr<>'') and
          (embedded_controllers[current_settings.controllertype].controllerunitstr<>curr.modulename^) then
          AddUnit(curr,embedded_controllers[current_settings.controllertype].controllerunitstr);
{$pop}
{$ifdef XTENSA}
        if not(curr.is_unit) and (target_info.system=system_xtensa_freertos) then
          if (current_settings.controllertype=ct_esp32) then
            begin
              if (idf_version>=40100) and (idf_version<40200) then
                AddUnit(curr,'espidf_40100')
              else if (curr,idf_version>=40200) and (idf_version<40400) then
                AddUnit(curr,'espidf_40200')
              else if idf_version>=40400 then
                AddUnit(curr,'espidf_40400')
              else
                Comment(V_Warning, 'Unsupported esp-idf version');
            end
          else if (current_settings.controllertype=ct_esp8266) then
            begin
              if (idf_version>=30300) and (idf_version<30400) then
                AddUnit(curr,'esp8266rtos_30300')
              else if idf_version>=30400 then
                AddUnit(curr,'esp8266rtos_30400')
              else
                Comment(V_Warning, 'Unsupported esp-rtos version');
            end;
{$endif XTENSA}
      end;


    procedure loadautounits(curr: tmodule);
      var
        hs,s : string;
      begin
        hs:=autoloadunits;
        repeat
          s:=GetToken(hs,',');
          if s='' then
            break;
          AddUnit(curr,s);
        until false;
      end;

    procedure parseusesclause(curr: tmodule);

      var
         s,sorg  : ansistring;
         fn      : string;
         pu  : tused_unit;
         hp2     : tmodule;
         unitsym : tunitsym;
         filepos : tfileposinfo;

      begin
        consume(_USES);
        repeat
          s:=pattern;
          sorg:=orgpattern;
          filepos:=current_tokenpos;
          consume(_ID);
          while token=_POINT do
            begin
              consume(_POINT);
              s:=s+'.'+pattern;
              sorg:=sorg+'.'+orgpattern;
              consume(_ID);
            end;
          { support "<unit> in '<file>'" construct, but not for tp7 }
          fn:='';
          if not(m_tp7 in current_settings.modeswitches) and
             try_to_consume(_OP_IN) then
            fn:=FixFileName(get_stringconst);
          { Give a warning if lineinfo is loaded }
          if s='LINEINFO' then
            begin
              Message(parser_w_no_lineinfo_use_switch);
              if (target_dbg.id in [dbg_dwarf2, dbg_dwarf3]) then
               s := 'LNFODWRF';
             sorg := s;
            end;
          { Give a warning if objpas is loaded }
          if s='OBJPAS' then
           Message(parser_w_no_objpas_use_mode);
          { Using the unit itself is not possible }
          if (s<>curr.modulename^) then
           begin
             { check if the unit is already used }
             hp2:=nil;
             pu:=tused_unit(curr.used_units.first);
             while assigned(pu) do
              begin
                if (pu.u.modulename^=s) then
                 begin
                   hp2:=pu.u;
                   break;
                 end;
                pu:=tused_unit(pu.next);
              end;
             if not assigned(hp2) then
               hp2:=registerunit(curr,sorg,fn)
             else
               Message1(sym_e_duplicate_id,s);
             { Create unitsym, we need to use the name as specified, we
               can not use the modulename because that can be different
               when -Un is used }
             current_tokenpos:=filepos;
             unitsym:=cunitsym.create(sorg,nil);
             { the current module uses the unit hp2 }
             curr.addusedunit(hp2,true,unitsym);
           end
          else
           Message1(sym_e_duplicate_id,s);
          if token=_COMMA then
           begin
             pattern:='';
             consume(_COMMA);
           end
          else
           break;
        until false;
      end;

    procedure loadunits(curr: tmodule; preservest:tsymtable; frominterface : boolean);

      var
         s,sorg  : ansistring;
         pu,pu2  : tused_unit;
         hp2     : tmodule;
         state: tglobalstate;

         procedure restorestate;

         begin
           state.restore(true);
           if assigned(current_scanner) and (current_module.scanner=current_scanner) then
              begin
              if assigned(current_scanner.inputfile) then
                current_scanner.tempopeninputfile;
              end;

           state.free;
         end;

      begin
        parseusesclause(curr);
        current_scanner.tempcloseinputfile;
        state:=tglobalstate.create(true);
         { Load the units }
         pu:=tused_unit(curr.used_units.first);
         while assigned(pu) do
          begin
            { Only load the units that are in the current
              (interface/implementation) uses clause }
            if pu.in_uses and
               (pu.in_interface=curr.in_interface) then
             begin
               tppumodule(pu.u).loadppu(curr);
               { is our module compiled? then we can stop }
               if curr.state=ms_compiled then
                 begin
                   Restorestate;
                   exit;
                 end;
               { add this unit to the dependencies }
               pu.u.adddependency(curr,frominterface);
               { save crc values }
               pu.checksum:=pu.u.crc;
               pu.interface_checksum:=pu.u.interface_crc;
               pu.indirect_checksum:=pu.u.indirect_crc;
               if tppumodule(pu.u).nsprefix<>'' then
                 begin
                   { use the name as declared in the uses section for -Un }
                   sorg:=tppumodule(pu.u).nsprefix+'.'+pu.unitsym.realname;
                   s:=upper(sorg);
                   { check whether the module was already loaded }
                   hp2:=nil;
                   pu2:=tused_unit(curr.used_units.first);
                   while assigned(pu2) and (pu2<>pu) do
                    begin
                      if (pu2.u.modulename^=s) then
                       begin
                         hp2:=pu.u;
                         break;
                       end;
                      pu2:=tused_unit(pu2.next);
                    end;
                   if assigned(hp2) then
                     begin
                       MessagePos1(pu.unitsym.fileinfo,sym_e_duplicate_id,s);
                       pu:=tused_unit(pu.next);
                       continue;
                     end;
                   { update unitsym now that we have access to the full name }
                   pu.unitsym.free;
                   pu.unitsym:=cunitsym.create(sorg,pu.u);
                 end
               else
                 begin
                   { connect unitsym to the module }
                   pu.unitsym.module:=pu.u;
                   pu.unitsym.register_sym;
                 end;
               tabstractunitsymtable(curr.localsymtable).insertunit(pu.unitsym);
               { add to symtable stack }
               if assigned(preservest) then
                 symtablestack.pushafter(pu.u.globalsymtable,preservest)
               else
                 symtablestack.push(pu.u.globalsymtable);
               if (m_mac in current_settings.modeswitches) and
                  assigned(pu.u.globalmacrosymtable) then
                 macrosymtablestack.push(pu.u.globalmacrosymtable);
               { check hints }
               pu.check_hints;
             end;
            pu:=tused_unit(pu.next);
          end;
         Restorestate;
      end;


     procedure reset_all_defs(curr: tmodule);
       begin
         if assigned(curr.wpoinfo) then
           curr.wpoinfo.resetdefs;
       end;


    procedure free_localsymtables(st:TSymtable);
      var
        i   : longint;
        def : tstoreddef;
        pd  : tprocdef;
      begin
        for i:=0 to st.DefList.Count-1 do
          begin
            def:=tstoreddef(st.DefList[i]);
            if def.typ=procdef then
              begin
                pd:=tprocdef(def);
                if assigned(pd.localst) and
                   (pd.localst.symtabletype<>staticsymtable) and
                   not(po_inline in pd.procoptions) then
                  begin
                    free_localsymtables(pd.localst);
                    pd.localst.free;
                    pd.localst:=nil;
                  end;
                pd.freeimplprocdefinfo;
                pd.done_paraloc_info(calleeside);
              end;
          end;
      end;


    procedure free_unregistered_localsymtable_elements(curr : tmodule);
      var
        i: longint;
        def: tdef;
        sym: tsym;
      begin
        for i:=curr.localsymtable.deflist.count-1 downto 0 do
          begin
            def:=tdef(curr.localsymtable.deflist[i]);
            { since commit 48986 deflist might have NIL entries }
            if not assigned(def) then
              continue;
            { this also frees def, as the defs are owned by the symtable }
            if not def.is_registered and
               not(df_not_registered_no_free in def.defoptions) then
              begin
                { if it's a procdef, unregister it from its procsym first,
                  unless that sym hasn't been registered either (it's possible
                  to have one overload in the interface and another in the
                  implementation) }
                if (def.typ=procdef) and
                   tprocdef(def).procsym.is_registered then
                 tprocsym(tprocdef(def).procsym).ProcdefList.Remove(def);
                curr.localsymtable.deletedef(def);
              end;
          end;
        { from high to low so we hopefully have moves of less data }
        for i:=curr.localsymtable.symlist.count-1 downto 0 do
          begin
            sym:=tsym(curr.localsymtable.symlist[i]);
            { this also frees sym, as the symbols are owned by the symtable }
            if not sym.is_registered then
              curr.localsymtable.DeleteSym(sym);
          end;
      end;


    procedure setupglobalswitches;
      begin
        if (cs_create_pic in current_settings.moduleswitches) then
          begin
            def_system_macro('FPC_PIC');
            def_system_macro('PIC');
          end;
      end;


    function create_main_proc(const name:TSymStr;potype:tproctypeoption;st:TSymtable):tcgprocinfo;
      var
        ps  : tprocsym;
        pd  : tprocdef;
      begin
        { there should be no current_procinfo available }
        if assigned(current_procinfo) then
         internalerror(200304275);
        {Generate a procsym for main}
        ps:=cprocsym.create('$'+name);
        { always register the symbol }
        ps.register_sym;
        { main are allways used }
        inc(ps.refs);
        st.insertsym(ps);
        pd:=tprocdef(cnodeutils.create_main_procdef(target_info.cprefix+name,potype,ps));
        { We don't need a local symtable, change it into the static symtable }
        if not (potype in [potype_mainstub,potype_pkgstub,potype_libmainstub]) then
          begin
            pd.localst.free;
            pd.localst:=st;
          end
        else if (potype=potype_pkgstub) and
            (target_info.system in systems_all_windows+systems_nativent) then
          pd.proccalloption:=pocall_stdcall
        else
          pd.proccalloption:=pocall_cdecl;
        handle_calling_convention(pd,hcc_default_actions_impl);
        { set procinfo and current_procinfo.procdef }
        result:=tcgprocinfo(cprocinfo.create(nil));
        result.procdef:=pd;
        { main proc does always a call e.g. to init system unit }
        if potype<>potype_pkgstub then
          include(result.flags,pi_do_call);
      end;


    procedure release_main_proc(curr: tmodule; pi:tcgprocinfo);
      begin
        { remove localst as it was replaced by staticsymtable }
        pi.procdef.localst:=nil;
        { remove procinfo }
        curr.procinfo:=nil;
        pi.free;
        pi:=nil;
      end;



    { Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it }

    procedure maybe_load_got;
{$if defined(i386) or defined (sparcgen)}
       var
         gotvarsym : tstaticvarsym;
{$endif i386 or sparcgen}
      begin
{$if defined(i386) or defined(sparcgen)}
         if (cs_create_pic in current_settings.moduleswitches) and
            (tf_pic_uses_got in target_info.flags) then
           begin
             { insert symbol for got access in assembler code}
             gotvarsym:=cstaticvarsym.create('_GLOBAL_OFFSET_TABLE_',
                          vs_value,voidpointertype,[vo_is_external]);
             gotvarsym.set_mangledname('_GLOBAL_OFFSET_TABLE_');
             curr.localsymtable.insertsym(gotvarsym);
             { avoid unnecessary warnings }
             gotvarsym.varstate:=vs_read;
             gotvarsym.refs:=1;
           end;
{$endif i386 or sparcgen}
      end;

    function gen_implicit_initfinal(curr: tmodule; flag:tmoduleflag;st:TSymtable):tcgprocinfo;
      begin
        { create procdef }
        case flag of
          mf_init :
            begin
              result:=create_main_proc(make_mangledname('',curr.localsymtable,'init_implicit$'),potype_unitinit,st);
              result.procdef.aliasnames.concat(make_mangledname('INIT$',curr.localsymtable,''));
            end;
          mf_finalize :
            begin
              result:=create_main_proc(make_mangledname('',curr.localsymtable,'finalize_implicit$'),potype_unitfinalize,st);
              result.procdef.aliasnames.concat(make_mangledname('FINALIZE$',curr.localsymtable,''));
              if (not curr.is_unit) then
                result.procdef.aliasnames.concat('PASCALFINALIZE');
            end;
          else
            internalerror(200304253);
        end;
        result.code:=cnothingnode.create;
      end;


    procedure copy_macro(p:TObject; arg:pointer);
      begin
        TModule(arg).globalmacrosymtable.insertsym(tmacro(p).getcopy);
      end;

    function try_consume_hintdirective(var moduleopt:tmoduleoptions; var deprecatedmsg:pshortstring):boolean;
      var
        deprecated_seen,
        last_is_deprecated:boolean;
      begin
        try_consume_hintdirective:=false;
        deprecated_seen:=false;
        repeat
          last_is_deprecated:=false;
          case idtoken of
            _LIBRARY :
              begin
                include(moduleopt,mo_hint_library);
                try_consume_hintdirective:=true;
              end;
            _DEPRECATED :
              begin
                { allow deprecated only once }
                if deprecated_seen then
                  break;
                include(moduleopt,mo_hint_deprecated);
                try_consume_hintdirective:=true;
                last_is_deprecated:=true;
                deprecated_seen:=true;
              end;
            _EXPERIMENTAL :
              begin
                include(moduleopt,mo_hint_experimental);
                try_consume_hintdirective:=true;
              end;
            _PLATFORM :
              begin
                include(moduleopt,mo_hint_platform);
                try_consume_hintdirective:=true;
              end;
            _UNIMPLEMENTED :
              begin
                include(moduleopt,mo_hint_unimplemented);
                try_consume_hintdirective:=true;
              end;
            else
              break;
          end;
          consume(Token);
          { handle deprecated message }
          if ((token=_CSTRING) or (token=_CCHAR)) and last_is_deprecated then
            begin
              if deprecatedmsg<>nil then
                internalerror(201001221);
              if token=_CSTRING then
                deprecatedmsg:=stringdup(cstringpattern)
              else
                deprecatedmsg:=stringdup(pattern);
              consume(token);
              include(moduleopt,mo_has_deprecated_msg);
            end;
        until false;
      end;


{$ifdef jvm}
      procedure addmoduleclass;
        var
          def: tobjectdef;
          typesym: ttypesym;
        begin
          { java_jlobject may not have been parsed yet (system unit); in any
            case, we only use this to refer to the class type, so inheritance
            does not matter }
          def:=cobjectdef.create(odt_javaclass,'__FPC_JVM_Module_Class_Alias$',nil,true);
          include(def.objectoptions,oo_is_external);
          include(def.objectoptions,oo_is_sealed);
          def.objextname:=stringdup(curr.realmodulename^);
          typesym:=ctypesym.create('__FPC_JVM_Module_Class_Alias$',def);
          symtablestack.top.insertsym(typesym);
        end;
{$endif jvm}

type
    tfinishstate=record
      init_procinfo:tcgprocinfo;
      finalize_procinfo:tcgprocinfo;
    end;
    pfinishstate=^tfinishstate;


    procedure finish_unit(module:tmodule;immediate:boolean);forward;

    function proc_unit_implementation(curr: tmodule):boolean;

      var
        init_procinfo,
        finalize_procinfo : tcgprocinfo;
        i,j : integer;
        finishstate:pfinishstate;
        globalstate:tglobalstate;

      begin
        result:=true;
        init_procinfo:=nil;
        finalize_procinfo:=nil;
        finishstate:=nil;
        globalstate:=nil;


        { All units are read, now give them a number }
        curr.updatemaps;

        { further, changing the globalsymtable is not allowed anymore }
        curr.globalsymtable.sealed:=true;
        symtablestack.push(curr.localsymtable);

        if not curr.interface_only then
          begin
            Message1(parser_u_parsing_implementation,curr.modulename^);
            if curr.in_interface then
              internalerror(200212285);

            { Compile the unit }
            init_procinfo:=create_main_proc(make_mangledname('',curr.localsymtable,'init$'),potype_unitinit,curr.localsymtable);
            init_procinfo.procdef.aliasnames.concat(make_mangledname('INIT$',curr.localsymtable,''));
            init_procinfo.parse_body;
            { save file pos for debuginfo }
            curr.mainfilepos:=init_procinfo.entrypos;

            { parse finalization section }
            if token=_FINALIZATION then
              begin
                { Compile the finalize }
                finalize_procinfo:=create_main_proc(make_mangledname('',curr.localsymtable,'finalize$'),potype_unitfinalize,curr.localsymtable);
                finalize_procinfo.procdef.aliasnames.concat(make_mangledname('FINALIZE$',curr.localsymtable,''));
                finalize_procinfo.parse_body;
              end
          end;

        { remove all units that we are waiting for that are already waiting for
          us => breaking up circles }
        for i:=0 to curr.waitingunits.count-1 do
          for j:=curr.waitingforunit.count-1 downto 0 do
            if curr.waitingunits[i]=curr.waitingforunit[j] then
              curr.waitingforunit.delete(j);

    {$ifdef DEBUG_UNITWAITING}
        Writeln('Units waiting for ', curr.modulename^, ': ',
          curr.waitingforunit.Count);
    {$endif}
        result:=curr.waitingforunit.count=0;

        { save all information that is needed for finishing the unit }
        New(finishstate);
        finishstate^.init_procinfo:=init_procinfo;
        finishstate^.finalize_procinfo:=finalize_procinfo;
        curr.finishstate:=finishstate;

        if result then
          finish_unit(curr,true)
        else
          begin
            { save the current state, so the parsing can continue where we left
              of here }
            globalstate:=tglobalstate.create(true);
          end;
      end;

    function parse_unit_interface_declarations(curr : tmodule) : boolean;

      begin
        result:=true;
        { create whole program optimisation information (may already be
          updated in the interface, e.g., in case of classrefdef typed
          constants }
        curr.wpoinfo:=tunitwpoinfo.create;

        { ... parse the declarations }
        Message1(parser_u_parsing_interface,curr.realmodulename^);
        symtablestack.push(curr.globalsymtable);
{$ifdef jvm}
         { fake classdef to represent the class corresponding to the unit }
         addmoduleclass;
{$endif}
        read_interface_declarations;

        { Export macros defined in the interface for macpas. The macros
          are put in the globalmacrosymtable that will only be used by other
          units. The current unit continues to use the localmacrosymtable }

        if (m_mac in current_settings.modeswitches) then
          begin
            curr.globalmacrosymtable:=tmacrosymtable.create(true);
            curr.localmacrosymtable.SymList.ForEachCall(@copy_macro,curr);
          end;

        { leave when we got an error }
        if (Errorcount>0) and not status.skip_error then
          begin
            Message1(unit_f_errors_in_unit,tostr(Errorcount));
            status.skip_error:=true;
            symtablestack.pop(curr.globalsymtable);

{$ifdef DEBUG_NODE_XML}
            XMLFinalizeNodeFile('unit');
{$endif DEBUG_NODE_XML}
            exit;
          end;

        { Our interface is compiled, generate CRC and switch to implementation }
        if not(cs_compilesystem in current_settings.moduleswitches) and
          (Errorcount=0) then
           tppumodule(curr).getppucrc;
        curr.in_interface:=false;
        curr.interface_compiled:=true;

        { First reload all units depending on our interface, we need to do this
          in the implementation part to prevent erroneous circular references }
        tppumodule(curr).setdefgeneration;
        tppumodule(curr).reload_flagged_units;

        { Parse the implementation section }
        if (m_mac in current_settings.modeswitches) and try_to_consume(_END) then
          curr.interface_only:=true
        else
          curr.interface_only:=false;

        parse_only:=false;

        { create static symbol table }
        curr.localsymtable:=tstaticsymtable.create(curr.modulename^,curr.moduleid);

        { Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it }
        maybe_load_got;
        if not curr.interface_only then
          begin
            consume(_IMPLEMENTATION);
            Message1(unit_u_loading_implementation_units,curr.modulename^);
            { Read the implementation units }
            if token=_USES then
              begin
                loadunits(curr,curr.globalsymtable,false);
                consume(_SEMICOLON);
              end;
          end;

        if curr.state=ms_compiled then
          begin
            symtablestack.pop(curr.globalsymtable);
            exit(true);
          end;
        result:=proc_unit_implementation(curr);
      end;

    function proc_unit(curr: tmodule):boolean;
      var
         main_file: tinputfile;
         s1,s2  : ^string; {Saves stack space}
         unitname : ansistring;
         unitname8 : string[8];
         consume_semicolon_after_uses:boolean;
         feature : tfeature;

      begin
         result:=true;

         if m_mac in current_settings.modeswitches then
           curr.mode_switch_allowed:= false;

         consume(_UNIT);
         if curr.is_initial then
          Status.IsExe:=false;

         unitname:=orgpattern;
         consume(_ID);
         while token=_POINT do
           begin
             consume(_POINT);
             unitname:=unitname+'.'+orgpattern;
             consume(_ID);
           end;

         { create filenames and unit name }
         main_file := current_scanner.inputfile;
         while assigned(main_file.next) do
           main_file := main_file.next;

         new(s1);
         s1^:=curr.modulename^;
         curr.SetFileName(main_file.path+main_file.name,true);
         curr.SetModuleName(unitname);

{$ifdef DEBUG_NODE_XML}
         XMLInitializeNodeFile('unit', unitname);
{$endif DEBUG_NODE_XML}

         { check for system unit }
         new(s2);
         s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
         unitname8:=copy(curr.modulename^,1,8);
         if (cs_check_unit_name in current_settings.globalswitches) and
            (
             not(
                 (curr.modulename^=s2^) or
                 (
                  (length(curr.modulename^)>8) and
                  (unitname8=s2^)
                 )
                )
             or
             (
              (length(s1^)>8) and
              (s1^<>curr.modulename^)
             )
            ) then
           Message2(unit_e_illegal_unit_name,curr.realmodulename^,s1^);
         if (curr.modulename^='SYSTEM') then
          include(current_settings.moduleswitches,cs_compilesystem);
         dispose(s2);
         dispose(s1);

         if (target_info.system in systems_unit_program_exports) then
           exportlib.preparelib(curr.realmodulename^);

         { parse hint directives }
         try_consume_hintdirective(curr.moduleoptions, curr.deprecatedmsg);

         consume(_SEMICOLON);

         { handle the global switches, do this before interface, because after interface has been
           read, all following directives are parsed as well }
         setupglobalswitches;

         { generate now the global symboltable,
           define first as local to overcome dependency conflicts }
         curr.localsymtable:=tglobalsymtable.create(curr.modulename^,curr.moduleid);

         { insert unitsym of this unit to prevent other units having
           the same name }
         tabstractunitsymtable(curr.localsymtable).insertunit(cunitsym.create(curr.realmodulename^,curr));

         { load default system unit, it must be loaded before interface is parsed
           else we cannot use e.g. feature switches before the next real token }
         loadsystemunit(curr);

         { system unit is loaded, now insert feature defines }
         for feature:=low(tfeature) to high(tfeature) do
           if feature in features then
             def_system_macro('FPC_HAS_FEATURE_'+featurestr[feature]);

         consume(_INTERFACE);

         { global switches are read, so further changes aren't allowed  }
         curr.in_global:=false;

         message1(unit_u_loading_interface_units,curr.modulename^);

         { update status }
         status.currentmodule:=curr.realmodulename^;

         { maybe turn off m_objpas if we are compiling objpas }
         if (curr.modulename^='OBJPAS') then
           exclude(current_settings.modeswitches,m_objpas);

         { maybe turn off m_mac if we are compiling macpas }
         if (curr.modulename^='MACPAS') then
           exclude(current_settings.modeswitches,m_mac);

         parse_only:=true;

         { load default units, like language mode units }
         if not(cs_compilesystem in current_settings.moduleswitches) then
           loaddefaultunits(curr);

         { insert qualifier for the system unit (allows system.writeln) }
         if not(cs_compilesystem in current_settings.moduleswitches) and
            (token=_USES) then
           begin
             // We do this as late as possible.
             if Assigned(curr) then
               curr.Loadlocalnamespacelist
             else
               current_namespacelist:=Nil;
             loadunits(curr, nil,true);
             { has it been compiled at a higher level ?}
             if curr.state=ms_compiled then
               begin
                 Message1(parser_u_already_compiled,curr.realmodulename^);
                 exit;
               end;

             consume_semicolon_after_uses:=true;
           end
         else
           consume_semicolon_after_uses:=false;

         { move the global symtable from the temporary local to global }
         curr.globalsymtable:=curr.localsymtable;
         curr.localsymtable:=nil;

         { number all units, so we know if a unit is used by this unit or
           needs to be added implicitly }
         curr.updatemaps;

         { consume the semicolon after maps have been updated else conditional compiling expressions
           might cause internal errors, see tw8611 }

         if consume_semicolon_after_uses then
           consume(_SEMICOLON);

         result:=parse_unit_interface_declarations(curr);

      end;

    procedure finish_unit(module:tmodule;immediate:boolean);

      function is_assembler_generated:boolean;
      var
        hal : tasmlisttype;
      begin
        result:=false;
        if Errorcount=0 then
          begin
            for hal:=low(TasmlistType) to high(TasmlistType) do
              if not current_asmdata.asmlists[hal].empty then
                begin
                  result:=true;
                  exit;
                end;
          end;
      end;

      procedure module_is_done(curr: tmodule);inline;
        begin

          FreeAndNil(curr.globalstate);
          dispose(pfinishstate(curr.finishstate));
          curr.finishstate:=nil;
        end;

      var
{$ifdef EXTDEBUG}
        store_crc,
{$endif EXTDEBUG}
        store_interface_crc,
        store_indirect_crc: cardinal;
        force_init_final : boolean;
        init_procinfo,
        finalize_procinfo : tcgprocinfo;
        i : longint;
        ag : boolean;
        finishstate : tfinishstate;
        globalstate : tglobalstate;
        waitingmodule : tmodule;
      begin
          globalstate:=default(tglobalstate);
         if not immediate then
           begin
{$ifdef DEBUG_UNITWAITING}
             writeln('finishing waiting unit ''', module.modulename^, '''');
{$endif DEBUG_UNITWAITING}
             { restore the state when we stopped working on the unit }
             save_global_state(globalstate,true);
             if not assigned(module.globalstate) then
               internalerror(2012091802);
             tglobalstate(module.globalstate).restore(true);
           end;

         { curr is now module }

         if not assigned(module.finishstate) then
           internalerror(2012091801);
         finishstate:=pfinishstate(module.finishstate)^;

         finalize_procinfo:=finishstate.finalize_procinfo;
         init_procinfo:=finishstate.init_procinfo;

         { Generate specializations of objectdefs methods }
         generate_specialization_procs;

         // This needs to be done before we generate the VMTs
         if (target_cpu=tsystemcpu.cpu_wasm32) then
           begin
           add_synthetic_interface_classes_for_st(module.globalsymtable);
           add_synthetic_interface_classes_for_st(module.localsymtable);
           end;

         { generate construction functions for all attributes in the unit:
           this must be done before writing the VMTs because
           during VMT writing  the extended field info is written }

         generate_attr_constrs(current_module.used_rtti_attrs);

         { Generate VMTs }
         if Errorcount=0 then
           begin
             write_vmts(module.globalsymtable,true);
             write_vmts(module.localsymtable,false);
           end;

         { add implementations for synthetic method declarations added by
           the compiler }
         add_synthetic_method_implementations(module.globalsymtable);
         add_synthetic_method_implementations(module.localsymtable);

         { if the unit contains ansi/widestrings, initialization and
           finalization code must be forced }
         force_init_final:=tglobalsymtable(module.globalsymtable).needs_init_final or
                           tstaticsymtable(module.localsymtable).needs_init_final;

         { should we force unit initialization? }
         { this is a hack, but how can it be done better ? }
         { Now the sole purpose of this is to change 'init' to 'init_implicit',
           is it needed at all? (Sergei) }
         { it's needed in case cnodeutils.force_init = true }
         if (force_init_final or cnodeutils.force_init) and
            (
              not assigned(init_procinfo) or
              has_no_code(init_procinfo.code)
            ) then
           begin
             { first release the not used init procinfo }
             if assigned(init_procinfo) then
               begin
                 release_proc_symbol(init_procinfo.procdef);
                 release_main_proc(module,init_procinfo);
               end;
             init_procinfo:=gen_implicit_initfinal(module,mf_init,module.localsymtable);
           end;
         if (force_init_final or cnodeutils.force_final) and
            (
              not assigned(finalize_procinfo) or
              has_no_code(finalize_procinfo.code)
            ) then
           begin
             { first release the not used finalize procinfo }
             if assigned(finalize_procinfo) then
               begin
                 release_proc_symbol(finalize_procinfo.procdef);
                 release_main_proc(module,finalize_procinfo);
               end;
             finalize_procinfo:=gen_implicit_initfinal(module,mf_finalize,module.localsymtable);
           end;

         { Now both init and finalize bodies are read and it is known
           which variables are used in both init and finalize we can now
           generate the code. This is required to prevent putting a variable in
           a register that is also used in the finalize body (PFV) }
         if assigned(init_procinfo) then
           begin
             if (force_init_final or cnodeutils.force_init) or
                not(has_no_code(init_procinfo.code)) then
               begin
                 init_procinfo.code:=cnodeutils.wrap_proc_body(init_procinfo.procdef,init_procinfo.code);
                 init_procinfo.generate_code_tree;
                 include(module.moduleflags,mf_init);
               end
             else
               release_proc_symbol(init_procinfo.procdef);
             init_procinfo.resetprocdef;
             release_main_proc(module,init_procinfo);
           end;
         if assigned(finalize_procinfo) then
           begin
             if force_init_final or
                cnodeutils.force_init or
                not(has_no_code(finalize_procinfo.code)) then
               begin
                 finalize_procinfo.code:=cnodeutils.wrap_proc_body(finalize_procinfo.procdef,finalize_procinfo.code);
                 finalize_procinfo.generate_code_tree;
                 include(module.moduleflags,mf_finalize);
               end
             else
               release_proc_symbol(finalize_procinfo.procdef);
             finalize_procinfo.resetprocdef;
             release_main_proc(module,finalize_procinfo);
           end;

         symtablestack.pop(module.localsymtable);
         symtablestack.pop(module.globalsymtable);

         { the last char should always be a point }
         consume(_POINT);

         { reset wpo flags for all defs }
         reset_all_defs(module);

         if (Errorcount=0) then
           begin
             { tests, if all (interface) forwards are resolved }
             tstoredsymtable(module.globalsymtable).check_forwards;
             { check if all private fields are used }
             tstoredsymtable(module.globalsymtable).allprivatesused;

             { test static symtable }
             tstoredsymtable(module.localsymtable).allsymbolsused;
             tstoredsymtable(module.localsymtable).allprivatesused;
             tstoredsymtable(module.localsymtable).check_forwards;
             tstoredsymtable(module.localsymtable).checklabels;

             { used units }
             module.allunitsused;
           end;

         { leave when we got an error }
         if (Errorcount>0) and not status.skip_error then
          begin
            Message1(unit_f_errors_in_unit,tostr(Errorcount));
            status.skip_error:=true;
            module_is_done(module);
            if not immediate then
              restore_global_state(globalstate,true);

{$ifdef DEBUG_NODE_XML}
            XMLFinalizeNodeFile('unit');
{$endif DEBUG_NODE_XML}
            exit;
          end;

         { if an Objective-C module, generate rtti and module info }
         MaybeGenerateObjectiveCImageInfo(module.globalsymtable,module.localsymtable);

         { do we need to add the variants unit? }
         maybeloadvariantsunit(module);

         { generate rtti/init tables }
         write_persistent_type_info(module.globalsymtable,true);
         write_persistent_type_info(module.localsymtable,false);

         { Tables }
         cnodeutils.InsertThreadvars;

         { Resource strings }
         GenerateResourceStrings;

         { Widestring typed constants }
         cnodeutils.InsertWideInits;

         { Resourcestring references }
         cnodeutils.InsertResStrInits;

         { generate debuginfo }
         if (cs_debuginfo in current_settings.moduleswitches) then
           current_debuginfo.inserttypeinfo;

         { generate imports }
         if module.ImportLibraryList.Count>0 then
           importlib.generatelib;

         { insert own objectfile, or say that it's in a library
           (no check for an .o when loading) }
         ag:=is_assembler_generated;
         if ag then
           insertobjectfile(module)
         else
           begin
             module.headerflags:=module.headerflags or uf_no_link;
             exclude(module.moduleflags,mf_has_stabs_debuginfo);
             exclude(module.moduleflags,mf_has_dwarf_debuginfo);
           end;

         if ag then
          begin
            { create callframe info }
            create_dwarf_frame;
            { assemble }
            create_objectfile(module);
          end;

         { Write out the ppufile after the object file has been created }
         store_interface_crc:=module.interface_crc;
         store_indirect_crc:=module.indirect_crc;
{$ifdef EXTDEBUG}
         store_crc:=curr.crc;
{$endif EXTDEBUG}
         if (Errorcount=0) then
           tppumodule(module).writeppu;

         if not(cs_compilesystem in current_settings.moduleswitches) then
           begin
             if store_interface_crc<>module.interface_crc then
               Message1(unit_u_interface_crc_changed,module.ppufilename);
             if store_indirect_crc<>module.indirect_crc then
               Message1(unit_u_indirect_crc_changed,module.ppufilename);
           end;
{$ifdef EXTDEBUG}
         if not(cs_compilesystem in current_settings.moduleswitches) then
           if (store_crc<>curr.crc) then
             Message1(unit_u_implementation_crc_changed,curr.ppufilename);
{$endif EXTDEBUG}

         { release unregistered defs/syms from the localsymtable }
         free_unregistered_localsymtable_elements(module);
         { release local symtables that are not needed anymore }
         free_localsymtables(module.globalsymtable);
         free_localsymtables(module.localsymtable);

         { leave when we got an error }
         if (Errorcount>0) and not status.skip_error then
          begin
            Message1(unit_f_errors_in_unit,tostr(Errorcount));
            status.skip_error:=true;
            module_is_done(module);
            if not immediate then
              restore_global_state(globalstate,true);

{$ifdef DEBUG_NODE_XML}
            XMLFinalizeNodeFile('unit');
{$endif DEBUG_NODE_XML}
            exit;
          end;

{$ifdef debug_devirt}
         { print out all instantiated class/object types }
         writeln('constructed object/class/classreftypes in ',curr.realmodulename^);
         for i := 0 to curr.wpoinfo.createdobjtypes.count-1 do
           begin
             write('  ',tdef(curr.wpoinfo.createdobjtypes[i]).GetTypeName);
             case tdef(curr.wpoinfo.createdobjtypes[i]).typ of
               objectdef:
                 case tobjectdef(curr.wpoinfo.createdobjtypes[i]).objecttype of
                   odt_object:
                     writeln(' (object)');
                   odt_class:
                     writeln(' (class)');
                   else
                     internalerror(2008101103);
                 end;
               else
                 internalerror(2008101104);
             end;
           end;

         for i := 0 to curr.wpoinfo.createdclassrefobjtypes.count-1 do
           begin
             write('  Class Of ',tdef(curr.wpoinfo.createdclassrefobjtypes[i]).GetTypeName);
             case tdef(curr.wpoinfo.createdclassrefobjtypes[i]).typ of
               objectdef:
                 case tobjectdef(curr.wpoinfo.createdclassrefobjtypes[i]).objecttype of
                   odt_class:
                     writeln(' (classrefdef)');
                   else
                     internalerror(2008101105);
                 end
               else
                 internalerror(2008101102);
             end;
           end;
{$endif debug_devirt}

        Message1(unit_u_finished_compiling,module.modulename^);

        module_is_done(module);
        module.end_of_parsing;

        if not immediate then
          restore_global_state(globalstate,true);

        for i:=0 to module.waitingunits.count-1 do
          begin
            waitingmodule:=tmodule(module.waitingunits[i]);
            waitingmodule.waitingforunit.remove(module);
            { only finish the module if it isn't already finished }
            if (waitingmodule.waitingforunit.count=0) and
                assigned(waitingmodule.finishstate) then
              begin
                finish_unit(waitingmodule,false);
                waitingmodule.end_of_parsing;
              end;
          end;
{$ifdef DEBUG_NODE_XML}
        XMLFinalizeNodeFile('unit');
{$endif DEBUG_NODE_XML}
      end;


    procedure proc_package(curr: tmodule);
      var
        main_file : tinputfile;
        hp,hp2    : tmodule;
        pkg : tpcppackage;
        main_procinfo : tcgprocinfo;
        force_init_final : boolean;
        uu : tused_unit;
        module_name: ansistring;
        pentry: ppackageentry;
        feature : tfeature;
      begin
         Status.IsPackage:=true;
         Status.IsExe:=true;
         parse_only:=false;
         main_procinfo:=nil;
         {init_procinfo:=nil;
         finalize_procinfo:=nil;}

         if not (tf_supports_packages in target_info.flags) then
           message1(parser_e_packages_not_supported,target_info.name);

         if not RelocSectionSetExplicitly then
           RelocSection:=true;

         { Relocation works only without stabs under Windows when }
         { external linker (LD) is used.  LD generates relocs for }
         { stab sections which is not loaded in memory. It causes }
         { AV error when DLL is loaded and relocation is needed.  }
         { Internal linker does not have this problem.            }
         if RelocSection and
            (target_info.system in systems_all_windows+[system_i386_wdosx]) and
            (cs_link_extern in current_settings.globalswitches) then
           begin
              include(current_settings.globalswitches,cs_link_strip);
              { Warning stabs info does not work with reloc section !! }
              if (cs_debuginfo in current_settings.moduleswitches) and
                 (target_dbg.id=dbg_stabs) then
                begin
                  Message1(parser_w_parser_reloc_no_debug,curr.mainsource);
                  Message(parser_w_parser_win32_debug_needs_WN);
                  exclude(current_settings.moduleswitches,cs_debuginfo);
                end;
           end;
         { get correct output names }
         main_file := current_scanner.inputfile;
         while assigned(main_file.next) do
           main_file := main_file.next;

         curr.SetFileName(main_file.path+main_file.name,true);

         { consume _PACKAGE word }
         consume(_ID);

         module_name:=orgpattern;
         consume(_ID);
         while token=_POINT do
           begin
             consume(_POINT);
             module_name:=module_name+'.'+orgpattern;
             consume(_ID);
           end;

         curr.setmodulename(module_name);
         curr.ispackage:=true;
         exportlib.preparelib(module_name);
         pkg:=tpcppackage.create(module_name);

         if tf_library_needs_pic in target_info.flags then
           include(current_settings.moduleswitches,cs_create_pic);

         { setup things using the switches, do this before the semicolon, because after the semicolon has been
           read, all following directives are parsed as well }

         setupglobalswitches;

{$ifdef DEBUG_NODE_XML}
         XMLInitializeNodeFile('package', module_name);
{$endif DEBUG_NODE_XML}

         consume(_SEMICOLON);

         { global switches are read, so further changes aren't allowed }
         curr.in_global:=false;

         { set implementation flag }
         curr.in_interface:=false;
         curr.interface_compiled:=true;

         { insert after the unit symbol tables the static symbol table }
         { of the program                                             }
         curr.localsymtable:=tstaticsymtable.create(curr.modulename^,curr.moduleid);

         { ensure that no packages are picked up from the options }
         packagelist.clear;

         // There should always be a requires, except for the system package. So we load here
         if Assigned(curr) then
           curr.Loadlocalnamespacelist
         else
           current_namespacelist:=Nil;

         {Read the packages used by the package we compile.}
         if (token=_ID) and (idtoken=_REQUIRES) then
           begin
             { consume _REQUIRES word }
             consume(_ID);
             while true do
               begin
                 if token=_ID then
                   begin
                     module_name:=orgpattern;
                     consume(_ID);
                     while token=_POINT do
                       begin
                         consume(_POINT);
                         module_name:=module_name+'.'+orgpattern;
                         consume(_ID);
                       end;
                     add_package(module_name,false,true);
                   end
                 else
                   consume(_ID);
                 if token=_COMMA then
                   consume(_COMMA)
                 else
                   break;
               end;
             consume(_SEMICOLON);
           end;

         { now load all packages, so that we can determine whether a unit is
           already provided by one of the loaded packages }
         load_packages;

         if packagelist.Count>0 then
           begin
             { this means the SYSTEM unit *must* be part of one of the required
               packages, so load it }
             AddUnit(curr,'system',false);
             systemunit:=tglobalsymtable(symtablestack.top);
             load_intern_types;
             { system unit is loaded, now insert feature defines }
             for feature:=low(tfeature) to high(tfeature) do
               if feature in features then
                 def_system_macro('FPC_HAS_FEATURE_'+featurestr[feature]);
           end;

         {Load the units used by the program we compile.}
         if (token=_ID) and (idtoken=_CONTAINS) then
           begin
             { consume _CONTAINS word }
             consume(_ID);
             while true do
               begin
                 if token=_ID then
                   begin
                     module_name:=orgpattern;
                     consume(_ID);
                     while token=_POINT do
                       begin
                         consume(_POINT);
                         module_name:=module_name+'.'+orgpattern;
                         consume(_ID);
                       end;
                     hp:=AddUnit(curr,module_name);
                     if (hp.modulename^='SYSTEM') and not assigned(systemunit) then
                       begin
                         systemunit:=tglobalsymtable(hp.globalsymtable);
                         load_intern_types;
                       end;
                   end
                 else
                   consume(_ID);
                 if token=_COMMA then
                   consume(_COMMA)
                 else break;
               end;
             consume(_SEMICOLON);
           end;

         { All units are read, now give them a number }
         curr.updatemaps;

         hp:=tmodule(loaded_units.first);
         while assigned(hp) do
           begin
             if (hp<>curr) and not assigned(hp.package) then
               begin
                 if mf_package_deny in hp.moduleflags then
                   message1(package_e_unit_deny_package,hp.realmodulename^);
                 { part of the package's used, aka contained units? }
                 uu:=tused_unit(curr.used_units.first);
                 while assigned(uu) do
                   begin
                     if uu.u=hp then
                       break;
                     uu:=tused_unit(uu.next);
                   end;
                 if not assigned(uu) then
                   message2(package_n_implicit_unit_import,hp.realmodulename^,curr.realmodulename^);
               end;
             { was this unit listed as a contained unit? If so => error }
             if (hp<>curr) and assigned(hp.package) then
               begin
                 uu:=tused_unit(curr.used_units.first);
                 while assigned(uu) do
                   begin
                     if uu.u=hp then
                       break;
                     uu:=tused_unit(uu.next);
                   end;
                 if assigned(uu) then
                   message2(package_e_unit_already_contained_in_package,hp.realmodulename^,hp.package.realpackagename^);
               end;
             hp:=tmodule(hp.next);
           end;

         {Insert the name of the main program into the symbol table.}
         if curr.realmodulename^<>'' then
           tabstractunitsymtable(curr.localsymtable).insertunit(cunitsym.create(curr.realmodulename^,curr));

         Message1(parser_u_parsing_implementation,curr.mainsource);

         symtablestack.push(curr.localsymtable);

         { create whole program optimisation information }
         curr.wpoinfo:=tunitwpoinfo.create;

         { should we force unit initialization? }
         force_init_final:=tstaticsymtable(curr.localsymtable).needs_init_final;
         if force_init_final or cnodeutils.force_init then
           {init_procinfo:=gen_implicit_initfinal(mf_init,curr.localsymtable)};

         { Add symbol to the exports section for win32 so smartlinking a
           DLL will include the edata section }
         if assigned(exportlib) and
            (target_info.system in [system_i386_win32,system_i386_wdosx]) and
            (mf_has_exports in curr.moduleflags) then
           current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',curr.localsymtable,''),0));

         { all labels must be defined before generating code }
         if Errorcount=0 then
           tstoredsymtable(curr.localsymtable).checklabels;

         symtablestack.pop(curr.localsymtable);

         { consume the last point }
         consume(_END);
         consume(_POINT);

         if (Errorcount=0) then
           begin
             { test static symtable }
             tstoredsymtable(curr.localsymtable).allsymbolsused;
             tstoredsymtable(curr.localsymtable).allprivatesused;
             tstoredsymtable(curr.localsymtable).check_forwards;

             { Note: all contained units are considered as used }
           end;

         if target_info.system in systems_all_windows+systems_nativent then
           begin
             main_procinfo:=create_main_proc('_PkgEntryPoint',potype_pkgstub,curr.localsymtable);
             main_procinfo.procdef.aliasnames.concat('_DLLMainCRTStartup');
             main_procinfo.code:=generate_pkg_stub(main_procinfo.procdef);
             main_procinfo.generate_code;
           end;

{$ifdef DEBUG_NODE_XML}
         XMLFinalizeNodeFile('package');
{$endif DEBUG_NODE_XML}

         { leave when we got an error }
         if (Errorcount>0) and not status.skip_error then
           begin
             Message1(unit_f_errors_in_unit,tostr(Errorcount));
             status.skip_error:=true;
             pkg.free;
             exit;
           end;

         { remove all unused units, this happends when units are removed
           from the uses clause in the source and the ppu was already being loaded }
         hp:=tmodule(loaded_units.first);
         while assigned(hp) do
          begin
            hp2:=hp;
            hp:=tmodule(hp.next);
            if assigned(hp2.package) then
              add_package_unit_ref(hp2.package);
            if hp2.is_unit and
               not assigned(hp2.globalsymtable) then
              loaded_units.remove(hp2);
          end;

         exportlib.ignoreduplicates:=true;

         { force exports }
         uu:=tused_unit(usedunits.first);
         while assigned(uu) do
           begin
             if not assigned(systemunit) and (uu.u.modulename^='SYSTEM') then
               begin
                 systemunit:=tglobalsymtable(uu.u.globalsymtable);
                 load_intern_types;
               end;
             if not assigned(uu.u.package) then
               export_unit(uu.u);

             uu:=tused_unit(uu.next);
           end;

{$ifdef arm}
         { Insert .pdata section for arm-wince.
           It is needed for exception handling. }
         if target_info.system in [system_arm_wince] then
           InsertPData;
{$endif arm}

         { generate debuginfo }
         if (cs_debuginfo in current_settings.moduleswitches) then
           current_debuginfo.inserttypeinfo;

         exportlib.generatelib;

         exportlib.ignoreduplicates:=false;

         { create import libraries for all packages }
         if packagelist.count>0 then
           createimportlibfromexternals;

         { generate imports }
         if curr.ImportLibraryList.Count>0 then
           importlib.generatelib;

         { Reference all DEBUGINFO sections from the main .fpc section }
         if (cs_debuginfo in current_settings.moduleswitches) then
           current_debuginfo.referencesections(current_asmdata.asmlists[al_procedures]);

         { insert own objectfile }
         insertobjectfile(curr);

         { assemble and link }
         create_objectfile(curr);

         { We might need the symbols info if not using
           the default do_extractsymbolinfo
           which is a dummy function PM }
         needsymbolinfo:=do_extractsymbolinfo<>@def_extractsymbolinfo;
         { release all local symtables that are not needed anymore }
         if (not needsymbolinfo) then
           free_localsymtables(curr.localsymtable);

         { leave when we got an error }
         if (Errorcount>0) and not status.skip_error then
          begin
            Message1(unit_f_errors_in_unit,tostr(Errorcount));
            status.skip_error:=true;
            pkg.free;
            exit;
          end;

         if (not curr.is_unit) then
           begin
             { we add all loaded units that are not part of a package to the
               package; this includes units in the "contains" section as well
               as implicitely imported ones }
             hp:=tmodule(loaded_units.first);
             while assigned(hp) do
              begin
                if (hp<>curr) then
                  begin
                    if not assigned(hp.package) then
                      begin
                        pkg.addunit(hp);
                        check_for_indirect_package_usages(hp.used_units);
                      end
                    else
                      begin
                        pentry:=ppackageentry(packagelist.find(hp.package.packagename^));
                        if not assigned(pentry) then
                          internalerror(2015112301);
                        pkg.add_required_package(hp.package);
                      end;
                  end;
                hp:=tmodule(hp.next);
              end;

             pkg.initmoduleinfo(curr);

             { create the executable when we are at level 1 }
             if (curr.is_initial) then
               begin
                 { create global resource file by collecting all resource files }
                 CollectResourceFiles;
                 { write .def file }
                 if (cs_link_deffile in current_settings.globalswitches) then
                   deffile.writefile;

                 { generate the pcp file }
                 pkg.savepcp;

                 { insert all .o files from all loaded units and
                   unload the units, we don't need them anymore.
                   Keep the curr because that is still needed }
                 hp:=tmodule(loaded_units.first);
                 while assigned(hp) do
                  begin
                    { only link in those units which should become part of this
                      package }
                    if not assigned(hp.package) then
                      linker.AddModuleFiles(hp);
                    hp2:=tmodule(hp.next);
                    if (hp<>curr) and
                       (not needsymbolinfo) then
                      begin
                        loaded_units.remove(hp);
                        hp.free;
                      end;
                    hp:=hp2;
                  end;
                 { add the library of directly used packages }
                 add_package_libs(linker);
                 { and now link the package library }
                 linker.MakeSharedLibrary
               end;

             { Give Fatal with error count for linker errors }
             if (Errorcount>0) and not status.skip_error then
              begin
                Message1(unit_f_errors_in_unit,tostr(Errorcount));
                status.skip_error:=true;
              end;

             pkg.free;
          end;
      end;

    procedure proc_create_executable(curr, sysinitmod: tmodule; islibrary : boolean);

      var
        program_uses_checkpointer : boolean;
        hp,hp2 : tmodule;

      begin
            { create global resource file by collecting all resource files }
            CollectResourceFiles;
            { write .def file }
            if (cs_link_deffile in current_settings.globalswitches) then
             deffile.writefile;
            { link SysInit (if any) first, to have behavior consistent with
              assembler startup files }
            if assigned(sysinitmod) then
              linker.AddModuleFiles(sysinitmod);
            { Does any unit use checkpointer function }
            program_uses_checkpointer:=false;
            { insert all .o files from all loaded units and
              unload the units, we don't need them anymore.
              Keep the curr because that is still needed }
            hp:=tmodule(loaded_units.first);
            while assigned(hp) do
             begin
               if (hp<>sysinitmod) and not assigned(hp.package) then
                 begin
                   linker.AddModuleFiles(hp);
                   if mf_checkpointer_called in hp.moduleflags then
                     program_uses_checkpointer:=true;
                 end;
               hp2:=tmodule(hp.next);
               if assigned(hp.package) then
                 add_package_unit_ref(hp.package);
               if (hp<>curr) and
                  (not needsymbolinfo) then
                 begin
                   loaded_units.remove(hp);
                   hp.free;
                 end;
               hp:=hp2;
             end;
            { free also unneeded units we didn't free before }
            if not needsymbolinfo then
              unloaded_units.Clear;
            { Does any unit use checkpointer function }
            if program_uses_checkpointer then
              Message1(link_w_program_uses_checkpointer,curr.modulename^);

            { add all directly used packages as libraries }
            add_package_libs(linker);
            { finally we can create an executable }
            if curr.islibrary then
              linker.MakeSharedLibrary
            else
              linker.MakeExecutable;

            { collect all necessary information for whole-program optimization }
            wpoinfomanager.extractwpoinfofromprogram;

      end;

    procedure proc_program_after_parsing(curr : tmodule; islibrary : boolean);

      var
        sysinitmod, hp,hp2 : tmodule;
        resources_used : boolean;


      begin
        sysinitmod:=nil;
        hp:=nil;
        hp2:=nil;
        resources_used:=false;

  {$ifdef DEBUG_NODE_XML}
        if IsLibrary then
          XMLFinalizeNodeFile('library')
        else
          XMLFinalizeNodeFile('program');
  {$endif DEBUG_NODE_XML}

        { reset wpo flags for all defs }
        reset_all_defs(curr);

        if (Errorcount=0) then
          begin
            { test static symtable }
            tstoredsymtable(curr.localsymtable).allsymbolsused;
            tstoredsymtable(curr.localsymtable).allprivatesused;
            tstoredsymtable(curr.localsymtable).check_forwards;

            curr.allunitsused;
          end;

        { leave when we got an error }
        if (Errorcount>0) and not status.skip_error then
          begin
            Message1(unit_f_errors_in_unit,tostr(Errorcount));
            status.skip_error:=true;
            exit;
          end;

        { remove all unused units, this happens when units are removed
          from the uses clause in the source and the ppu was already being loaded }
        hp:=tmodule(loaded_units.first);
        while assigned(hp) do
         begin
           hp2:=hp;
           hp:=tmodule(hp.next);
           if hp2.is_unit and
              not assigned(hp2.globalsymtable) then
               begin
                 loaded_units.remove(hp2);
                 unloaded_units.concat(hp2);
               end;
         end;

        { do we need to add the variants unit? }
        maybeloadvariantsunit(curr);

        { Now that everything has been compiled we know if we need resource
          support. If not, remove the unit. }
        resources_used:=MaybeRemoveResUnit(curr);

        linker.initsysinitunitname;
        if target_info.system in systems_internal_sysinit then
        begin
          { add start/halt unit }
          sysinitmod:=AddUnit(curr,linker.sysinitunit);
        end
        else
          sysinitmod:=nil;

  {$ifdef arm}
        { Insert .pdata section for arm-wince.
          It is needed for exception handling. }
        if target_info.system in [system_arm_wince] then
          InsertPData;
  {$endif arm}

        cnodeutils.InsertThreadvars;

        { generate rtti/init tables }
        write_persistent_type_info(curr.localsymtable,false);

        { if an Objective-C module, generate rtti and module info }
        MaybeGenerateObjectiveCImageInfo(nil,curr.localsymtable);

        { generate debuginfo }
        if (cs_debuginfo in current_settings.moduleswitches) then
          current_debuginfo.inserttypeinfo;

        if islibrary or (target_info.system in systems_unit_program_exports) then
          exportlib.generatelib;

        { Reference all DEBUGINFO sections from the main .fpc section }
        if (cs_debuginfo in current_settings.moduleswitches) then
          current_debuginfo.referencesections(current_asmdata.asmlists[al_procedures]);

        { Resource strings }
        GenerateResourceStrings;

        { Windows widestring needing initialization }
        cnodeutils.InsertWideInits;

        { Resourcestring references (const foo:string=someresourcestring) }
        cnodeutils.InsertResStrInits;

        { insert Tables and StackLength }
        cnodeutils.InsertInitFinalTable;
        cnodeutils.InsertThreadvarTablesTable;
        cnodeutils.InsertResourceTablesTable;
        cnodeutils.InsertWideInitsTablesTable;
        cnodeutils.InsertResStrTablesTable;
        cnodeutils.InsertMemorySizes;

        { Insert symbol to resource info }
        cnodeutils.InsertResourceInfo(resources_used);

        { create callframe info }
        create_dwarf_frame;

        { create import library for all packages }
        if packagelist.count>0 then
          createimportlibfromexternals;

        { generate imports }
        if curr.ImportLibraryList.Count>0 then
          importlib.generatelib;

        { insert own objectfile }
        insertobjectfile(curr);

        { assemble and link }
        create_objectfile(curr);

        { We might need the symbols info if not using
          the default do_extractsymbolinfo
          which is a dummy function PM }
        needsymbolinfo:=
          (do_extractsymbolinfo<>@def_extractsymbolinfo) or
          ((current_settings.genwpoptimizerswitches*WPOptimizationsNeedingAllUnitInfo)<>[]);

        { release all local symtables that are not needed anymore }
        if (not needsymbolinfo) then
          free_localsymtables(curr.localsymtable);

        { leave when we got an error }
        if (Errorcount>0) and not status.skip_error then
          begin
            Message1(unit_f_errors_in_unit,tostr(Errorcount));
            status.skip_error:=true;
            exit;
          end;
        { create the executable when we are at level 1 }

        if (not curr.is_unit) and (curr.is_initial) then
          proc_create_executable(curr,sysinitmod,islibrary);

        { Give Fatal with error count for linker errors }
        if (Errorcount>0) and not status.skip_error then
         begin
           Message1(unit_f_errors_in_unit,tostr(Errorcount));
           status.skip_error:=true;
         end;
      end;

    procedure proc_program_declarations(curr : tmodule; islibrary : boolean);

      var
        initpd    : tprocdef;
        finalize_procinfo,
        init_procinfo,
        main_procinfo : tcgprocinfo;
        force_init_final : boolean;

      begin
        main_procinfo:=nil;
        init_procinfo:=nil;
        finalize_procinfo:=nil;

        {Insert the name of the main program into the symbol table.}
        if curr.realmodulename^<>'' then
          tabstractunitsymtable(curr.localsymtable).insertunit(cunitsym.create(curr.realmodulename^,curr));

        Message1(parser_u_parsing_implementation,curr.mainsource);

        symtablestack.push(curr.localsymtable);

  {$ifdef jvm}
        { fake classdef to represent the class corresponding to the unit }
        addmoduleclass;
  {$endif}

        { Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it }
        maybe_load_got;

        { create whole program optimisation information }
        curr.wpoinfo:=tunitwpoinfo.create;

        { The program intialization needs an alias, so it can be called
          from the bootstrap code.}
        if islibrary then
         begin
           initpd:=nil;
           { ToDo: other systems that use indirect entry info, but check back with Windows! }
           { we need to call FPC_LIBMAIN in sysinit which in turn will call PascalMain -> create dummy stub }
           if target_info.system in systems_darwin then
             begin
               main_procinfo:=create_main_proc(make_mangledname('sysinitcallthrough',curr.localsymtable,'stub'),potype_libmainstub,curr.localsymtable);
               call_through_new_name(main_procinfo.procdef,target_info.cprefix+'FPC_LIBMAIN');
               initpd:=main_procinfo.procdef;
               main_procinfo.free;
             end;

           main_procinfo:=create_main_proc(make_mangledname('',curr.localsymtable,mainaliasname),potype_proginit,curr.localsymtable);
           { Win32 startup code needs a single name }
           if not(target_info.system in (systems_darwin+systems_aix)) then
             main_procinfo.procdef.aliasnames.concat('PASCALMAIN')
           else
             main_procinfo.procdef.aliasnames.concat(target_info.Cprefix+'PASCALMAIN');

           if not(target_info.system in systems_darwin) then
             initpd:=main_procinfo.procdef;

           cnodeutils.RegisterModuleInitFunction(initpd);
         end
        else if (target_info.system in ([system_i386_netware,system_i386_netwlibc,system_powerpc_macosclassic]+systems_darwin+systems_aix)) then
          begin
            { create a stub with the name of the desired main routine, with
              the same signature as the C "main" function, and call through to
              FPC_SYSTEMMAIN, which will initialise everything based on its
              parameters. This function cannot be in the system unit, because
              its name can be configured on the command line (for use with e.g.
              SDL, where the main function should be called SDL_main) }
            main_procinfo:=create_main_proc(mainaliasname,potype_mainstub,curr.localsymtable);
            call_through_new_name(main_procinfo.procdef,target_info.cprefix+'FPC_SYSTEMMAIN');
            main_procinfo.free;
            { now create the PASCALMAIN routine (which will be called from
              FPC_SYSTEMMAIN) }
            main_procinfo:=create_main_proc('PASCALMAIN',potype_proginit,curr.localsymtable);
          end
        else
          begin
            main_procinfo:=create_main_proc(mainaliasname,potype_proginit,curr.localsymtable);
            main_procinfo.procdef.aliasnames.concat('PASCALMAIN');
          end;
        main_procinfo.parse_body;
        { save file pos for debuginfo }
        curr.mainfilepos:=main_procinfo.entrypos;

        { finalize? }
        if token=_FINALIZATION then
          begin
             { Parse the finalize }
             finalize_procinfo:=create_main_proc(make_mangledname('',curr.localsymtable,'finalize$'),potype_unitfinalize,curr.localsymtable);
             finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',curr.localsymtable,''));
             finalize_procinfo.procdef.aliasnames.concat('PASCALFINALIZE');
             finalize_procinfo.parse_body;
          end;

        { Generate specializations of objectdefs methods }
        if Errorcount=0 then
          generate_specialization_procs;

        { This needs to be done before we generate the VMTs }
        if (target_cpu=tsystemcpu.cpu_wasm32) then
          add_synthetic_interface_classes_for_st(curr.localsymtable);

        { Generate VMTs }
        if Errorcount=0 then
          write_vmts(curr.localsymtable,false);

        { add implementations for synthetic method declarations added by
          the compiler }
        add_synthetic_method_implementations(curr.localsymtable);

        { generate construction functions for all attributes in the program }
        generate_attr_constrs(curr.used_rtti_attrs);

        { should we force unit initialization? }
        force_init_final:=tstaticsymtable(curr.localsymtable).needs_init_final;
        if force_init_final or cnodeutils.force_init then
          init_procinfo:=gen_implicit_initfinal(curr,mf_init,curr.localsymtable);

        { Add symbol to the exports section for win32 so smartlinking a
          DLL will include the edata section }
        if assigned(exportlib) and
           (target_info.system in [system_i386_win32,system_i386_wdosx]) and
           (mf_has_exports in curr.moduleflags) then
          current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',curr.localsymtable,''),0));

        if (force_init_final or cnodeutils.force_final) and
           (
             not assigned(finalize_procinfo)
             or has_no_code(finalize_procinfo.code)
           ) then
          begin
            { first release the not used finalize procinfo }
            if assigned(finalize_procinfo) then
              begin
                release_proc_symbol(finalize_procinfo.procdef);
                release_main_proc(curr,finalize_procinfo);
              end;
            finalize_procinfo:=gen_implicit_initfinal(curr,mf_finalize,curr.localsymtable);
          end;

         { the finalization routine of libraries is generic (and all libraries need to }
         { be finalized, so they can finalize any units they use                       }
         { Place in "pure assembler" list so that the llvm assembler writer
           directly emits the generated directives }
         if (islibrary) then
           cnodeutils.RegisterModuleFiniFunction(search_system_proc('fpc_lib_exit'));

        { all labels must be defined before generating code }
        if Errorcount=0 then
          tstoredsymtable(curr.localsymtable).checklabels;

        { See remark in unit init/final }
        main_procinfo.generate_code_tree;
        main_procinfo.resetprocdef;
        release_main_proc(curr,main_procinfo);
        if assigned(init_procinfo) then
          begin
            { initialization can be implicit only }
            include(curr.moduleflags,mf_init);
            init_procinfo.code:=cnodeutils.wrap_proc_body(init_procinfo.procdef,init_procinfo.code);
            init_procinfo.generate_code;
            init_procinfo.resetprocdef;
            release_main_proc(curr,init_procinfo);
          end;
        if assigned(finalize_procinfo) then
          begin
            if force_init_final or
               cnodeutils.force_init or
               not(has_no_code(finalize_procinfo.code)) then
              begin
                finalize_procinfo.code:=cnodeutils.wrap_proc_body(finalize_procinfo.procdef,finalize_procinfo.code);
                finalize_procinfo.generate_code_tree;
                include(curr.moduleflags,mf_finalize);
              end;
            finalize_procinfo.resetprocdef;
            release_main_proc(curr,finalize_procinfo);
          end;

        symtablestack.pop(curr.localsymtable);

        { consume the last point }
        consume(_POINT);

        proc_program_after_parsing(curr,islibrary);
      end;

    procedure proc_library_header(curr: tmodule);
      var
        program_name : ansistring;

      begin
        consume(_LIBRARY);
        program_name:=orgpattern;
        consume(_ID);
        while token=_POINT do
         begin
           consume(_POINT);
           program_name:=program_name+'.'+orgpattern;
           consume(_ID);
         end;
        curr.setmodulename(program_name);
        curr.islibrary:=true;
        exportlib.preparelib(program_name);

        if tf_library_needs_pic in target_info.flags then
         begin
           include(current_settings.moduleswitches,cs_create_pic);
           { also set create_pic for all unit compilation }
           include(init_settings.moduleswitches,cs_create_pic);
         end;

        { setup things using the switches, do this before the semicolon, because after the semicolon has been
         read, all following directives are parsed as well }
        setupglobalswitches;

        {$ifdef DEBUG_NODE_XML}
        XMLInitializeNodeFile('library', program_name);
        {$endif DEBUG_NODE_XML}
      end;

    type
      TProgramParam = record
        name : ansistring;
        nr : dword;
      end;
      TProgramParamArray = array of TProgramParam;

      procedure proc_program_header(curr: tmodule; out sc : TProgramParamArray);

        var
          program_name : ansistring;
          paramnum : integer;

        begin
          sc:=nil;
          consume(_PROGRAM);
          program_name:=orgpattern;
          consume(_ID);
          while token=_POINT do
            begin
              consume(_POINT);
              program_name:=program_name+'.'+orgpattern;
              consume(_ID);
            end;
          curr.setmodulename(program_name);
          if (target_info.system in systems_unit_program_exports) then
            exportlib.preparelib(program_name);
          if token=_LKLAMMER then
            begin
               consume(_LKLAMMER);
               paramnum:=1;
               repeat
                 if m_isolike_program_para in current_settings.modeswitches then
                   begin
                     if (pattern<>'INPUT') and (pattern<>'OUTPUT') then
                       begin
                         { the symtablestack is not setup here, so text must be created later on }
                         Setlength(sc,length(sc)+1);
                         with sc[high(sc)] do
                           begin
                             name:=pattern;
                             nr:=paramnum;
                           end;
                         inc(paramnum);
                       end;
                   end;
                 consume(_ID);
               until not try_to_consume(_COMMA);
               consume(_RKLAMMER);
            end;

          { setup things using the switches, do this before the semicolon, because after the semicolon has been
            read, all following directives are parsed as well }
          setupglobalswitches;


{$ifdef DEBUG_NODE_XML}
          XMLInitializeNodeFile('program', program_name);
{$endif DEBUG_NODE_XML}
        end;

    procedure proc_program(curr: tmodule; islibrary : boolean);

      var
         main_file : tinputfile;
         consume_semicolon_after_uses,
         consume_semicolon_after_loaded : boolean;
         ps : tprogramparasym;
         textsym : ttypesym;
         sc : TProgramParamArray;
         i : Longint;
         feature : tfeature;

      begin
         Status.IsLibrary:=IsLibrary;
         Status.IsPackage:=false;
         Status.IsExe:=true;
         parse_only:=false;
         consume_semicolon_after_loaded:=false;

         { make the compiler happy and avoid an uninitialized variable warning on Setlength(sc,length(sc)+1); }
         sc:=nil;

         { DLL defaults to create reloc info }
         if islibrary or (target_info.system in [system_aarch64_win64]) then
           begin
             if not RelocSectionSetExplicitly then
               RelocSection:=true;
           end;

         { Relocation works only without stabs under Windows when }
         { external linker (LD) is used.  LD generates relocs for }
         { stab sections which is not loaded in memory. It causes }
         { AV error when DLL is loaded and relocation is needed.  }
         { Internal linker does not have this problem.            }
         if RelocSection and
            (target_info.system in systems_all_windows+[system_i386_wdosx]) and
            (cs_link_extern in current_settings.globalswitches) then
           begin
              include(current_settings.globalswitches,cs_link_strip);
              { Warning stabs info does not work with reloc section !! }
              if (cs_debuginfo in current_settings.moduleswitches) and
                 (target_dbg.id=dbg_stabs) then
                begin
                  Message1(parser_w_parser_reloc_no_debug,curr.mainsource);
                  Message(parser_w_parser_win32_debug_needs_WN);
                  exclude(current_settings.moduleswitches,cs_debuginfo);
                end;
           end;
         { get correct output names }
         main_file := current_scanner.inputfile;
         while assigned(main_file.next) do
           main_file := main_file.next;

         curr.SetFileName(main_file.path+main_file.name,true);

         if islibrary then
           begin
             proc_library_header(curr);
             consume_semicolon_after_loaded:=true;
           end
         else if token=_PROGRAM then
           { is there an program head ? }
           begin
             proc_program_header(curr,sc);
             consume_semicolon_after_loaded:=true;
           end
         else
           begin
             if (target_info.system in systems_unit_program_exports) then
               exportlib.preparelib(curr.realmodulename^);

             { setup things using the switches }
             setupglobalswitches;

{$ifdef DEBUG_NODE_XML}
             XMLInitializeNodeFile('program', curr.realmodulename^);
{$endif DEBUG_NODE_XML}
           end;

         { load all packages, so we know whether a unit is contained inside a
           package or not }
         load_packages;

         { set implementation flag }
         curr.in_interface:=false;
         curr.interface_compiled:=true;

         { insert after the unit symbol tables the static symbol table
           of the program                                              }
         curr.localsymtable:=tstaticsymtable.create(curr.modulename^,curr.moduleid);

         { load system unit }
         loadsystemunit(curr);

         { consume the semicolon now that the system unit is loaded }
         if consume_semicolon_after_loaded then
           consume(_SEMICOLON);

         { global switches are read, so further changes aren't allowed }
         curr.in_global:=false;
  
         { system unit is loaded, now insert feature defines }
         for feature:=low(tfeature) to high(tfeature) do
           if feature in features then
             def_system_macro('FPC_HAS_FEATURE_'+featurestr[feature]);

         { load standard units, e.g objpas,profile unit }
         loaddefaultunits(curr);

         { Load units provided on the command line }
         loadautounits(curr);

         { insert iso program parameters }
         if length(sc)>0 then
           begin
             textsym:=search_system_type('TEXT');
             if not(assigned(textsym)) then
               internalerror(2013011201);
             for i:=0 to high(sc) do
               begin
                 ps:=cprogramparasym.create(sc[i].name,sc[i].nr);
                 curr.localsymtable.insertsym(ps,true);
               end;
           end;

         { Load the units used by the program we compile. }
         if token=_USES then
           begin
             // We can do this here: if there is no uses then the namespace directive makes no sense.
             if Assigned(curr) then
               curr.Loadlocalnamespacelist
             else
               current_namespacelist:=Nil;
             loadunits(curr,nil,false);
             consume_semicolon_after_uses:=true;
           end
         else
           consume_semicolon_after_uses:=false;

         { All units are read, now give them a number }
         curr.updatemaps;

         { consume the semicolon after maps have been updated else conditional compiling expressions
           might cause internal errors, see tw8611 }
         if consume_semicolon_after_uses then
           consume(_SEMICOLON);

         proc_program_declarations(curr,islibrary);
      end;

end.