View Issue Details

IDProjectCategoryView StatusLast Update
0016888FPCCompilerpublic2010-09-30 08:51
ReporterHans-Peter Diettrich Assigned To 
PrioritynormalSeverityminorReproducibilityalways
Status newResolutionopen 
Product Version2.5.1 
Summary0016888: Preprocessor doesn't compile
DescriptionThe preprocessor option in the compiler (-m) seems to be broken since a long time. The attached patch makes it compile and work again.
Steps To ReproduceAdd -dPreProcWrite to the compiler options,
try to build an compiler.
Additional InformationThe patch upgrades the parser.preprocess() code
- from the old Objects to the current Classes,
- scanner and module initialization,
fixes TPreProcFile (missing "override" on destructor)
adds missing Get_Directive to TScannerFile
adds TDirectiveItem.kind for preprocessor (and general) use
fixes a scanner problem (0000010 never occurs on Windows?)
adds a prep.lpi test project

Some more beautification may be necessary, see the notes and ToDos in the supplied code.
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files

Activities

2010-07-09 20:08

 

preprocessor.patch (19,493 bytes)   
Index: parser.pas
===================================================================
--- parser.pas	(revision 15534)
+++ parser.pas	(working copy)
@@ -184,31 +184,60 @@
       var
         i : longint;
       begin
-         new(preprocfile,init('pre'));
-       { initialize a module }
-         set_current_module(new(pmodule,init(filename,false)));
+      (* DoDi: I could make the preprocessor work, somehow,
+        but it still deserves some improvements:
+        - message 'preprocessing...'
+        - catch errors (open infile, outfile...)
+        - outfile: where? name?
+        - newlines?
+        Also remove old statements (comments).
+      *)
+        { TODO : set message level? show action?}
+        //status.verbosity := V_All;
+        Message1(parser_i_compiling, filename);
+        if not FileExists(filename) then begin
+        { TODO : handle missing files properly }
+          Message2(scan_f_cannot_open_input, 'File not found: ', filename);
+          inc(status.errorcount);
+          Exit;
+        end;
+         { TODO : force preprocessed file into source directory, by default?
+          handle errors? }
+         //new(preprocfile,init('pre'));
+        //preprocfile := tpreprocfile.create('pre'); //?
+        preprocfile := tpreprocfile.create(filename + '.pre'); //???
 
-         macrosymtablestack:= initialmacrosymtable;
+       { initialize a module, for symbol tables etc. }
+         //set_current_module(new(pmodule,init(filename,false)));
+         set_current_module(tmodule.create(nil, filename, False));
+
+         //macrosymtablestack:= initialmacrosymtable;
+         macrosymtablestack:= TSymtablestack.create;
+         { init macros before anything in the file is parsed.}
          current_module.localmacrosymtable:= tmacrosymtable.create(false);
-         current_module.localmacrosymtable.next:= initialmacrosymtable;
-         macrosymtablestack:= current_module.localmacrosymtable;
+         //current_module.localmacrosymtable.next:= initialmacrosymtable;
+         //macrosymtablestack:= current_module.localmacrosymtable;
+         macrosymtablestack.push(initialmacrosymtable);
+         macrosymtablestack.push(current_module.localmacrosymtable);
 
          main_module:=current_module;
        { startup scanner, and save in current_module }
-         current_scanner:=new(pscannerfile,Init(filename));
-         current_module.scanner:=current_scanner;
+         //current_scanner:=new(pscannerfile,Init(filename));
+         current_scanner:=tscannerfile.Create(filename); //?
+         current_scanner.firstfile;
+         //current_module.scanner:=current_scanner;
        { loop until EOF is found }
          repeat
-           current_scanner^.readtoken(true);
-           preprocfile^.AddSpace;
+           current_scanner.readtoken(true);
+           //preprocfile.AddSpace; //nl, space or nothing - moved into Add()
            case token of
              _ID :
                begin
-                 preprocfile^.Add(orgpattern);
+                 preprocfile.Add(orgpattern);
                end;
              _REALNUMBER,
              _INTCONST :
-               preprocfile^.Add(pattern);
+               preprocfile.Add(pattern);
              _CSTRING :
                begin
                  i:=0;
@@ -221,7 +250,7 @@
                        inc(i);
                      end;
                   end;
