+ isolated semantic code in ProcUnit.

+ suspect compiler bug in parserOPL.loadunits :-(
added debug features to parseropl.pas, see "BugHere".
+ made current_scanner a function, to catch bad assignments (see "ifdef gbl").
+ found questionable code in tmodule.destroy (see "todo")


git-svn-id: http://svn.freepascal.org/svn/fpc/branches/dodi@16130 3ad0048d-3df7-0310-abae-a5850022a9f2

5 files changed, 581 insertions, 10 deletions

diff --git a/AltParser/compiler/fmodule.pas b/AltParser/compiler/fmodule.pas
index de64f05d9b..946f696df2 100644
--- a/AltParser/compiler/fmodule.pas
+++ b/AltParser/compiler/fmodule.pas
@@ -272,7 +272,7 @@ implementation
     procedure set_current_module(p:tmodule);
       begin
         { save the state of the scanner }
-        if assigned(current_scanner) then
+        if assigned(current_module) and assigned(current_scanner) then
           current_scanner.tempcloseinputfile;
         { set new module }
         current_module:=p;
@@ -283,7 +283,11 @@ implementation
             current_asmdata:=tasmdata(current_module.asmdata);
             current_debuginfo:=tdebuginfo(current_module.debuginfo);
             { restore scanner and file positions }
+          {$IFDEF gbl}
             current_scanner:=tscannerfile(current_module.scanner);
+          {$ELSE}
+            //SetScanner(tscannerfile(current_module.scanner));
+          {$ENDIF}
             if assigned(current_scanner) then
               begin
                 current_scanner.tempopeninputfile;
@@ -299,7 +303,10 @@ implementation
         else
           begin
             current_asmdata:=nil;
+          {$IFDEF gbl}
             current_scanner:=nil;
+          {$ELSE}
+          {$ENDIF}
             current_debuginfo:=nil;
           end;
       end;
@@ -571,9 +578,13 @@ implementation
          begin
             { also update current_scanner if it was pointing
               to this module }
+         {$IFDEF gbl}
             if current_scanner=tscannerfile(scanner) then
              current_scanner:=nil;
-            tscannerfile(scanner).free;
+            tscannerfile(scanner).free; //todo: also set scanner to nil!
+         {$ELSE}
+            FreeAndNil(scanner);
+         {$ENDIF}
          end;
         if assigned(asmdata) then
           begin
@@ -656,8 +667,11 @@ implementation
           begin
             { also update current_scanner if it was pointing
               to this module }
+          {$IFDEF gbl}
             if current_scanner=tscannerfile(scanner) then
              current_scanner:=nil;
+          {$ELSE}
+          {$ENDIF}
             tscannerfile(scanner).free;
             scanner:=nil;
           end;
diff --git a/AltParser/compiler/parser.pas b/AltParser/compiler/parser.pas
index c9e59e0ee0..eba5ed6c99 100644
--- a/AltParser/compiler/parser.pas
+++ b/AltParser/compiler/parser.pas
@@ -86,7 +86,10 @@ implementation
          pattern:='';
          orgpattern:='';
          cstringpattern:='';
+      {$IFDEF gbl}
          current_scanner:=nil;
+      {$ELSE}
+      {$ENDIF}
          switchesstatestackpos:=0;
 
          { register all nodes and tais }
@@ -157,11 +160,16 @@ implementation
 
          { if there was an error in the scanner, the scanner is
            still assinged }
+      {$IFDEF gbl}
          if assigned(current_scanner) then
           begin
             current_scanner.free;
             current_scanner:=nil;
           end;
+      {$ELSE}
+       if assigned(current_module) then
+        FreeAndNil(current_module.scanner);
+      {$ENDIF}
 
          { close scanner }
          DoneScanner;
@@ -373,9 +381,14 @@ implementation
          current_asmdata:=TAsmData(current_module.asmdata);
 
          { startup scanner and load the first file }
+       {$IFDEF gbl}
          current_scanner:=ParserFor(filename);
          current_scanner.firstfile;
          current_module.scanner:=current_scanner;
+       {$ELSE}
+         SetScanner(ParserFor(filename));
+         current_scanner.firstfile;
+       {$ENDIF}
 
          { init macros before anything in the file is parsed.}
          current_module.localmacrosymtable:= tmacrosymtable.create(false);
@@ -419,8 +432,11 @@ implementation
                { free scanner }
                if assigned(current_module.scanner) then
                  begin
+                 {$IFDEF gbl}
                    if current_scanner=tscannerfile(current_module.scanner) then
                      current_scanner:=nil;
+                 {$ELSE}
+                 {$ENDIF}
                    tscannerfile(current_module.scanner).free;
                    current_module.scanner:=nil;
                  end;
diff --git a/AltParser/compiler/parseropl.pas b/AltParser/compiler/parseropl.pas
index 15c77f7375..b2d04469b6 100644
--- a/AltParser/compiler/parseropl.pas
+++ b/AltParser/compiler/parseropl.pas
@@ -29,6 +29,22 @@ uses
   aasmbase,aasmdata,aasmcpu,aasmtai,wpobase, wpoinfo,link
   ;
 
+(* These constants are for debugging the semantic procedures.
+  It looks as if the same code behaves differently,
+  when used in a global or local procedure :-(
+
+  When different behaviour is assumed, set the condition to Buggy
+  to use the inlined code (known to work correctly).
+
+  When different behaviour has been detected, set the condition to BugHere
+  so that correct (inlined) code is enabled by default.
+  Set BugHere to True to use the code in the subroutine.
+*)
+const
+  Sem = True; //False; //use semantic procedures?
+  Buggy = False;  //don't use selected semantic procedures
+  BugHere = False;  //enable buggy semantic procedures?
+
 {***************************************************************
                 From pmodules
 ***************************************************************}
@@ -40,7 +56,86 @@ uses
          pu      : tused_unit;
          hp2     : tmodule;
          unitsym : tunitsym;
-      begin
+
+        procedure SIntfUses;
+         begin  //SIntfUses
+           { Give a warning if lineinfo is loaded }
+           if s='LINEINFO' then begin
+            Message(parser_w_no_lineinfo_use_switch);
+            if (paratargetdbg 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<>current_module.modulename^) then
+            begin
+              { check if the unit is already used }
+              hp2:=nil;
+              pu:=tused_unit(current_module.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(current_module,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 }
+              unitsym:=tunitsym.create(sorg,nil);
+              current_module.localsymtable.insert(unitsym);
+              { the current module uses the unit hp2 }
+              current_module.addusedunit(hp2,true,unitsym);
+            end
+           else
+            Message1(sym_e_duplicate_id,s);
+         end;
+
+        procedure SUsesDone;
+        begin //SUsesDone;
+         { Load the units }
+         pu:=tused_unit(current_module.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=current_module.in_interface) then
+             begin
+               tppumodule(pu.u).loadppu;
+               { is our module compiled? then we can stop }
+               if current_module.state=ms_compiled then
+                exit;
+               { add this unit to the dependencies }
+               pu.u.adddependency(current_module);
+               { save crc values }
+               pu.checksum:=pu.u.crc;
+               pu.interface_checksum:=pu.u.interface_crc;
+               pu.indirect_checksum:=pu.u.indirect_crc;
+               { connect unitsym to the module }
+               pu.unitsym.module:=pu.u;
+               { add to symtable stack }
+               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.u.check_hints;
+             end;
+            pu:=tused_unit(pu.next);
+          end;
+        end;
+
+      begin //loadunits
          {If you use units, you likely need unit initializations.}
          current_module.micro_exe_allowed:=false;
 
@@ -54,6 +149,9 @@ uses
            if not(m_tp7 in current_settings.modeswitches) and
               try_to_consume(_OP_IN) then
              fn:=FixFileName(get_stringconst);
+
+         if Sem then SIntfUses else
+         begin  //SIntfUses
            { Give a warning if lineinfo is loaded }
            if s='LINEINFO' then begin
             Message(parser_w_no_lineinfo_use_switch);
@@ -93,6 +191,8 @@ uses
             end
            else
             Message1(sym_e_duplicate_id,s);
+         end; //SIntfUses
+
            if token=_COMMA then
             begin
               pattern:='';
@@ -102,6 +202,8 @@ uses
             break;
          until false;
 
+        if BugHere {Sem} {Buggy} then SUsesDone else
+        begin //SUsesDone;
          { Load the units }
          pu:=tused_unit(current_module.used_units.first);
          while assigned(pu) do
@@ -133,6 +235,7 @@ uses
              end;
             pu:=tused_unit(pu.next);
           end;
+        end; //UsesDone;
 
          consume(_SEMICOLON);
       end;
@@ -171,19 +274,412 @@ uses
 {$ifdef debug_devirt}
          i: longint;
 {$endif debug_devirt}
+
+        procedure SModuleInitUnit;
+        begin //SModuleInitUnit;
+         init_procinfo:=nil;
+         finalize_procinfo:=nil;
+
+         if m_mac in current_settings.modeswitches then
+           current_module.mode_switch_allowed:= false;
+        end;
+
+        procedure SUnitName;
+            begin //SUnitName
+             { create filenames and unit name }
+             main_file := current_scanner.inputfile;
+             while assigned(main_file.next) do
+               main_file := main_file.next;
+
+             new(s1);
+             s1^:=current_module.modulename^;
+             current_module.SetFileName(main_file.path^+main_file.name^,true);
+             current_module.SetModuleName(orgpattern);
+
+             { check for system unit }
+             new(s2);
+             s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name^),''));
+             unitname8:=copy(current_module.modulename^,1,8);
+             if (cs_check_unit_name in current_settings.globalswitches) and
+                (
+                 not(
+                     (current_module.modulename^=s2^) or
+                     (
+                      (length(current_module.modulename^)>8) and
+                      (unitname8=s2^)
+                     )
+                    )
+                 or
+                 (
+                  (length(s1^)>8) and
+                  (s1^<>current_module.modulename^)
+                 )
+                ) then
+              Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
+             if (current_module.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(current_module.realmodulename^);
+        end;
+
+        procedure SUnitInterface;
+        begin //SUnitInterface
+         { global switches are read, so further changes aren't allowed }
+         current_module.in_global:=false;
+
+         { handle the global switches }
+         setupglobalswitches;
+
+         message1(unit_u_loading_interface_units,current_module.modulename^);
+
+         { update status }
+         status.currentmodule:=current_module.realmodulename^;
+
+         { maybe turn off m_objpas if we are compiling objpas }
+         if (current_module.modulename^='OBJPAS') then
+           exclude(current_settings.modeswitches,m_objpas);
+
+         { maybe turn off m_mac if we are compiling macpas }
+         if (current_module.modulename^='MACPAS') then
+           exclude(current_settings.modeswitches,m_mac);
+
+         parse_only:=true;
+
+         { generate now the global symboltable,
+           define first as local to overcome dependency conflicts }
+         current_module.localsymtable:=tglobalsymtable.create(current_module.modulename^,current_module.moduleid);
+
+         { insert unitsym of this unit to prevent other units having
+           the same name }
+         current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
+
+         { load default units, like the system unit }
+         loaddefaultunits;
+      end;
+
+        procedure SUnitIntfDone;
+        begin //SUnitIntfDone
+         { move the global symtable from the temporary local to global }
+         current_module.globalsymtable:=current_module.localsymtable;
+         current_module.localsymtable:=nil;
+
+         { number all units, so we know if a unit is used by this unit or
+           needs to be added implicitly }
+         current_module.updatemaps;
+
+         { create whole program optimisation information (may already be
+           updated in the interface, e.g., in case of classrefdef typed
+           constants }
+         current_module.wpoinfo:=tunitwpoinfo.create;
+
+         { ... parse the declarations }
+         Message1(parser_u_parsing_interface,current_module.realmodulename^);
+         symtablestack.push(current_module.globalsymtable);
+         read_interface_declarations;
+         symtablestack.pop(current_module.globalsymtable);
+
+         { 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
+            current_module.globalmacrosymtable:=tmacrosymtable.create(true);
+            current_module.localmacrosymtable.SymList.ForEachCall(@copy_macro,nil);
+          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;
+
+         { Our interface is compiled, generate CRC and switch to implementation }
+         if not(cs_compilesystem in current_settings.moduleswitches) and
+            (Errorcount=0) then
+           tppumodule(current_module).getppucrc;
+         current_module.in_interface:=false;
+         current_module.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(current_module).setdefgeneration;
+         tppumodule(current_module).reload_flagged_units;
+
+         { Parse the implementation section }
+         if (m_mac in current_settings.modeswitches) and try_to_consume(_END) then
+           current_module.interface_only:=true
+         else
+           current_module.interface_only:=false;
+
+         parse_only:=false;
+
+         { create static symbol table }
+         current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
+
+         { Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it }
+         maybe_load_got;
+      end; //SUnitIntfDone
+
+        procedure SUnitImplInit;
+        begin //SUnitImplInit;
+         if current_module.state=ms_compiled then
+           exit;
+
+         { All units are read, now give them a number }
+         current_module.updatemaps;
+
+         symtablestack.push(current_module.globalsymtable);
+         symtablestack.push(current_module.localsymtable);
+        end; //SUnitImplInit;
+
+        procedure SUnitBodyInit;
+            begin //SUnitBodyInit;
+             Message1(parser_u_parsing_implementation,current_module.modulename^);
+             if current_module.in_interface then
+               internalerror(200212285);
+
+             { Compile the unit }
+             init_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'init'),potype_unitinit,current_module.localsymtable);
+             init_procinfo.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
+            end; //SUnitBodyInit;
+
+        procedure SUnitBodyDone;
+        begin //SUnitBodyDone;
+         { Generate specializations of objectdefs methods }
+         generate_specialization_procs;
+
+         { if the unit contains ansi/widestrings, initialization and
+           finalization code must be forced }
+         force_init_final:=tglobalsymtable(current_module.globalsymtable).needs_init_final or
+                           tstaticsymtable(current_module.localsymtable).needs_init_final;
+
+         { should we force unit initialization? }
+         { this is a hack, but how can it be done better ? }
+         if force_init_final and ((current_module.flags and uf_init)=0) then
+           begin
+             { first release the not used init procinfo }
+             if assigned(init_procinfo) then
+               release_main_proc(init_procinfo);
+             init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable);
+           end;
+        end; //SUnitBodyDone;
+
+        procedure SUnitFinalInit(fPresent: boolean);
+        begin
+          if fPresent then
+            begin //finalize_procinfo:= SUnitFinalInit;
+              { the uf_finalize flag is only set after we checked that it
+                wasn't empty }
+
+              { Compile the finalize }
+              finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
+              finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
+            end
+          else
+           finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
+        end;
+
+        procedure SUnitFinalDone;
+        begin //SUnitFinalDone
+         { 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
+             init_procinfo.generate_code;
+             init_procinfo.resetprocdef;
+             release_main_proc(init_procinfo);
+           end;
+         if assigned(finalize_procinfo) then
+           begin
+             finalize_procinfo.generate_code;
+             finalize_procinfo.resetprocdef;
+             release_main_proc(finalize_procinfo);
+           end;
+
+         symtablestack.pop(current_module.localsymtable);
+         symtablestack.pop(current_module.globalsymtable);
+        end; //SUnitFinalDone
+
+        procedure SUnitDone;
+        begin //SUnitDone;
+         { reset wpo flags for all defs }
+         reset_all_defs;
+
+         if (Errorcount=0) then
+           begin
+             { tests, if all (interface) forwards are resolved }
+             tstoredsymtable(current_module.globalsymtable).check_forwards;
+             { check if all private fields are used }
+             tstoredsymtable(current_module.globalsymtable).allprivatesused;
+
+             { test static symtable }
+             tstoredsymtable(current_module.localsymtable).allsymbolsused;
+             tstoredsymtable(current_module.localsymtable).allprivatesused;
+             tstoredsymtable(current_module.localsymtable).check_forwards;
+             tstoredsymtable(current_module.localsymtable).checklabels;
+
+             { used units }
+             current_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;
+            exit;
+          end;
+
+         { if an Objective-C module, generate rtti and module info }
+         MaybeGenerateObjectiveCImageInfo(current_module.globalsymtable,current_module.localsymtable);
+
+         { do we need to add the variants unit? }
+         maybeloadvariantsunit;
+
+         { generate wrappers for interfaces }
+         gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.globalsymtable);
+         gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
+
+         { generate pic helpers to load eip if necessary }
+         gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
+
+         { generate rtti/init tables }
+         write_persistent_type_info(current_module.globalsymtable);
+         write_persistent_type_info(current_module.localsymtable);
+
+         { Tables }
+         InsertThreadvars;
+
+         { Resource strings }
+         GenerateResourceStrings;
+
+         { Widestring typed constants }
+         InsertWideInits;
+
+         { generate debuginfo }
+         if (cs_debuginfo in current_settings.moduleswitches) then
+           current_debuginfo.inserttypeinfo;
+
+         { generate imports }
+         if current_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
+         else
+           begin
+             current_module.flags:=current_module.flags or uf_no_link;
+             current_module.flags:=current_module.flags and not (uf_has_stabs_debuginfo or uf_has_dwarf_debuginfo);
+           end;
+
+         if ag then
+          begin
+            { create callframe info }
+            create_dwarf_frame;
+            { assemble }
+            create_objectfile;
+          end;
+
+         { Write out the ppufile after the object file has been created }
+         store_interface_crc:=current_module.interface_crc;
+         store_indirect_crc:=current_module.indirect_crc;
+{$ifdef EXTDEBUG}
+         store_crc:=current_module.crc;
+{$endif EXTDEBUG}
+         if (Errorcount=0) then
+           tppumodule(current_module).writeppu;
+
+         if not(cs_compilesystem in current_settings.moduleswitches) then
+           begin
+             if store_interface_crc<>current_module.interface_crc then
+               Message1(unit_u_interface_crc_changed,current_module.ppufilename^);
+             if store_indirect_crc<>current_module.indirect_crc then
+               Message1(unit_u_indirect_crc_changed,current_module.ppufilename^);
+           end;
+{$ifdef EXTDEBUG}
+         if not(cs_compilesystem in current_settings.moduleswitches) then
+           if (store_crc<>current_module.crc) and simplify_ppu then
+             Message1(unit_u_implementation_crc_changed,current_module.ppufilename^);
+{$endif EXTDEBUG}
+
+         { release local symtables that are not needed anymore }
+         free_localsymtables(current_module.globalsymtable);
+         free_localsymtables(current_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;
+            exit;
+          end;
+
+{$ifdef debug_devirt}
+         { print out all instantiated class/object types }
+         writeln('constructed object/class/classreftypes in ',current_module.realmodulename^);
+         for i := 0 to current_module.wpoinfo.createdobjtypes.count-1 do
+           begin
+             write('  ',tdef(current_module.wpoinfo.createdobjtypes[i]).GetTypeName);
+             case tdef(current_module.wpoinfo.createdobjtypes[i]).typ of
+               objectdef:
+                 case tobjectdef(current_module.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 current_module.wpoinfo.createdclassrefobjtypes.count-1 do
+           begin
+             write('  Class Of ',tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).GetTypeName);
+             case tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).typ of
+               objectdef:
+                 case tobjectdef(current_module.wpoinfo.createdclassrefobjtypes[i]).objecttype of
+                   odt_class:
+                     writeln(' (classrefdef)');
+                   else
+                     internalerror(2008101105);
+                 end
+               else
+                 internalerror(2008101102);
+             end;
+           end;
+{$endif debug_devirt}
+        end; //SUnitDone;
+
       begin
+        if Sem then SModuleInitUnit else
+        begin //SModuleInitUnit;
          init_procinfo:=nil;
          finalize_procinfo:=nil;
 
          if m_mac in current_settings.modeswitches then
            current_module.mode_switch_allowed:= false;
+        end; //SModuleInitUnit;
 
          consume(_UNIT);
          if compile_level=1 then
           Status.IsExe:=false;
 
          if token=_ID then
-          begin
+          if Sem then SUnitName else
+            begin //SUnitName
              { create filenames and unit name }
              main_file := current_scanner.inputfile;
              while assigned(main_file.next) do
@@ -218,10 +714,10 @@ uses
               include(current_settings.moduleswitches,cs_compilesystem);
              dispose(s2);
              dispose(s1);
-          end;
 
          if (target_info.system in systems_unit_program_exports) then
            exportlib.preparelib(current_module.realmodulename^);
+        end; //SUnitName
 
          consume(_ID);
 
@@ -230,6 +726,9 @@ uses
 
          consume(_SEMICOLON);
          consume(_INTERFACE);
+
+         if Sem then SUnitInterface else
+         begin //SUnitInterface
          { global switches are read, so further changes aren't allowed }
          current_module.in_global:=false;
 
@@ -261,6 +760,7 @@ uses
 
          { load default units, like the system unit }
          loaddefaultunits;
+      end; //SUnitInterface
 
          { insert qualifier for the system unit (allows system.writeln) }
          if not(cs_compilesystem in current_settings.moduleswitches) and
@@ -272,6 +772,8 @@ uses
                exit;
            end;
 
+         if Sem then SUnitIntfDone else
+         begin //SUnitIntfDone
          { move the global symtable from the temporary local to global }
          current_module.globalsymtable:=current_module.localsymtable;
          current_module.localsymtable:=nil;
@@ -333,6 +835,7 @@ uses
 
          { Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it }
          maybe_load_got;
+      end; //SUnitIntfDone
 
          if not current_module.interface_only then
            begin
@@ -344,6 +847,8 @@ uses
                loadunits;
            end;
 
+        if Sem then SUnitImplInit else
+        begin //SUnitImplInit;
          if current_module.state=ms_compiled then
            exit;
 
@@ -352,9 +857,12 @@ uses
 
          symtablestack.push(current_module.globalsymtable);
          symtablestack.push(current_module.localsymtable);
+        end; //SUnitImplInit;
 
-         if not current_module.interface_only then
-           begin
+        if not current_module.interface_only then
+          begin
+            if Sem then SUnitBodyInit else
+            begin //SUnitBodyInit;
              Message1(parser_u_parsing_implementation,current_module.modulename^);
              if current_module.in_interface then
                internalerror(200212285);
@@ -362,11 +870,15 @@ uses
              { Compile the unit }
              init_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'init'),potype_unitinit,current_module.localsymtable);
              init_procinfo.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
+            end; //SUnitBodyInit;
+
              init_procinfo.parse_body;
              { save file pos for debuginfo }
              current_module.mainfilepos:=init_procinfo.entrypos;
-           end;
+          end;
 
+        if Sem then SUnitBodyDone else
+        begin //SUnitBodyDone;
          { Generate specializations of objectdefs methods }
          generate_specialization_procs;
 
@@ -384,20 +896,29 @@ uses
                release_main_proc(init_procinfo);
              init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable);
            end;
