* preprocessor support. But it fails on the caret in type blocks

compiler/compiler.pas

@@ -285,7 +285,10 @@ begin
 {$endif TP}
 {$endif USEEXCEPT}
      starttime:=getrealtime;
-     parser.compile(inputdir+inputfile+inputextension,false);
+     if parapreprocess then
+      parser.preprocess(inputdir+inputfile+inputextension)
+     else
+      parser.compile(inputdir+inputfile+inputextension,false);
      if status.errorcount=0 then
       begin
         starttime:=getrealtime-starttime;
@@ -326,7 +329,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.40  1999-11-18 13:43:48  pierre
+  Revision 1.41  1999-12-02 17:34:34  peter
+    * preprocessor support. But it fails on the caret in type blocks
+
+  Revision 1.40  1999/11/18 13:43:48  pierre
    + IsExe global var needed for IDE
 
   Revision 1.39  1999/11/12 11:03:50  peter

compiler/globals.pas

@@ -94,6 +94,7 @@ unit globals;
        { things specified with parameters }
        paralinkoptions,
        paradynamiclinker : string;
+       parapreprocess    : boolean;
 
        { directory where the utils can be found (options -FD) }
        utilsdirectory : dirstr;
@@ -1357,7 +1358,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.36  1999-11-18 15:34:45  pierre
+  Revision 1.37  1999-12-02 17:34:34  peter
+    * preprocessor support. But it fails on the caret in type blocks
+
+  Revision 1.36  1999/11/18 15:34:45  pierre
     * Notes/Hints for local syms changed to
       Set_varstate function
 

compiler/options.pas

@@ -598,6 +598,7 @@ begin
                       DoWriteLogo:=true
                     else
                       IllegalPara(opt);
+              'm' : parapreprocess:=true;
               'n' : if More='' then
                      read_configfile:=false
                     else
@@ -1276,7 +1277,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.37  1999-11-20 01:22:19  pierre
+  Revision 1.38  1999-12-02 17:34:34  peter
+    * preprocessor support. But it fails on the caret in type blocks
+
+  Revision 1.37  1999/11/20 01:22:19  pierre
     + cond FPC_USE_CPREFIX (needs also some RTL changes)
       this allows to use unit global vars as DLL exports
       (the underline prefix seems needed by dlltool)

compiler/parser.pas

@@ -38,6 +38,7 @@ unit parser;
 
   interface
 
+    procedure preprocess(const filename:string);
     procedure compile(const filename:string;compile_system:boolean);
     procedure initparser;
     procedure doneparser;
@@ -148,6 +149,76 @@ unit parser;
       end;
 
 