-                 preprocfile^.Add(''''+cstringpattern+'''');
+                 preprocfile.Add(''''+cstringpattern+'''');
                end;
              _CCHAR :
                begin
@@ -237,19 +266,19 @@
                    else
                      pattern:=''''+pattern[1]+'''';
                  end;
-                 preprocfile^.Add(pattern);
+                 preprocfile.Add(pattern);
                end;
              _EOF :
                break;
              else
-               preprocfile^.Add(tokeninfo^[token].str)
+               preprocfile.Add(tokeninfo^[token].str)
            end;
          until false;
        { free scanner }
-         dispose(current_scanner,done);
+         current_scanner.Free;  // dispose(current_scanner,done);
          current_scanner:=nil;
        { close }
-         dispose(preprocfile,done);
+         preprocfile.Free;  // dispose(preprocfile,done);
       end;
 {$endif PREPROCWRITE}
 
Index: pp.lpi
===================================================================
--- pp.lpi	(revision 15534)
+++ pp.lpi	(working copy)
@@ -15,6 +15,9 @@
       <TargetFileExt Value=".exe"/>
       <Title Value="pp"/>
     </General>
+    <VersionInfo>
+      <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion="0.0.0.0"/>
+    </VersionInfo>
     <PublishOptions>
       <Version Value="2"/>
       <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
@@ -23,7 +26,6 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="-n @\home\florian\bin\fpc.cfg \home\florian\fpc\tests\test\cg\tsar1.pp"/>
         <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
@@ -41,7 +43,7 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="8"/>
+    <Version Value="9"/>
     <PathDelim Value="\"/>
     <Target>
       <Filename Value="i386\pp"/>
@@ -56,6 +58,7 @@
         <CStyleOperator Value="False"/>
         <AllowLabel Value="False"/>
         <CPPInline Value="False"/>
+        <UseAnsiStrings Value="False"/>
       </SyntaxOptions>
     </Parsing>
     <Linking>
Index: prep.lpi
===================================================================
--- prep.lpi	(revision 0)
+++ prep.lpi	(revision 0)
@@ -0,0 +1,99 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="7"/>
+    <General>
+      <Flags>
+        <MainUnitHasUsesSectionForAllUnits Value="False"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=".exe"/>
+      <Title Value="prep"/>
+    </General>
+    <VersionInfo>
+      <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion="0.0.0.0"/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <CommandLineParams Value="-m E:\fpcsrc\fpc-2.5\compiler\prep.pas"/>
+        <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="prep.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="prep"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="x86\aasmcpu.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="aasmcpu"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="i386\prep"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="i386\"/>
+      <OtherUnitFiles Value="i386\;x86\;systems\"/>
+      <UnitOutputDirectory Value="i386\lazbuild"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <CStyleOperator Value="False"/>
+        <AllowLabel Value="False"/>
+        <CPPInline Value="False"/>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Optimizations>
+        <OptimizationLevel Value="0"/>
+      </Optimizations>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="True"/>
+      </Debugging>
+    </Linking>
+    <Other>
+      <Verbosity>
+        <ShowWarn Value="False"/>
+        <ShowNotes Value="False"/>
+        <ShowHints Value="False"/>
+      </Verbosity>
+      <ConfigFile>
+        <StopAfterErrCount Value="50"/>
+      </ConfigFile>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CustomOptions Value="-di386 -dPreprocWrite
+"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="1">
+      <Item1>
+        <Name Value="ECompilerAbortSilent"/>
+      </Item1>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

Property changes on: prep.lpi
___________________________________________________________________
Added: svn:mime-type
   + text/plain
Added: svn:eol-style
   + native

Index: prep.pas
===================================================================
--- prep.pas	(revision 0)
+++ prep.pas	(revision 0)
@@ -0,0 +1,101 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Commandline compiler for Free Pascal
+
+    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.
+
+ ****************************************************************************
+}
+program prep;
+
+{$ifdef win32}
+  { 256 MB stack }
+  { under windows the stack can't grow }
+  {$MAXSTACKSIZE 256000000}
+{$else win32}
+  {$ifdef win64}
+    { 512 MB stack }
+    { under windows the stack can't grow }
+    {$MAXSTACKSIZE 512000000}
+  {$else win64}
+    { 1 MB stack }
+    {$MINSTACKSIZE 1000000}
+  {$endif win64}
+{$endif win32}
+
+uses
+{$ifdef cmem}
+  cmem,
+{$endif cmem}
+{$ifdef profile}
+  profile,
+{$endif profile}
+{$ifndef NOCATCH}
+  {$if defined(Unix) or defined(Go32v2) or defined(Watcom)}
+    catch,
+  {$endif}
+{$endif NOCATCH}
+  globals,compiler;
+
+var
+  oldexit : pointer;
+procedure myexit;
+begin
+  exitproc:=oldexit;
+{$ifdef nocatch}
+  exit;
+{$endif nocatch}
+{ Show Runtime error if there was an error }
+  if (erroraddr<>nil) then
+   begin
+     case exitcode of
+      100:
+        begin
+           erroraddr:=nil;
+           writeln('Error while reading file');
+        end;
+      101:
+        begin
+           erroraddr:=nil;
+           writeln('Error while writing file');
+        end;
+      202:
+        begin
+           erroraddr:=nil;
+           writeln('Error: Stack Overflow');
+        end;
+      203:
+        begin
+           erroraddr:=nil;
+           writeln('Error: Out of memory');
+        end;
+     end;
+     { we cannot use current_filepos.file because all memory might have been
+       freed already !
+       But we can use global parser_current_file var }
+     Writeln('Compilation aborted ',parser_current_file,':',current_filepos.line);
+   end;
+end;
+
+begin
+  oldexit:=exitproc;
+  exitproc:=@myexit;
+{$ifdef extheaptrc}
+  keepreleased:=true;
+{$endif extheaptrc}
+{ Call the compiler with empty command, so it will take the parameters }
+  Halt(compiler.Compile(''));
+end.

Property changes on: prep.pas
___________________________________________________________________
Added: svn:mime-type
   + text/pascal
Added: svn:eol-style
   + native

Index: scanner.pas
===================================================================
--- scanner.pas	(revision 15534)
+++ scanner.pas	(working copy)
@@ -57,12 +57,21 @@
 
        tdirectiveproc=procedure;
 
+       eDirectiveItem = (
+        diOther,
+        diDefine, // _DIR_DEFINE,
+        diUndef   // _DIR_UNDEF
+       ); //for preprocessor
+
        tdirectiveitem = class(TFPHashObject)
        public
           is_conditional : boolean;
+         kind: eDirectiveItem;
           proc : tdirectiveproc;
-          constructor Create(AList:TFPHashObjectList;const n:string;p:tdirectiveproc);
-          constructor CreateCond(AList:TFPHashObjectList;const n:string;p:tdirectiveproc);
+          constructor Create(AList:TFPHashObjectList;const n:string;
+            p:tdirectiveproc; k:eDirectiveItem=diOther);
+          constructor CreateCond(AList:TFPHashObjectList;const n:string;
+            p:tdirectiveproc; k:eDirectiveItem=diOther);
        end;
 
        // stack for replay buffers
@@ -156,6 +165,7 @@
           procedure popreplaystack;
           procedure handleconditional(p:tdirectiveitem);
           procedure handledirectives;
+          function  Get_Directive(const hs: string): tdirectiveitem;
           procedure linebreak;
           procedure recordtoken;
           procedure startrecordtokens(buf:tdynamicarray);
@@ -187,10 +197,11 @@
        tpreprocfile=class
          f   : text;
          buf : pointer;
+       public
          spacefound,
          eolfound : boolean;
          constructor create(const fn:string);
-         destructor  destroy;
+         destructor  destroy; override;
          procedure Add(const s:string);
          procedure AddSpace;
        end;
@@ -218,8 +229,8 @@
     type
         tdirectivemode = (directive_all, directive_turbo, directive_mac);
 
-    procedure AddDirective(const s:string; dm: tdirectivemode; p:tdirectiveproc);
-    procedure AddConditional(const s:string; dm: tdirectivemode; p:tdirectiveproc);
+    procedure AddDirective(const s:string; dm: tdirectivemode; p:tdirectiveproc; k:eDirectiveItem=diOther);
+    procedure AddConditional(const s:string; dm: tdirectivemode; p:tdirectiveproc; k:eDirectiveItem=diOther);
 
     procedure InitScanner;
     procedure DoneScanner;
@@ -1801,6 +1812,7 @@
 
     procedure tpreprocfile.add(const s:string);
       begin
+        AddSpace; //if whitespace found
         write(f,s);
       end;
 
@@ -1848,18 +1860,20 @@
                               TDirectiveItem
 *****************************************************************************}
 
-    constructor TDirectiveItem.Create(AList:TFPHashObjectList;const n:string;p:tdirectiveproc);
+    constructor TDirectiveItem.Create(AList:TFPHashObjectList;const n:string;p:tdirectiveproc; k:eDirectiveItem);
       begin
         inherited Create(AList,n);
         is_conditional:=false;
+        kind := k;
         proc:=p;
       end;
 
 
-    constructor TDirectiveItem.CreateCond(AList:TFPHashObjectList;const n:string;p:tdirectiveproc);
+    constructor TDirectiveItem.CreateCond(AList:TFPHashObjectList;const n:string;p:tdirectiveproc; k:eDirectiveItem);
       begin
         inherited Create(AList,n);
         is_conditional:=true;
+        kind := k;
         proc:=p;
       end;
 
@@ -2668,10 +2682,11 @@
          if parapreprocess then
           begin
             t:=Get_Directive(hs);
-            if not(is_conditional(t) or (t=_DIR_DEFINE) or (t=_DIR_UNDEF)) then
+            //if not(is_conditional(t) or (t=_DIR_DEFINE) or (t=_DIR_UNDEF)) then
+            if not(t.is_conditional or (t.kind in [diDefine, diUndef])) then
              begin
-               preprocfile^.AddSpace;
-               preprocfile^.Add('{$'+hs+current_scanner.readcomment+'}');
+               preprocfile.AddSpace;
+               preprocfile.Add('{$'+hs+current_scanner.readcomment+'}');
                exit;
              end;
           end;
@@ -2714,10 +2729,14 @@
          { directives may follow switches after a , }
          if hs<>'' then
           begin
+          {$IFDEF old}
             if not (m_mac in current_settings.modeswitches) then
               t:=tdirectiveitem(turbo_scannerdirectives.Find(hs))
             else
               t:=tdirectiveitem(mac_scannerdirectives.Find(hs));
+          {$ELSE}
+            t := Get_Directive(hs);
+          {$ENDIF}
 
             if assigned(t) then
              begin
@@ -2742,7 +2761,15 @@
           end;
       end;
 
+  function tscannerfile.Get_Directive(const hs: string): tdirectiveitem;
+    begin
+      if not (m_mac in current_settings.modeswitches) then
+        Result:=tdirectiveitem(turbo_scannerdirectives.Find(hs))
+      else
+        Result:=tdirectiveitem(mac_scannerdirectives.Find(hs));
+    end;
 
+
     procedure tscannerfile.readchar;
       begin
         c:=inputpointer^;
@@ -3391,7 +3418,8 @@
 {$ifdef PREPROCWRITE}
                 if parapreprocess then
                  begin
-                   if c=#10 then
+                   //if c=#10 then  //never matched???
+                   if c in [#10,#13] then
                     preprocfile.eolfound:=true
                    else
                     preprocfile.spacefound:=true;
@@ -4303,20 +4331,20 @@
                                    Helpers
 *****************************************************************************}
 
-    procedure AddDirective(const s:string; dm: tdirectivemode; p:tdirectiveproc);
+    procedure AddDirective(const s:string; dm: tdirectivemode; p:tdirectiveproc; k:eDirectiveItem);
       begin
         if dm in [directive_all, directive_turbo] then
-          tdirectiveitem.create(turbo_scannerdirectives,s,p);
+          tdirectiveitem.create(turbo_scannerdirectives,s,p,k);
         if dm in [directive_all, directive_mac] then
-          tdirectiveitem.create(mac_scannerdirectives,s,p);
+          tdirectiveitem.create(mac_scannerdirectives,s,p,k);
       end;
 
-    procedure AddConditional(const s:string; dm: tdirectivemode; p:tdirectiveproc);
+    procedure AddConditional(const s:string; dm: tdirectivemode; p:tdirectiveproc; k:eDirectiveItem);
       begin
         if dm in [directive_all, directive_turbo] then
-          tdirectiveitem.createcond(turbo_scannerdirectives,s,p);
+          tdirectiveitem.createcond(turbo_scannerdirectives,s,p,k);
         if dm in [directive_all, directive_mac] then
-          tdirectiveitem.createcond(mac_scannerdirectives,s,p);
+          tdirectiveitem.createcond(mac_scannerdirectives,s,p,k);
       end;
 
 {*****************************************************************************
@@ -4331,9 +4359,10 @@
 
         { Common directives and conditionals }
         AddDirective('I',directive_all, @dir_include);
-        AddDirective('DEFINE',directive_all, @dir_define);
-        AddDirective('UNDEF',directive_all, @dir_undef);
+        AddDirective('DEFINE',directive_all, @dir_define, diDefine);
+        AddDirective('UNDEF',directive_all, @dir_undef, diUndef);
 
+        { TODO : add directive kinds for all conditionals }
         AddConditional('IF',directive_all, @dir_if);
         AddConditional('IFDEF',directive_all, @dir_ifdef);
         AddConditional('IFNDEF',directive_all, @dir_ifndef);
preprocessor.patch (19,493 bytes)   

Jonas Maebe

2010-07-09 20:39

manager   ~0039205

The -m option and -dpreprocrewrite has never worked. It's only in the compiler sources because it dates from the time that we still used cvs (from the first cvs repository even, i.e., before July 2000), and back then it was very cumbersome to use separate branches to work on experimental code. It's also not documented in the help page.

I'm not even sure what the purpose of that code is. What does it do? And what can the compiler do after this patch? This patch seems to do a lot more than simply fix an undocumented and never-finished command line parameter, and the comments you added seem to indicate that this code is far from finished (lots of question marks and TODO comments as you also mention above).

Also, adding a lot of commented-out code is not good practice, it only makes the code harder to read.

This is not necessarily an improvement:
> - from the old Objects to the current Classes,

In general, that mainly makes code slower. It's mainly useful if you need features offered by classes that are not possible with objects (such as virtual constructors).

This is also wrong:
> fixes a scanner problem (# 10 never occurs on Windows?)

FPC supports all line endings on all platforms. If you consider both # 10 and # 13 as the end-of-line, you will detect two end-of-line characters with the standard Dos/Windows EOL combination. On the other hand, only looking at # 10 is also wrong, because Mac line endings are # 13 only.

Please also always submit separate patches for separate things, e.g.
> fixes TPreProcFile (missing "override" on destructor)

This is unrelated to the rest of the patch (it's also harmless, but it's indeed nicer to correct it)

Hans-Peter Diettrich

2010-07-12 01:15

reporter   ~0039274

Please verify your assumptions, before you produce wrong criticism out of thin air. Thanks.

Jonas Maebe

2010-07-19 14:03

manager   ~0039452

For Hans-Peter Diettrich's actual answer, see http://lists.freepascal.org/lists/fpc-devel/2010-July/020568.html

Jonas Maebe

2010-07-19 14:37

manager   ~0039459

> Why a branch for a simple function of the compiler?

Because it wasn't finished yet. Unfinished code is normally not committed to trunk. It's committed to a branch, developed there and once it's finished it's merged into trunk.

> > The -m option and -dpreprocrewrite has never worked.
>
> Now it does - so what?

That was in reply to your remark that the option "seems to be broken since a long time".

> > This patch seems to do a lot more than simply fix an undocumented and
> > never-finished command line parameter, and the comments you added seem
> > to indicate that this code is far from finished (lots of question
> > marks and TODO comments as you also mention above).
>
> The questions arose from the missing (detailed) description of the
> preprocessor. They are easy to answer, but deserve an consent
> about the correct answer (desired behaviour).

To me at least that suggests that this patch is not ready to be committed as is.

> > And what can the compiler do after this patch?
>
> It can output the preprocessed file, instead of an object file. In that
> file one can see which code remains, after the conditionally excluded
> parts have been removed. Very helpful when complex nested conditions
> and defines are used.

Conditionals can also be debugged with the -vc option, but such a feature might indeed be handy to get a quick overview.

> > Also, adding a lot of commented-out code is not good practice, it only
> > makes the code harder to read.
>
> I've left the original code for the case that somebody wants to know
> more about my changes, before adding it permanently to the trunk.

That's what diffs are for. Now the diff shows the old lines twice everywhere, which for me make it harder to read the changes.

> > This is also wrong:
> > fixes a scanner problem (# 10 never occurs on Windows?)
>
> How can you decline? Have you debugged the code, as I did? :-(

In that case, you should add a comment explaining why that is the case. Requiring everyone who wonders about that statement (knowing how the compiler normally functions) to debug the compiler in order to figure it out serves no useful purpose.

In general, comments like "fixes a problem in X" should be avoided, much better is "solves problem X that when occurs when Y and Z happen, which is the case when construct Q is parsed". That will help people who look in the svn log afterwards in case they wonder why something was changed.

> and the "override" is not harmless, because a destructor without
> "override" is never called by Free.

That's correct, my mistake.

> Should I supply two or more patches, which only make sense when
> applied together?

No, that's only if in fact unrelated things are changed by the same patch. If that's not the case, then it's not necessary.

2010-09-30 08:49

 

prep2.patch (12,177 bytes)   
Index: compiler/globals.pas
===================================================================
--- compiler/globals.pas	(revision 16066)
+++ compiler/globals.pas	(working copy)
@@ -208,7 +208,9 @@
        paralinkoptions   : TCmdStr;
        paradynamiclinker : string;
        paraprintnodetree : byte;
+{$ifdef PREPROCWRITE}
        parapreprocess    : boolean;
+{$ENDIF PREPROCWRITE}
        printnodefile     : text;
 
        {  typical cross compiling params}
Index: compiler/options.pas
===================================================================
--- compiler/options.pas	(revision 16066)
+++ compiler/options.pas	(working copy)
@@ -1094,8 +1094,10 @@
            'l' :
              ParaLogo:=not UnSetBool(more,0);
 
+{$ifdef PREPROCWRITE}
            'm' :
              parapreprocess:=not UnSetBool(more,0);
+{$endif PREPROCWRITE}
 
            'M' :
              begin
Index: compiler/parser.pas
===================================================================
--- compiler/parser.pas	(revision 16066)
+++ compiler/parser.pas	(working copy)
@@ -184,31 +184,40 @@
       var
         i : longint;
       begin
-         new(preprocfile,init('pre'));
+         preprocfile:=tpreprocfile.create(filename+'.txt'); //init('pre');
        { initialize a module }
-         set_current_module(new(pmodule,init(filename,false)));
+         set_current_module(tmodule.create(nil,filename,false));
+         current_module.state := ms_compile;
+         main_module:=current_module;
+         parser_current_file:=filename;
 
-         macrosymtablestack:= initialmacrosymtable;
+       { Load current state from the init values }
+         current_settings:=init_settings;
+
+       { reset symtable }
+         symtablestack := TSymtablestack.create;
+         macrosymtablestack:=TSymtablestack.create;
+
+       { init macros before anything in the file is parsed.}
          current_module.localmacrosymtable:= tmacrosymtable.create(false);
-         current_module.localmacrosymtable.next:= initialmacrosymtable;
-         macrosymtablestack:= current_module.localmacrosymtable;
+         macrosymtablestack.push(initialmacrosymtable);
+         macrosymtablestack.push(current_module.localmacrosymtable);
 
-         main_module:=current_module;
        { startup scanner, and save in current_module }
-         current_scanner:=new(pscannerfile,Init(filename));
+         current_scanner:=tscannerfile.Create(filename);
          current_module.scanner:=current_scanner;
+         current_scanner.firstfile;
        { loop until EOF is found }
          repeat
-           current_scanner^.readtoken(true);
-           preprocfile^.AddSpace;
+           current_scanner.readtoken(true);
            case token of
              _ID :
                begin
-                 preprocfile^.Add(orgpattern);
+                 preprocfile.Add(orgpattern);
                end;
              _REALNUMBER,
              _INTCONST :
-               preprocfile^.Add(pattern);
+               preprocfile.Add(pattern);
              _CSTRING :
                begin
                  i:=0;
@@ -221,7 +230,7 @@
                        inc(i);
                      end;
                   end;
-                 preprocfile^.Add(''''+cstringpattern+'''');
+                 preprocfile.Add(''''+cstringpattern+'''');
                end;
              _CCHAR :
                begin
@@ -237,19 +246,19 @@
                    else
                      pattern:=''''+pattern[1]+'''';
                  end;
-                 preprocfile^.Add(pattern);
+                 preprocfile.Add(pattern);
                end;
              _EOF :
                break;
              else
-               preprocfile^.Add(tokeninfo^[token].str)
+               preprocfile.Add(tokeninfo^[token].str)
            end;
          until false;
-       { free scanner }
-         dispose(current_scanner,done);
-         current_scanner:=nil;
+       { free module }
+         main_module := nil;
+         FreeAndNil(current_module);
        { close }
-         dispose(preprocfile,done);
+         FreeAndNil(preprocfile);
       end;
 {$endif PREPROCWRITE}
 
Index: compiler/scanner.pas
===================================================================
--- compiler/scanner.pas	(revision 16066)
+++ compiler/scanner.pas	(working copy)
@@ -57,11 +57,19 @@
 
        tdirectiveproc=procedure;
 
+    { Directive kind for preprocessor }
+       TDirectiveKind = (
+        dkOther,  // all directives but the following:
+        dkDefine, // $DEFINE
+        dkUndef   // $UNDEF
+       );
+
        tdirectiveitem = class(TFPHashObject)
        public
           is_conditional : boolean;
+          kind: TDirectiveKind;
           proc : tdirectiveproc;
-          constructor Create(AList:TFPHashObjectList;const n:string;p:tdirectiveproc);
+          constructor Create(AList:TFPHashObjectList;const n:string;p:tdirectiveproc;k:TDirectiveKind);
           constructor CreateCond(AList:TFPHashObjectList;const n:string;p:tdirectiveproc);
        end;
 
@@ -78,6 +86,8 @@
 
        tspecialgenerictoken = (ST_LOADSETTINGS,ST_LINE,ST_COLUMN,ST_FILEINDEX);
 
+       { tscannerfile }
+
        tscannerfile = class
        private
          procedure do_gettokenpos(out tokenpos: longint; out filepos: tfileposinfo);
@@ -156,6 +166,7 @@
           procedure popreplaystack;
           procedure handleconditional(p:tdirectiveitem);
           procedure handledirectives;
+          function  Get_Directive(const hs: string):tdirectiveitem;
           procedure linebreak;
           procedure recordtoken;
           procedure startrecordtokens(buf:tdynamicarray);
@@ -184,16 +195,21 @@
        end;
 
 {$ifdef PREPROCWRITE}
+    { output file for preprocessor option }
        tpreprocfile=class
+       protected
          f   : text;
          buf : pointer;
          spacefound,
          eolfound : boolean;
+         procedure AddSpace;
+       public
          constructor create(const fn:string);
-         destructor  destroy;
+         destructor  destroy; override;
          procedure Add(const s:string);
-         procedure AddSpace;
        end;
+    var
+        preprocfile     : tpreprocfile;  { used with only preprocessing }
 {$endif PREPROCWRITE}
 
     var
@@ -211,14 +227,11 @@
         current_scanner : tscannerfile;  { current scanner in use }
 
         aktcommentstyle : tcommentstyle; { needed to use read_comment from directives }
-{$ifdef PREPROCWRITE}
-        preprocfile     : tpreprocfile;  { used with only preprocessing }
-{$endif PREPROCWRITE}
 
     type
         tdirectivemode = (directive_all, directive_turbo, directive_mac);
 
-    procedure AddDirective(const s:string; dm: tdirectivemode; p:tdirectiveproc);
+    procedure AddDirective(const s:string; dm: tdirectivemode; p:tdirectiveproc; k:TDirectiveKind = dkOther);
     procedure AddConditional(const s:string; dm: tdirectivemode; p:tdirectiveproc);
 
     procedure InitScanner;
@@ -1804,6 +1817,7 @@
 
     procedure tpreprocfile.add(const s:string);
       begin
+        AddSpace;
         write(f,s);
       end;
 
@@ -1851,19 +1865,18 @@
                               TDirectiveItem
 *****************************************************************************}
 
-    constructor TDirectiveItem.Create(AList:TFPHashObjectList;const n:string;p:tdirectiveproc);
+    constructor TDirectiveItem.Create(AList:TFPHashObjectList;const n:string;p:tdirectiveproc;k:TDirectiveKind);
       begin
         inherited Create(AList,n);
-        is_conditional:=false;
+        kind := k;
         proc:=p;
       end;
 
 
     constructor TDirectiveItem.CreateCond(AList:TFPHashObjectList;const n:string;p:tdirectiveproc);
       begin
-        inherited Create(AList,n);
+        Create(AList,n,p,dkOther);
         is_conditional:=true;
-        proc:=p;
       end;
 
 {****************************************************************************
@@ -2640,10 +2653,7 @@
              Message(scan_c_skipping_until);
              repeat
                current_scanner.skipuntildirective;
-               if not (m_mac in current_settings.modeswitches) then
-                 p:=tdirectiveitem(turbo_scannerdirectives.Find(current_scanner.readid))
-               else
-                 p:=tdirectiveitem(mac_scannerdirectives.Find(current_scanner.readid));
+               p := Get_Directive(current_scanner.readid);
              until assigned(p) and (p.is_conditional);
              current_scanner.gettokenpos;
              Message1(scan_d_handling_switch,'$'+p.name);
@@ -2653,6 +2663,14 @@
       end;
 
 
+    function tscannerfile.Get_Directive(const hs: string): tdirectiveitem;
+    begin
+        if not (m_mac in current_settings.modeswitches) then
+          Result:=tdirectiveitem(turbo_scannerdirectives.Find(hs))
+        else
+          Result:=tdirectiveitem(mac_scannerdirectives.Find(hs));
+    end;
+
     procedure tscannerfile.handledirectives;
       var
          t  : tdirectiveitem;
@@ -2671,10 +2689,10 @@
          if parapreprocess then
           begin
             t:=Get_Directive(hs);
-            if not(is_conditional(t) or (t=_DIR_DEFINE) or (t=_DIR_UNDEF)) then
+            if not(t.is_conditional or (t.kind in [dkDefine,dkUndef])) then
              begin
-               preprocfile^.AddSpace;
-               preprocfile^.Add('{$'+hs+current_scanner.readcomment+'}');
+               preprocfile.AddSpace;
+               preprocfile.Add('{$'+hs+current_scanner.readcomment+'}');
                exit;
              end;
           end;
@@ -2717,10 +2735,7 @@
          { directives may follow switches after a , }
          if hs<>'' then
           begin
-            if not (m_mac in current_settings.modeswitches) then
-              t:=tdirectiveitem(turbo_scannerdirectives.Find(hs))
-            else
-              t:=tdirectiveitem(mac_scannerdirectives.Find(hs));
+            t := Get_Directive(hs);
 
             if assigned(t) then
              begin
@@ -3394,7 +3409,7 @@
 {$ifdef PREPROCWRITE}
                 if parapreprocess then
                  begin
-                   if c=#10 then
+                   if c in [#10,#13] then
                     preprocfile.eolfound:=true
                    else
                     preprocfile.spacefound:=true;
@@ -4306,12 +4321,12 @@
                                    Helpers
 *****************************************************************************}
 
-    procedure AddDirective(const s:string; dm: tdirectivemode; p:tdirectiveproc);
+    procedure AddDirective(const s:string; dm: tdirectivemode; p:tdirectiveproc; k:TDirectiveKind);
       begin
         if dm in [directive_all, directive_turbo] then
-          tdirectiveitem.create(turbo_scannerdirectives,s,p);
+          tdirectiveitem.create(turbo_scannerdirectives,s,p,k);
         if dm in [directive_all, directive_mac] then
-          tdirectiveitem.create(mac_scannerdirectives,s,p);
+          tdirectiveitem.create(mac_scannerdirectives,s,p,k);
       end;
 
     procedure AddConditional(const s:string; dm: tdirectivemode; p:tdirectiveproc);
@@ -4334,8 +4349,8 @@
 
         { Common directives and conditionals }
         AddDirective('I',directive_all, @dir_include);
-        AddDirective('DEFINE',directive_all, @dir_define);
-        AddDirective('UNDEF',directive_all, @dir_undef);
+        AddDirective('DEFINE',directive_all, @dir_define,dkDefine);
+        AddDirective('UNDEF',directive_all, @dir_undef,dkUndef);
 
         AddConditional('IF',directive_all, @dir_if);
         AddConditional('IFDEF',directive_all, @dir_ifdef);
@@ -4355,8 +4370,8 @@
 
         { Directives and conditionals for mode macpas: }
         AddDirective('SETC',directive_mac, @dir_setc);
-        AddDirective('DEFINEC',directive_mac, @dir_definec);
-        AddDirective('UNDEFC',directive_mac, @dir_undef);
+        AddDirective('DEFINEC',directive_mac, @dir_definec,dkDefine);
+        AddDirective('UNDEFC',directive_mac, @dir_undef,dkUndef);
 
         AddConditional('IFC',directive_mac, @dir_if);
         AddConditional('ELSEC',directive_mac, @dir_else);
prep2.patch (12,177 bytes)   

Hans-Peter Diettrich

2010-09-30 08:51

reporter   ~0041375

I hope that the prep2.patch is acceptable to you. Here's what it does:

Preprocessor update, from Objects to Classes.

*conditionalize option -m properly
*added tscannerfile.Get_Directive, for general use
*added directive kind for $DEFINE/$UNDEF
*corrected tpreprocfile class and method references
*updated preprocessor module and scanner initialization and finalization

Issue History

Date Modified Username Field Change
2010-07-09 20:08 Hans-Peter Diettrich New Issue
2010-07-09 20:08 Hans-Peter Diettrich File Added: preprocessor.patch
2010-07-09 20:39 Jonas Maebe Note Added: 0039205
2010-07-12 01:15 Hans-Peter Diettrich Note Added: 0039274
2010-07-19 14:03 Jonas Maebe Note Added: 0039452
2010-07-19 14:37 Jonas Maebe Note Added: 0039459
2010-09-30 08:49 Hans-Peter Diettrich File Added: prep2.patch
2010-09-30 08:51 Hans-Peter Diettrich Note Added: 0041375