+        end; //SUnitBodyDone;
+
          { finalize? }
          if not current_module.interface_only and (token=_FINALIZATION) then
            begin
+              if Sem then SUnitFinalInit(True) else
+            begin //finalize_procinfo:= SUnitFinalInit;
               { the uf_finalize flag is only set after we checked that it
                 wasn't empty }
 
               { Compile the finalize }
               finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
               finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
+            end; //SUnitFinalInit;
+
               finalize_procinfo.parse_body;
            end
          else if force_init_final then
+          if Sem then SUnitFinalInit(False) else
            finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
 
+         if Sem then SUnitFinalDone else
+        begin //SUnitFinalDone
          { 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
@@ -417,10 +938,13 @@ uses
 
          symtablestack.pop(current_module.localsymtable);
          symtablestack.pop(current_module.globalsymtable);
+        end; //SUnitFinalDone
 
          { the last char should always be a point }
          consume(_POINT);
 
+        if Sem then SUnitDone else
+        begin //SUnitDone;
          { reset wpo flags for all defs }
          reset_all_defs;
 
@@ -573,6 +1097,7 @@ uses
              end;
            end;
 {$endif debug_devirt}
+        end; //SUnitDone;
 
         Message1(unit_u_finished_compiling,current_module.modulename^);
       end;
diff --git a/AltParser/compiler/pbase.pas b/AltParser/compiler/pbase.pas
index 62400175ba..b6a06e5b9d 100644
--- a/AltParser/compiler/pbase.pas
+++ b/AltParser/compiler/pbase.pas
@@ -423,8 +423,6 @@ implementation
         end;
       end;
 
-//const ParaAltParser = True; //debug: force use of alternative parser
-
       function  ParserFor(const filename: string): TParser;
       var
         ext: string;
diff --git a/AltParser/compiler/scanner.pas b/AltParser/compiler/scanner.pas
index 53819988e7..7866b7d941 100644
--- a/AltParser/compiler/scanner.pas
+++ b/AltParser/compiler/scanner.pas
@@ -208,7 +208,13 @@ interface
         token,                        { current token being parsed }
         idtoken    : ttoken;          { holds the token if the pattern is a known word }
 
+    {$IFDEF gbl}
         current_scanner : tscannerfile;  { current scanner in use }
+    {$ELSE}
+        function current_scanner : tscannerfile;  { current scanner in use }
+        procedure SetScanner(s: tscannerfile);
+    var
+    {$ENDIF}
 
         aktcommentstyle : tcommentstyle; { needed to use read_comment from directives }
 {$ifdef PREPROCWRITE}
@@ -244,6 +250,18 @@ implementation
       turbo_scannerdirectives : TFPHashObjectList;     { for other modes }
       mac_scannerdirectives   : TFPHashObjectList;     { for mode mac }
 
+{$IFDEF gbl}
+{$ELSE}
+    function current_scanner : tscannerfile;  { current scanner in use }
+    begin
+      TObject(Result) := current_module.scanner;
+    end;
+
+    procedure SetScanner(s: tscannerfile);
+    begin
+      current_module.scanner := s;
+    end;
+{$ENDIF}
 
 {*****************************************************************************
                               Helper routines