+    procedure preprocess(const filename:string);
+      var
+        i : longint;
+      begin
+         new(preprocfile,init('pre'));
+       { default macros }
+         macros:=new(psymtable,init(macrosymtable));
+         macros^.name:=stringdup('Conditionals for '+filename);
+         default_macros;
+       { initialize a module }
+         current_module:=new(pmodule,init(filename,false));
+         main_module:=current_module;
+       { startup scanner, and save in current_module }
+         current_scanner:=new(pscannerfile,Init(filename));
+         current_module^.scanner:=current_scanner;
+       { loop until EOF is found }
+         repeat
+           current_scanner^.readtoken;
+           preprocfile^.AddSpace;
+           case token of
+             _ID :
+               begin
+                 preprocfile^.Add(orgpattern);
+               end;
+             _REALNUMBER,
+             _INTCONST :
+               preprocfile^.Add(pattern);
+             _CSTRING :
+               begin
+                 i:=0;
+                 while (i<length(pattern)) do
+                  begin
+                    inc(i);
+                    if pattern[i]='''' then
+                     begin
+                       insert('''',pattern,i);
+                       inc(i);
+                     end;
+                  end;
+                 preprocfile^.Add(''''+pattern+'''');
+               end;
+             _CCHAR :
+               begin
+                 case pattern[1] of
+                   #39 :
+                     pattern:='''''''';
+                   #0..#31,
+                   #128..#255 :
+                     begin
+                       str(ord(pattern[1]),pattern);
+                       pattern:='#'+pattern;
+                     end;
+                   else
+                     pattern:=''''+pattern[1]+'''';
+                 end;
+                 preprocfile^.Add(pattern);
+               end;
+             _EOF :
+               break;
+             else
+               preprocfile^.Add(tokeninfo^[token].str)
+           end;
+         until false;
+       { free scanner }
+         dispose(current_scanner,done);
+       { close }
+         dispose(preprocfile,done);
+      end;
+
+
     procedure compile(const filename:string;compile_system:boolean);
       var
        { scanner }
@@ -504,7 +575,10 @@ unit parser;
 end.
 {
   $Log$
-  Revision 1.93  1999-11-24 11:41:03  pierre
+  Revision 1.94  1999-12-02 17:34:34  peter
+    * preprocessor support. But it fails on the caret in type blocks
+
+  Revision 1.93  1999/11/24 11:41:03  pierre
    * defaultsymtablestack is now restored after parser.compile
 
   Revision 1.92  1999/11/18 15:34:46  pierre

compiler/scandir.inc

@@ -1100,6 +1100,16 @@ const
          current_scanner^.gettokenpos;
          current_scanner^.readchar; {Remove the $}
          hs:=current_scanner^.readid;
+         if parapreprocess then
+          begin
+            t:=Get_Directive(hs);
+            if not(is_conditional(t) or (t=_DIR_DEFINE) or (t=_DIR_UNDEF)) then
+             begin
+               preprocfile^.AddSpace;
+               preprocfile^.Add('{$'+hs+current_scanner^.readcomment+'}');
+               exit;
+             end;
+          end;
          Message1(scan_d_handling_switch,'$'+hs);
          if hs='' then
           Message1(scan_w_illegal_switch,'$'+hs);
@@ -1155,7 +1165,10 @@ const
 
 {
   $Log$
-  Revision 1.68  1999-11-24 11:39:53  pierre
+  Revision 1.69  1999-12-02 17:34:34  peter
+    * preprocessor support. But it fails on the caret in type blocks
+
+  Revision 1.68  1999/11/24 11:39:53  pierre
    * asmmode message was placed too early
 
   Revision 1.67  1999/11/12 11:03:50  peter

compiler/scanner.pas

@@ -37,8 +37,10 @@ unit scanner;
     const
 {$ifdef TP}
        maxmacrolen=1024;
+       preprocbufsize=1024;
 {$else}
        maxmacrolen=16*1024;
+       preprocbufsize=32*1024;
 {$endif}
        Newline = #10;
 
@@ -122,6 +124,19 @@ unit scanner;
           function  asmgetchar:char;
        end;
 
+       ppreprocfile=^tpreprocfile;
+       tpreprocfile=object
+         f   : text;
+         buf : pointer;
+         spacefound,
+         eolfound : boolean;
+         constructor init(const fn:string);
+         destructor  done;
+         procedure Add(const s:string);
+         procedure AddSpace;
+       end;
+
+
     var
         c              : char;
         orgpattern,
@@ -129,6 +144,9 @@ unit scanner;
         current_scanner : pscannerfile;
         aktcommentstyle : tcommentstyle; { needed to use read_comment from directives }
 
+        preprocfile : ppreprocfile; { used with only preprocessing }
+
+
 implementation
 
     uses
@@ -171,6 +189,56 @@ implementation
       end;
 
 
+{*****************************************************************************
+                            Preprocessor writting
+*****************************************************************************}
+
+    constructor tpreprocfile.init(const fn:string);
+      begin
+      { open outputfile }
+        assign(f,fn);
+        {$I-}
+         rewrite(f);
+        {$I+}
+        if ioresult<>0 then
+         Comment(V_Fatal,'can''t create file '+fn);
+        getmem(buf,preprocbufsize);
+        settextbuf(f,buf^,preprocbufsize);
+      { reset }
+        eolfound:=false;
+        spacefound:=false;
+      end;
+
+
+    destructor tpreprocfile.done;
+      begin
+        close(f);
+        freemem(buf,preprocbufsize);
+      end;
+
+
+    procedure tpreprocfile.add(const s:string);
+      begin
+        write(f,s);
+      end;
+
+    procedure tpreprocfile.addspace;
+      begin
+        if eolfound then
+         begin
+           writeln(f,'');
+           eolfound:=false;
+           spacefound:=false;
+         end
+        else
+         if spacefound then
+          begin
+            write(f,' ');
+            spacefound:=false;
+          end;
+      end;
+
+
 {*****************************************************************************
                               TPreProcStack
 *****************************************************************************}
@@ -815,9 +883,11 @@ implementation
            else
             inc(longint(inputpointer));
            case c of
-            #26 : reload;
+            #26 :
+              reload;
             #10,
-            #13 : linebreak;
+            #13 :
+              linebreak;
            end;
          end;
       end;
@@ -1075,7 +1145,16 @@ implementation
             '{' :
               skipcomment;
             ' ',#9..#13 :
-              skipspace;
+              begin
+                if parapreprocess then
+                 begin
+                   if c=#10 then
+                    preprocfile^.eolfound:=true
+                   else
+                    preprocfile^.spacefound:=true;
+                 end;
+                skipspace;
+              end
             else
               break;
           end;
@@ -1698,7 +1777,10 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.101  1999-11-15 17:52:59  pierre
+  Revision 1.102  1999-12-02 17:34:34  peter
+    * preprocessor support. But it fails on the caret in type blocks
+
+  Revision 1.101  1999/11/15 17:52:59  pierre
     + one field added for ttoken record for operator
       linking the id to the corresponding operator token that
       can now now all be overloaded