* rework of macro subsystem

  + exportable macros for mode macpas

compiler/compiler.pas

@@ -310,7 +310,7 @@ begin
   do_initSymbolInfo;
 {$endif BrowserCol}
   inittokens;
-  InitSymtable;
+  InitSymtable; {Must come before read_arguments, to enable macrosymstack}
   CompilerInited:=true;
 { this is needed here for the IDE
   in case of compilation failure
@@ -448,7 +448,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.50  2004-11-22 19:34:58  peter
+  Revision 1.51  2005-01-09 20:24:43  olle
+    * rework of macro subsystem
+    + exportable macros for mode macpas
+
+  Revision 1.50  2004/11/22 19:34:58  peter
     * GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
 
   Revision 1.49  2004/10/15 09:14:16  mazen

compiler/fmodule.pas

@@ -95,6 +95,7 @@ interface
         is_unit,
         in_interface,             { processing the implementation part? }
         in_global     : boolean;  { allow global settings }
+        mode_switch_allowed  : boolean;  { Whether a mode switch is still allowed at this point in the parsing.}
         mainfilepos   : tfileposinfo;
         recompile_reason : trecompile_reason;  { the reason why the unit should be recompiled }
         crc,
@@ -107,6 +108,8 @@ interface
         derefdata     : tdynamicarray;
         globalsymtable,           { pointer to the global symtable of this unit }
         localsymtable : tsymtable;{ pointer to the local symtable of this unit }
+        globalmacrosymtable,           { pointer to the global macro symtable of this unit }
+        localmacrosymtable : tsymtable;{ pointer to the local macro symtable of this unit }
         scanner       : pointer;  { scanner object used }
         procinfo      : pointer;  { current procedure being compiled }
         loaded_from   : tmodule;
@@ -396,6 +399,8 @@ implementation
         derefdataintflen:=0;
         globalsymtable:=nil;
         localsymtable:=nil;
+        globalmacrosymtable:=nil;
+        localmacrosymtable:=nil;
         loaded_from:=LoadedFrom;
         do_reload:=false;
         do_compile:=false;
@@ -410,6 +415,7 @@ implementation
         islibrary:=false;
         is_stab_written:=false;
         is_reset:=false;
+        mode_switch_allowed:= true;
         uses_imports:=false;
         imports:=TLinkedList.Create;
         _exports:=TLinkedList.Create;
@@ -484,6 +490,10 @@ implementation
           globalsymtable.free;
         if assigned(localsymtable) then
           localsymtable.free;
+        if assigned(globalmacrosymtable) then
+          globalmacrosymtable.free;
+        if assigned(localmacrosymtable) then
+          localmacrosymtable.free;
 {$ifdef MEMDEBUG}
         d.free;
 {$endif}
@@ -534,6 +544,16 @@ implementation
             localsymtable.free;
             localsymtable:=nil;
           end;
+        if assigned(globalmacrosymtable) then
+          begin
+            globalmacrosymtable.free;
+            globalmacrosymtable:=nil;
+          end;
+        if assigned(localmacrosymtable) then
+          begin
+            localmacrosymtable.free;
+            localmacrosymtable:=nil;
+          end;
         derefdata.free;
         derefdata:=TDynamicArray.Create(1024);
         if assigned(map) then
@@ -577,6 +597,7 @@ implementation
         interface_compiled:=false;
         in_interface:=true;
         in_global:=true;
+        mode_switch_allowed:=true;
         is_stab_written:=false;
         is_reset:=false;
         crc:=0;
@@ -711,7 +732,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.50  2004-12-28 20:43:01  hajny
+  Revision 1.51  2005-01-09 20:24:43  olle
+    * rework of macro subsystem
+    + exportable macros for mode macpas
+
+  Revision 1.50  2004/12/28 20:43:01  hajny
     * 8.3 fixes (short target name in paths)
 
   Revision 1.49  2004/11/04 23:59:13  peter

compiler/fppu.pas

@@ -64,20 +64,22 @@ interface
           procedure load_implementation;
           procedure load_symtable_refs;
           procedure load_usedunits;
-          procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
-          procedure writeusedmacros;
           procedure writesourcefiles;
           procedure writeusedunit(intf:boolean);
           procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
           procedure writederefdata;
           procedure putasmsymbol_in_idx(s:tnamedindexitem;arg:pointer);
           procedure writeasmsymbols;
-          procedure readusedmacros;
           procedure readsourcefiles;
           procedure readloadunit;
           procedure readlinkcontainer(var p:tlinkcontainer);
           procedure readderefdata;
           procedure readasmsymbols;
+{$IFDEF MACRO_DIFF_HINT}
+          procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
+          procedure writeusedmacros;
+          procedure readusedmacros;
+{$ENDIF}
        end;
 
     procedure reload_flagged_units;
@@ -88,7 +90,7 @@ implementation
 
 uses
   verbose,systems,version,
-  symtable,
+  symtable, symsym,
   scanner,
   aasmbase,
   parser;
@@ -398,25 +400,33 @@ uses
     PPU Reading/Writing Helpers
 ***********************************}
 
+{$IFDEF MACRO_DIFF_HINT}
+    var
+      is_initial: Boolean;
+
     procedure tppumodule.writeusedmacro(p:TNamedIndexItem;arg:pointer);
       begin
-        if tmacro(p).is_used or tmacro(p).defined_at_startup then
+        if tmacro(p).is_used or is_initial then
           begin
             ppufile.putstring(p.name);
-            ppufile.putbyte(byte(tmacro(p).defined_at_startup));
+            ppufile.putbyte(byte(is_initial));
             ppufile.putbyte(byte(tmacro(p).is_used));
           end;
       end;
 
-
     procedure tppumodule.writeusedmacros;
       begin
         ppufile.do_crc:=false;
-        tscannerfile(scanner).macros.foreach(@writeusedmacro,nil);
+        is_initial:= true;
+        initialmacrosymtable.foreach(@writeusedmacro,nil);
+        is_initial:= false;
+        if assigned(globalmacrosymtable) then
+          globalmacrosymtable.foreach(@writeusedmacro,nil);
+        localmacrosymtable.foreach(@writeusedmacro,nil);
         ppufile.writeentry(ibusedmacros);
         ppufile.do_crc:=true;
       end;
-
+{$ENDIF}
 
     procedure tppumodule.writesourcefiles;
       var
@@ -588,41 +598,55 @@ uses
         ppufile.writeentry(ibasmsymbols);
       end;
 
+{$IFDEF MACRO_DIFF_HINT}
 
+{
+  Define MACRO_DIFF_HINT for the whole compiler (and ppudump)
+  to turn this facility on. There is some problems with this,
+  thats why it is shut off:
+  
+  At the first compilation, consider a macro which is not initially
+  defined, but it is used (e g the check that it is undefined is true).
+  Since it do not exist, there is no macro object where the is_used 
+  flag can be set. Later on when the macro is defined, and the ppu
+  is opened, the check cannot detect this.
+  
+  Also, in which macro object should this flag be set ? It cant be set
+  for macros in the initialmacrosymboltable since this table is shared
+  between different files.
+}
+  
     procedure tppumodule.readusedmacros;
       var
         hs : string;
         mac : tmacro;
-        was_defined_at_startup,
+        was_initial,
         was_used : boolean;
+      {Reads macros which was defined or used when the module was compiled.
+       This is done when a ppu file is open, before it possibly is parsed.}
       begin
-        { only possible when we've a scanner of the current file }
-        if not assigned(current_scanner) then
-         exit;
         while not ppufile.endofentry do
          begin
            hs:=ppufile.getstring;
-           was_defined_at_startup:=boolean(ppufile.getbyte);
+           was_initial:=boolean(ppufile.getbyte);
            was_used:=boolean(ppufile.getbyte);
-           mac:=tmacro(tscannerfile(current_scanner).macros.search(hs));
+           mac:=tmacro(initialmacrosymtable.search(hs));
            if assigned(mac) then
              begin
 {$ifndef EXTDEBUG}
            { if we don't have the sources why tell }
               if sources_avail then
 {$endif ndef EXTDEBUG}
-               if (not was_defined_at_startup) and
-                  was_used and
-                  mac.defined_at_startup then
+               if (not was_initial) and was_used then
                 Message2(unit_h_cond_not_set_in_last_compile,hs,mainsource^);
              end
            else { not assigned }
-             if was_defined_at_startup and
+             if was_initial and
                 was_used then
               Message2(unit_h_cond_set_in_last_compile,hs,mainsource^);
          end;
       end;
-
+{$ENDIF}
 
     procedure tppumodule.readsourcefiles;
       var
@@ -854,8 +878,10 @@ uses
                end;
              ibsourcefiles :
                readsourcefiles;
+{$IFDEF MACRO_DIFF_HINT}
              ibusedmacros :
                readusedmacros;
+{$ENDIF}
              ibloadunit :
                readloadunit;
              iblinkunitofiles :
@@ -962,7 +988,9 @@ uses
          ppufile.writeentry(ibmodulename);
 
          writesourcefiles;
+{$IFDEF MACRO_DIFF_HINT}
          writeusedmacros;
+{$ENDIF}
 
          { write interface uses }
          writeusedunit(true);
@@ -1000,6 +1028,18 @@ uses
          { write the symtable entries }
          tstoredsymtable(globalsymtable).ppuwrite(ppufile);
 
+         if assigned(globalmacrosymtable) and (globalmacrosymtable.symindex.count > 0) then
+           begin
+             ppufile.putbyte(byte(true));
+             ppufile.writeentry(ibexportedmacros);
+             tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);           
+           end
+         else
+           begin
+             ppufile.putbyte(byte(false));
+             ppufile.writeentry(ibexportedmacros);
+           end;
+
          { everything after this doesn't affect the crc }
          ppufile.do_crc:=false;
 
@@ -1095,6 +1135,18 @@ uses
          { write the symtable entries }
          tstoredsymtable(globalsymtable).ppuwrite(ppufile);
 
+         if assigned(globalmacrosymtable) and (globalmacrosymtable.symindex.count > 0) then
+           begin
+             ppufile.putbyte(byte(true));
+             ppufile.writeentry(ibexportedmacros);
+             tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);           
+           end
+         else
+           begin
+             ppufile.putbyte(byte(false));
+             ppufile.writeentry(ibexportedmacros);
+           end;
+
          { save crc  }
          crc:=ppufile.crc;
          interface_crc:=ppufile.interface_crc;
@@ -1180,6 +1232,15 @@ uses
          internalerror(200208187);
         globalsymtable:=tglobalsymtable.create(modulename^);
         tstoredsymtable(globalsymtable).ppuload(ppufile);
+    
+        if ppufile.readentry<>ibexportedmacros then
+          Message(unit_f_ppu_read_error);
+        if boolean(ppufile.getbyte) then
+          begin
+            globalmacrosymtable:=tmacrosymtable.Create(true);
+            tstoredsymtable(globalmacrosymtable).ppuload(ppufile)
+          end;
+
         interface_compiled:=true;
 
         { read the implementation part, containing
@@ -1512,7 +1573,11 @@ uses
 end.
 {
   $Log$
-  Revision 1.63  2004-10-15 09:14:16  mazen
+  Revision 1.64  2005-01-09 20:24:43  olle
+    * rework of macro subsystem
+    + exportable macros for mode macpas
+
+  Revision 1.63  2004/10/15 09:14:16  mazen
   - remove $IFDEF DELPHI and related code
   - remove $IFDEF FPCPROCVAR and related code
 

compiler/globals.pas

@@ -187,7 +187,6 @@ interface
        aktexceptblock        : integer;  { the exceptblock number of the current block (0 if none) }
 
      { commandline values }
-       initdefines        : tstringlist;
        initglobalswitches : tglobalswitches;
        initmoduleswitches : tmoduleswitches;
        initlocalswitches  : tlocalswitches;
@@ -2041,7 +2040,6 @@ end;
 
    procedure DoneGlobals;
      begin
-       initdefines.free;
        if assigned(DLLImageBase) then
          StringDispose(DLLImageBase);
        librarysearchpath.Free;
@@ -2168,7 +2166,6 @@ end;
 {$endif x86_64}
         initinterfacetype:=it_interfacecom;
         initdefproccall:=pocall_default;
-        initdefines:=TStringList.Create;
 
       { memory sizes, will be overriden by parameter or default for target
         in options or init_parser }
@@ -2180,7 +2177,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.159  2005-01-06 13:40:41  florian
+  Revision 1.160  2005-01-09 20:24:43  olle
+    * rework of macro subsystem
+    + exportable macros for mode macpas
+
+  Revision 1.159  2005/01/06 13:40:41  florian
     * 1.0.10 starting patch from Peter
 
   Revision 1.158  2005/01/06 09:20:36  karoly

compiler/msg/errore.msg

@@ -303,6 +303,9 @@ scan_e_error_macro_lacks_value=02065_E_Macro "$1" does not have any value
 % Thus the conditional compiling expression cannot be evaluated.
 scan_e_wrong_switch_toggle_default=02066_E_Wrong switch toggle, use ON/OFF/DEFAULT or +/-/*
 % You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch
+scan_e_mode_switch_not_allowed=02067_E_Mode switch "$1" not allowed here
+% A mode switch has already been encountered, or, in case of option -Mmacpas,
+% a mode switch occur after UNIT.
 % \end{description}
 #
 # Parser
@@ -2076,8 +2079,6 @@ option_interpreting_firstpass_option=11036_D_interpreting firstpass option "$1"
 option_interpreting_file_option=11033_D_interpreting file option "$1"
 option_read_config_file=11034_D_Reading config file "$1"
 option_found_file=11035_D_found source file name "$1"
-option_defining_symbol=11037_D_Defining symbol $1
-option_undefining_symbol=11038_D_Undefining symbol $1
 % Additional infos about options, displayed
 % when you have debug option turned on.
 option_code_page_not_available=11039_E_Unknown code page

compiler/msgidx.inc

@@ -81,6 +81,7 @@ const
   scan_e_too_many_pop=02064;
   scan_e_error_macro_lacks_value=02065;
   scan_e_wrong_switch_toggle_default=02066;
+  scan_e_mode_switch_not_allowed=02067;
   parser_e_syntax_error=03000;
   parser_e_dont_nest_interrupt=03004;
   parser_w_proc_directive_ignored=03005;
@@ -644,16 +645,14 @@ const
   option_interpreting_file_option=11033;
   option_read_config_file=11034;
   option_found_file=11035;
-  option_defining_symbol=11037;
-  option_undefining_symbol=11038;
   option_code_page_not_available=11039;
   option_logo=11023;
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 37959;
+  MsgTxtSize = 37945;
 
   MsgIdxMax : array[1..20] of longint=(
-    18,67,213,59,57,46,100,20,35,60,
+    18,68,213,59,57,46,100,20,35,60,
     40,1,1,1,1,1,1,1,1,1
   );

compiler/options.pas

@@ -33,7 +33,7 @@ type
   TOption=class
     FirstPass,
     NoPressEnter,
-    DoWriteLogo : boolean;
+    LogoWritten : boolean;
     FileLevel : longint;
     QuickInfo : string;
     ParaIncludePath,
@@ -76,7 +76,8 @@ uses
   dos,
 {$ENDIF USE_SYSUTILS}
   version,
-  cutils,cmsgs
+  cutils,cmsgs,
+  symtable
 {$ifdef BrowserLog}
   ,browlog
 {$endif BrowserLog}
@@ -100,47 +101,23 @@ var
                                  Defines
 ****************************************************************************}
 
-procedure def_symbol(const s : string);
-begin
-  if s='' then
-   exit;
-  initdefines.insert(upper(s));
-  Message1(option_defining_symbol,s);
-end;
-
-
-procedure undef_symbol(const s : string);
-begin
-  if s='' then
-   exit;
-  InitDefines.Remove(s);
-  Message1(option_undefining_symbol,s);
-end;
-
-
-function check_symbol(const s:string):boolean;
-begin
-  check_symbol:=(initdefines.find(s)<>nil);
-end;
-
-
 procedure set_default_link_type;
 begin
   { win32 and wdosx need smartlinking by default to prevent including too much
     dll dependencies }
   if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
     begin
-      def_symbol('FPC_LINK_SMART');
-      undef_symbol('FPC_LINK_STATIC');
-      undef_symbol('FPC_LINK_DYNAMIC');
+      def_system_macro('FPC_LINK_SMART');
+      undef_system_macro('FPC_LINK_STATIC');
+      undef_system_macro('FPC_LINK_DYNAMIC');
       initglobalswitches:=initglobalswitches+[cs_link_smart];
       initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_static];
     end
   else
     begin
-      undef_symbol('FPC_LINK_SMART');
-      def_symbol('FPC_LINK_STATIC');
-      undef_symbol('FPC_LINK_DYNAMIC');
+      undef_system_macro('FPC_LINK_SMART');
+      def_system_macro('FPC_LINK_STATIC');
+      undef_system_macro('FPC_LINK_DYNAMIC');
       initglobalswitches:=initglobalswitches+[cs_link_static];
       initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_smart];
     end;
@@ -168,9 +145,13 @@ procedure Toption.WriteLogo;
 var
   p : pchar;
 begin
-  p:=MessagePchar(option_logo);
-  while assigned(p) do
-   Comment(V_Normal,GetMsgLine(p));
+  if not LogoWritten then
+    begin
+      p:=MessagePchar(option_logo);
+      while assigned(p) do
+        Comment(V_Normal,GetMsgLine(p));
+      LogoWritten:= true;
+    end;
 end;
 
 
@@ -384,9 +365,9 @@ begin
   if opt='' then
    exit;
 
-  { only parse define,undef,target,verbosity and link options the firsttime }
+  { only parse define,undef,target,verbosity,link etc options the firsttime }
   if firstpass and
-     not((opt[1]='-') and (opt[2] in ['i','d','v','T','u','n','X'])) then
+     not((opt[1]='-') and (opt[2] in ['i','d','v','T','u','n','X','l'])) then
    exit;
 
   Message1(option_handling_option,opt);
@@ -587,7 +568,8 @@ begin
              end;
 
            'd' :
-             def_symbol(more);
+             if more <> '' then
+               def_system_macro(more);
 
            'D' :
              begin
@@ -834,7 +816,8 @@ begin
              end;
 
            'l' :
-             DoWriteLogo:=not UnSetBool(more,0);
+             if not UnSetBool(more,0) then
+               WriteLogo;
 
            'm' :
              parapreprocess:=not UnSetBool(more,0);
@@ -874,7 +857,7 @@ begin
                if UnsetBool(More, 0) then
                  begin
                    initmoduleswitches:=initmoduleswitches-[cs_profile];
-                   undef_symbol('FPC_PROFILE');
+                   undef_system_macro('FPC_PROFILE');
                  end
                else
                  if Length(More)=0 then
@@ -884,12 +867,12 @@ begin
                   'g' : if UnsetBool(more, 1) then
                          begin
                            exclude(initmoduleswitches,cs_profile);
-                           undef_symbol('FPC_PROFILE');
+                           undef_system_macro('FPC_PROFILE');
                          end
                         else
                          begin
                            include(initmoduleswitches,cs_profile);
-                           def_symbol('FPC_PROFILE');
+                           def_system_macro('FPC_PROFILE');
                         end;
                  else
                    IllegalPara(opt);
@@ -1008,8 +991,8 @@ begin
              end;
 
            'u' :
-             undef_symbol(upper(More));
-
+             if more <> '' then
+               undef_system_macro(more);
            'U' :
              begin
                j:=1;
@@ -1148,9 +1131,9 @@ begin
                       include(initglobalswitches,cs_link_staticflag);
                     'D' :
                       begin
-                        def_symbol('FPC_LINK_DYNAMIC');
-                        undef_symbol('FPC_LINK_SMART');
-                        undef_symbol('FPC_LINK_STATIC');
+                        def_system_macro('FPC_LINK_DYNAMIC');
+                        undef_system_macro('FPC_LINK_SMART');
+                        undef_system_macro('FPC_LINK_STATIC');
                         exclude(initglobalswitches,cs_link_static);
                         exclude(initglobalswitches,cs_link_smart);
                         include(initglobalswitches,cs_link_shared);
@@ -1167,9 +1150,9 @@ begin
                           end;
                     'S' :
                       begin
-                        def_symbol('FPC_LINK_STATIC');
-                        undef_symbol('FPC_LINK_SMART');
-                        undef_symbol('FPC_LINK_DYNAMIC');
+                        def_system_macro('FPC_LINK_STATIC');
+                        undef_system_macro('FPC_LINK_SMART');
+                        undef_system_macro('FPC_LINK_DYNAMIC');
                         include(initglobalswitches,cs_link_static);
                         exclude(initglobalswitches,cs_link_smart);
                         exclude(initglobalswitches,cs_link_shared);
@@ -1177,9 +1160,9 @@ begin
                       end;
                     'X' :
                       begin
-                        def_symbol('FPC_LINK_SMART');
-                        undef_symbol('FPC_LINK_STATIC');
-                        undef_symbol('FPC_LINK_DYNAMIC');
+                        def_system_macro('FPC_LINK_SMART');
+                        undef_system_macro('FPC_LINK_STATIC');
+                        undef_system_macro('FPC_LINK_DYNAMIC');
                         exclude(initglobalswitches,cs_link_static);
                         include(initglobalswitches,cs_link_smart);
                         exclude(initglobalswitches,cs_link_shared);
@@ -1253,7 +1236,7 @@ const
   maxlevel=16;
 var
   f     : text;
-  s,
+  s, tmp,
   opts  : string;
   skip  : array[0..maxlevel-1] of boolean;
   level : longint;
@@ -1294,7 +1277,7 @@ begin
               RemoveSep(opts);
               s:=upper(GetName(opts));
               if level=0 then
-               skip[level]:=not (check_symbol(s) or (s='COMMON'));
+               skip[level]:=not (assigned(search_macro(s)) or (s='COMMON'));
             end
            else
             if (s='IFDEF') then
@@ -1306,7 +1289,7 @@ begin
                   stopOptions(1);
                 end;
                inc(Level);
-               skip[level]:=(skip[level-1] or (not check_symbol(upper(GetName(opts)))));
+               skip[level]:=(skip[level-1] or not assigned(search_macro(upper(GetName(opts)))));
              end
            else
             if (s='IFNDEF') then
@@ -1318,7 +1301,7 @@ begin
                   stopOptions(1);
                 end;
                inc(Level);
-               skip[level]:=(skip[level-1] or (check_symbol(upper(GetName(opts)))));
+               skip[level]:=(skip[level-1] or assigned(search_macro(upper(GetName(opts)))));
              end
            else
             if (s='ELSE') then
@@ -1340,13 +1323,17 @@ begin
                if (s='DEFINE') then
                 begin
                   RemoveSep(opts);
-                  def_symbol(upper(GetName(opts)));
+                  tmp:= GetName(opts);
+                  if tmp <> '' then
+                    def_system_macro(tmp);
                 end
               else
                if (s='UNDEF') then
                 begin
                   RemoveSep(opts);
-                  undef_symbol(upper(GetName(opts)));
+                  tmp:= GetName(opts);
+                  if tmp <> '' then
+                    undef_system_macro(tmp);
                 end
               else
                if (s='WRITE') then
@@ -1587,9 +1574,9 @@ var
   i : integer;
 begin
   if def then
-   def_symbol(upper(target_info.shortname))
+   def_system_macro(target_info.shortname)
   else
-   undef_symbol(upper(target_info.shortname));
+   undef_system_macro(target_info.shortname);
   s:=target_info.extradefines;
   while (s<>'') do
    begin
@@ -1597,9 +1584,9 @@ begin
      if i=0 then
       i:=length(s)+1;
      if def then
-      def_symbol(Copy(s,1,i-1))
+      def_system_macro(Copy(s,1,i-1))
      else
-      undef_symbol(Copy(s,1,i-1));
+      undef_system_macro(Copy(s,1,i-1));
      delete(s,1,i);
    end;
 end;
@@ -1607,7 +1594,7 @@ end;
 
 constructor TOption.create;
 begin
-  DoWriteLogo:=false;
+  LogoWritten:=false;
   NoPressEnter:=false;
   FirstPass:=false;
   FileLevel:=0;
@@ -1697,178 +1684,178 @@ begin
   option:=coption.create;
   disable_configfile:=false;
 
+{ get default messagefile }
+{$IFDEF USE_SYSUTILS}
+  msgfilename:=GetEnvironmentVariable('PPC_ERROR_FILE');
+{$ELSE USE_SYSUTILS}
+  msgfilename:=dos.getenv('PPC_ERROR_FILE');
+{$ENDIF USE_SYSUTILS}
+
+{ default configfile can be specified on the commandline,
+   remove it first }
+  if (cmd<>'') and (cmd[1]='[') then
+    begin
+      ppccfg:=Copy(cmd,2,pos(']',cmd)-2);
+      Delete(cmd,1,pos(']',cmd));
+    end
+  else
+    begin
+      ppccfg:='fpc.cfg';
+      ppcaltcfg:='ppc386.cfg';
+    end;
+
+{ first pass reading of parameters, only -i -v -T etc.}
+  option.firstpass:=true;
+  if cmd<>'' then
+    option.parsecmd(cmd)
+  else
+    begin
+      option.read_parameters;
+      { Write only quickinfo }
+      if option.quickinfo<>'' then
+        option.writequickinfo;
+    end;
+  option.firstpass:=false;
+
 { default defines }
-  def_symbol(upper(target_info.shortname));
-  def_symbol('FPC');
-  def_symbol('VER'+version_nr);
-  def_symbol('VER'+version_nr+'_'+release_nr);
-  def_symbol('VER'+version_nr+'_'+release_nr+'_'+patch_nr);
+  def_system_macro(target_info.shortname);
+  def_system_macro('FPC');
+  def_system_macro('VER'+version_nr);
+  def_system_macro('VER'+version_nr+'_'+release_nr);
+  def_system_macro('VER'+version_nr+'_'+release_nr+'_'+patch_nr);
 
 { Temporary defines, until things settle down }
-  def_symbol('HASWIDECHAR');
-  def_symbol('HASWIDESTRING');
-  def_symbol('HASOUT');
-  def_symbol('HASGLOBALPROPERTY');
-  def_symbol('FPC_HASPREFETCH');
-  def_symbol('FPC_LINEEND_IN_TEXTREC');
-  def_symbol('FPC_ALIGNSRTTI');
+  def_system_macro('HASWIDECHAR');
+  def_system_macro('HASWIDESTRING');
+  def_system_macro('HASOUT');
+  def_system_macro('HASGLOBALPROPERTY');
+  def_system_macro('FPC_HASPREFETCH');
+  def_system_macro('FPC_LINEEND_IN_TEXTREC');
+  def_system_macro('FPC_ALIGNSRTTI');
 {$ifdef i386}
-  def_symbol('HASINTF');
-  def_symbol('HASVARIANT');
+  def_system_macro('HASINTF');
+  def_system_macro('HASVARIANT');
 {$endif i386}
 {$ifdef x86_64}
-  def_symbol('HASINTF');
-  def_symbol('HASVARIANT');
+  def_system_macro('HASINTF');
+  def_system_macro('HASVARIANT');
 {$endif x86_64}
 {$ifdef powerpc}
-  def_symbol('HASINTF');
-  def_symbol('HASVARIANT');
-  def_symbol('FPC_MTFSB0_CORRECTED');
+  def_system_macro('HASINTF');
+  def_system_macro('HASVARIANT');
+  def_system_macro('FPC_MTFSB0_CORRECTED');
 {$endif powerpc}
 {$ifdef arm}
-  def_symbol('HASINTF');
-  def_symbol('HASVARIANT');
+  def_system_macro('HASINTF');
+  def_system_macro('HASVARIANT');
 {$endif arm}
 {$ifdef sparc}
-  def_symbol('HASINTF');
-  def_symbol('HASVARIANT');
+  def_system_macro('HASINTF');
+  def_system_macro('HASVARIANT');
 {$endif sparc}
-  def_symbol('INTERNSETLENGTH');
-  def_symbol('INTERNLENGTH');
-  def_symbol('INTERNCOPY');
-  def_symbol('INT64FUNCRESOK');
-  def_symbol('HAS_ADDR_STACK_ON_STACK');
-  def_symbol('NOBOUNDCHECK');
-  def_symbol('HASCOMPILERPROC');
-  def_symbol('INTERNCONSTINTF');
-  def_symbol('VALUEGETMEM');
-  def_symbol('VALUEFREEMEM');
-  def_symbol('HASCURRENCY');
-  def_symbol('HASTHREADVAR');
-  def_symbol('HAS_GENERICCONSTRUCTOR');
-  def_symbol('NOCLASSHELPERS');
+  def_system_macro('INTERNSETLENGTH');
+  def_system_macro('INTERNLENGTH');
+  def_system_macro('INTERNCOPY');
+  def_system_macro('INT64FUNCRESOK');
+  def_system_macro('HAS_ADDR_STACK_ON_STACK');
+  def_system_macro('NOBOUNDCHECK');
+  def_system_macro('HASCOMPILERPROC');
+  def_system_macro('INTERNCONSTINTF');
+  def_system_macro('VALUEGETMEM');
+  def_system_macro('VALUEFREEMEM');
+  def_system_macro('HASCURRENCY');
+  def_system_macro('HASTHREADVAR');
+  def_system_macro('HAS_GENERICCONSTRUCTOR');
+  def_system_macro('NOCLASSHELPERS');
   if pocall_default = pocall_register then
-    def_symbol('REGCALL');
-  def_symbol('DECRREFNOTNIL');
-  def_symbol('HAS_INTERNAL_INTTYPES');
-  def_symbol('STR_USES_VALINT');
-  def_symbol('NOSAVEREGISTERS');
-  def_symbol('SHORTSTRCOMPAREINREG');
-  def_symbol('HASGETHEAPSTATUS');
+    def_system_macro('REGCALL');
+  def_system_macro('DECRREFNOTNIL');
+  def_system_macro('HAS_INTERNAL_INTTYPES');
+  def_system_macro('STR_USES_VALINT');
+  def_system_macro('NOSAVEREGISTERS');
+  def_system_macro('SHORTSTRCOMPAREINREG');
+  def_system_macro('HASGETHEAPSTATUS');
 
 { using a case is pretty useless here (FK) }
 { some stuff for TP compatibility }
 {$ifdef i386}
-  def_symbol('CPU86');
-  def_symbol('CPU87');
+  def_system_macro('CPU86');
+  def_system_macro('CPU87');
 {$endif}
 {$ifdef m68k}
-  def_symbol('CPU68');
+  def_system_macro('CPU68');
 {$endif}
 
 { new processor stuff }
 {$ifdef i386}
-  def_symbol('CPUI386');
-  def_symbol('CPU32');
-  def_symbol('FPC_HAS_TYPE_EXTENDED');
-  def_symbol('FPC_HAS_TYPE_DOUBLE');
-  def_symbol('FPC_HAS_TYPE_SINGLE');
+  def_system_macro('CPUI386');
+  def_system_macro('CPU32');
+  def_system_macro('FPC_HAS_TYPE_EXTENDED');
+  def_system_macro('FPC_HAS_TYPE_DOUBLE');
+  def_system_macro('FPC_HAS_TYPE_SINGLE');
 {$endif}
 {$ifdef m68k}
-  def_symbol('CPU68K');
-  def_symbol('CPUM68K');
-  def_symbol('CPU32');
-  def_symbol('FPC_CURRENCY_IS_INT64');
-  def_symbol('FPC_COMP_IS_INT64');
+  def_system_macro('CPU68K');
+  def_system_macro('CPUM68K');
+  def_system_macro('CPU32');
+  def_system_macro('FPC_CURRENCY_IS_INT64');
+  def_system_macro('FPC_COMP_IS_INT64');
 {$endif}
 {$ifdef ALPHA}
-  def_symbol('CPUALPHA');
-  def_symbol('CPU64');
+  def_system_macro('CPUALPHA');
+  def_system_macro('CPU64');
 {$endif}
 {$ifdef powerpc}
-  def_symbol('CPUPOWERPC');
-  def_symbol('CPUPOWERPC32');
-  def_symbol('CPU32');
-  def_symbol('FPC_HAS_TYPE_DOUBLE');
-  def_symbol('FPC_HAS_TYPE_SINGLE');
-  def_symbol('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
-  def_symbol('FPC_CURRENCY_IS_INT64');
-  def_symbol('FPC_COMP_IS_INT64');
+  def_system_macro('CPUPOWERPC');
+  def_system_macro('CPUPOWERPC32');
+  def_system_macro('CPU32');
+  def_system_macro('FPC_HAS_TYPE_DOUBLE');
+  def_system_macro('FPC_HAS_TYPE_SINGLE');
+  def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
+  def_system_macro('FPC_CURRENCY_IS_INT64');
+  def_system_macro('FPC_COMP_IS_INT64');
 {$endif}
 {$ifdef iA64}
-  def_symbol('CPUIA64');
-  def_symbol('CPU64');
+  def_system_macro('CPUIA64');
+  def_system_macro('CPU64');
 {$endif}
 {$ifdef x86_64}
-  def_symbol('CPUX86_64');
-  def_symbol('CPUAMD64');
-  def_symbol('CPU64');
+  def_system_macro('CPUX86_64');
+  def_system_macro('CPUAMD64');
+  def_system_macro('CPU64');
   { not supported for now, afaik (FK)
-   def_symbol('FPC_HAS_TYPE_FLOAT128'); }
-  def_symbol('FPC_HAS_TYPE_EXTENDED');
-  def_symbol('FPC_HAS_TYPE_DOUBLE');
-  def_symbol('FPC_HAS_TYPE_SINGLE');
+   def_system_macro('FPC_HAS_TYPE_FLOAT128'); }
+  def_system_macro('FPC_HAS_TYPE_EXTENDED');
+  def_system_macro('FPC_HAS_TYPE_DOUBLE');
+  def_system_macro('FPC_HAS_TYPE_SINGLE');
 {$endif}
 {$ifdef sparc}
-  def_symbol('CPUSPARC');
-  def_symbol('CPUSPARC32');
-  def_symbol('CPU32');
-  def_symbol('FPC_HAS_TYPE_DOUBLE');
-  def_symbol('FPC_HAS_TYPE_SINGLE');
-  def_symbol('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
-  def_symbol('FPC_CURRENCY_IS_INT64');
-  def_symbol('FPC_COMP_IS_INT64');
-  def_symbol('FPC_REQUIRES_PROPER_ALIGNMENT');
+  def_system_macro('CPUSPARC');
+  def_system_macro('CPUSPARC32');
+  def_system_macro('CPU32');
+  def_system_macro('FPC_HAS_TYPE_DOUBLE');
+  def_system_macro('FPC_HAS_TYPE_SINGLE');
+  def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
+  def_system_macro('FPC_CURRENCY_IS_INT64');
+  def_system_macro('FPC_COMP_IS_INT64');
+  def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
 {$endif}
 {$ifdef vis}
-  def_symbol('CPUVIS');
-  def_symbol('CPU32');
+  def_system_macro('CPUVIS');
+  def_system_macro('CPU32');
 {$endif}
 {$ifdef arm}
-  def_symbol('CPUARM');
-  def_symbol('FPUFPA');
-  def_symbol('CPU32');
-  def_symbol('FPC_HAS_TYPE_DOUBLE');
-  def_symbol('FPC_HAS_TYPE_SINGLE');
-  def_symbol('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
-  def_symbol('FPC_CURRENCY_IS_INT64');
-  def_symbol('FPC_COMP_IS_INT64');
-  def_symbol('FPC_REQUIRES_PROPER_ALIGNMENT');
+  def_system_macro('CPUARM');
+  def_system_macro('FPUFPA');
+  def_system_macro('CPU32');
+  def_system_macro('FPC_HAS_TYPE_DOUBLE');
+  def_system_macro('FPC_HAS_TYPE_SINGLE');
+  def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
+  def_system_macro('FPC_CURRENCY_IS_INT64');
+  def_system_macro('FPC_COMP_IS_INT64');
+  def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
 {$endif arm}
 
-{ get default messagefile }
-{$IFDEF USE_SYSUTILS}
-  msgfilename:=GetEnvironmentVariable('PPC_ERROR_FILE');
-{$ELSE USE_SYSUTILS}
-  msgfilename:=dos.getenv('PPC_ERROR_FILE');
-{$ENDIF USE_SYSUTILS}
-
-   { default configfile can be specified on the commandline,
-     remove it first }
-   if (cmd<>'') and (cmd[1]='[') then
-    begin
-      ppccfg:=Copy(cmd,2,pos(']',cmd)-2);
-      Delete(cmd,1,pos(']',cmd));
-    end
-   else
-    begin
-      ppccfg:='fpc.cfg';
-      ppcaltcfg:='ppc386.cfg';
-    end;
-
-   { read the parameters quick, only -i -v -T }
-   option.firstpass:=true;
-   if cmd<>'' then
-     option.parsecmd(cmd)
-   else
-    begin
-      option.read_parameters;
-      { Write only quickinfo }
-      if option.quickinfo<>'' then
-       option.writequickinfo;
-    end;
-   option.firstpass:=false;
-
   { read configuration file }
   if (not disable_configfile) and
      (ppccfg<>'') then
@@ -1917,33 +1904,29 @@ begin
   case target_info.endian of
     endian_little :
       begin
-         def_symbol('ENDIAN_LITTLE');
-         def_symbol('FPC_LITTLE_ENDIAN');
+         def_system_macro('ENDIAN_LITTLE');
+         def_system_macro('FPC_LITTLE_ENDIAN');
       end;
     endian_big :
       begin
-         def_symbol('ENDIAN_BIG');
-         def_symbol('FPC_BIG_ENDIAN');
+         def_system_macro('ENDIAN_BIG');
+         def_system_macro('FPC_BIG_ENDIAN');
       end;
   end;
 
   { abi define }
   case target_info.abi of
     abi_powerpc_sysv :
-      def_symbol('FPC_ABI_SYSV');
+      def_system_macro('FPC_ABI_SYSV');
     abi_powerpc_aix :
-      def_symbol('FPC_ABI_AIX');
+      def_system_macro('FPC_ABI_AIX');
   end;
 
 {$ifdef m68k}
   if initoptprocessor=MC68020 then
-    def_symbol('CPUM68020');
+    def_system_macro('CPUM68020');
 {$endif m68k}
 
-{ write logo if set }
-  if option.DoWriteLogo then
-   option.WriteLogo;
-
 { Check file to compile }
   if param_file='' then
    begin
@@ -2089,6 +2072,10 @@ begin
    end;
   UpdateAlignment(initalignment,option.paraalignment);
 
+  set_system_macro('FPC_VERSION',version_nr);
+  set_system_macro('FPC_RELEASE',release_nr);
+  set_system_macro('FPC_PATCH',patch_nr);
+
   option.free;
   Option:=nil;
 end;
@@ -2102,7 +2089,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.160  2005-01-08 23:14:50  peter
+  Revision 1.161  2005-01-09 20:24:43  olle
+    * rework of macro subsystem
+    + exportable macros for mode macpas
+
+  Revision 1.160  2005/01/08 23:14:50  peter
     * Allow #include ~/.fpc.cfg
 
   Revision 1.159  2005/01/04 16:19:52  florian

compiler/parser.pas

@@ -160,22 +160,6 @@ implementation
       end;
 
 
-    procedure default_macros;
-      var
-        hp : tstringlistitem;
-      begin
-      { commandline }
-        hp:=tstringlistitem(initdefines.first);
-        while assigned(hp) do
-         begin
-           current_scanner.def_macro(hp.str);
-           hp:=tstringlistitem(hp.next);
-         end;
-      { set macros for version checking }
-        current_scanner.set_macro('FPC_VERSION',version_nr);
-        current_scanner.set_macro('FPC_RELEASE',release_nr);
-        current_scanner.set_macro('FPC_PATCH',patch_nr);
-      end;
 
 
 {$ifdef PREPROCWRITE}
@@ -184,11 +168,15 @@ implementation
         i : longint;
       begin
          new(preprocfile,init('pre'));
-       { default macros }
-         current_scanner^.macros:=new(pdictionary,init);
-         default_macros;
        { initialize a module }
          current_module:=new(pmodule,init(filename,false));
+
+         macrosymtablestack:= initialmacrosymtable;
+         current_module.localmacrosymtable:= tmacrosymtable.create(false);
+         current_module.localmacrosymtable.next:= initialmacrosymtable;
+         macrosymtablestack:= current_module.localmacrosymtable;
+         ConsolidateMode;
+
          main_module:=current_module;
        { startup scanner, and save in current_module }
          current_scanner:=new(pscannerfile,Init(filename));
@@ -334,6 +322,8 @@ implementation
           oldrefsymtable,
           olddefaultsymtablestack,
           oldsymtablestack : tsymtable;
+          olddefaultmacrosymtablestack,
+          oldmacrosymtablestack : tsymtable;
           oldaktprocsym    : tprocsym;
         { cg }
           oldparse_only  : boolean;
@@ -395,7 +385,9 @@ implementation
             old_compiled_module:=compiled_module;
           { save symtable state }
             oldsymtablestack:=symtablestack;
+            oldmacrosymtablestack:=macrosymtablestack;
             olddefaultsymtablestack:=defaultsymtablestack;
+            olddefaultmacrosymtablestack:=defaultmacrosymtablestack;
             oldrefsymtable:=refsymtable;
             oldcurrent_procinfo:=current_procinfo;
             oldaktdefproccall:=aktdefproccall;
@@ -457,7 +449,9 @@ implementation
 
        { reset symtable }
          symtablestack:=nil;
+         macrosymtablestack:=nil;
          defaultsymtablestack:=nil;
+         defaultmacrosymtablestack:=nil;
          systemunit:=nil;
          refsymtable:=nil;
          aktdefproccall:=initdefproccall;
@@ -506,8 +500,13 @@ implementation
          current_scanner:=tscannerfile.Create(filename);
          current_scanner.firstfile;
          current_module.scanner:=current_scanner;
-         { macros }
-         default_macros;
+
+         { init macros before anything in the file is parsed.}
+         macrosymtablestack:= initialmacrosymtable;
+         current_module.localmacrosymtable:= tmacrosymtable.create(false);
+         current_module.localmacrosymtable.next:= initialmacrosymtable;
+         macrosymtablestack:= current_module.localmacrosymtable;
+
          { read the first token }
          current_scanner.readtoken;
 
@@ -606,7 +605,9 @@ implementation
                  { restore symtable state }
                  refsymtable:=oldrefsymtable;
                  symtablestack:=oldsymtablestack;
+                 macrosymtablestack:=oldmacrosymtablestack;
                  defaultsymtablestack:=olddefaultsymtablestack;
+                 defaultmacrosymtablestack:=olddefaultmacrosymtablestack;
                  aktdefproccall:=oldaktdefproccall;
                  current_procinfo:=oldcurrent_procinfo;
                  aktsourcecodepage:=oldsourcecodepage;
@@ -698,7 +699,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.68  2004-10-25 15:38:41  peter
+  Revision 1.69  2005-01-09 20:24:43  olle
+    * rework of macro subsystem
+    + exportable macros for mode macpas
+
+  Revision 1.68  2004/10/25 15:38:41  peter
     * heap and heapsize removed
     * checkpointer fixes
 

compiler/pmodules.pas

@@ -381,6 +381,11 @@ implementation
         { add to symtable stack }
         tsymtable(hp.globalsymtable).next:=symtablestack;
         symtablestack:=hp.globalsymtable;
+        if (m_mac in aktmodeswitches) and assigned(hp.globalmacrosymtable) then
+          begin
+            tsymtable(hp.globalmacrosymtable).next:=macrosymtablestack;
+            macrosymtablestack:=hp.globalmacrosymtable;
+          end;
         { insert unitsym }
         unitsym:=tunitsym.create(s,hp.globalsymtable);
         inc(unitsym.refs);
@@ -424,7 +429,8 @@ implementation
            exit;
          end;
         { insert the system unit, it is allways the first }
-        Symtablestack:=nil;
+        symtablestack:=nil;
+        macrosymtablestack:=initialmacrosymtable;
         AddUnit('System');
         SystemUnit:=TGlobalSymtable(Symtablestack);
         { read default constant definitions }
@@ -468,6 +474,7 @@ implementation
          end;
         { save default symtablestack }
         defaultsymtablestack:=symtablestack;
+        defaultmacrosymtablestack:=macrosymtablestack;
       end;
 
 
@@ -479,6 +486,8 @@ implementation
          hp2     : tmodule;
          hp3     : tsymtable;
          unitsym : tunitsym;
+         top_of_macrosymtable : tsymtable;
+         
       begin
          consume(_USES);
 {$ifdef DEBUG}
@@ -536,9 +545,9 @@ implementation
            else
             break;
          until false;
-         consume(_SEMICOLON);
 
          { Load the units }
+         top_of_macrosymtable:= macrosymtablestack;
          pu:=tused_unit(current_module.used_units.first);
          while assigned(pu) do
           begin
@@ -571,6 +580,7 @@ implementation
            then insert the units in the symtablestack }
          pu:=tused_unit(current_module.used_units.first);
          symtablestack:=defaultsymtablestack;
+         macrosymtablestack:=defaultmacrosymtablestack;
          while assigned(pu) do
            begin
               if pu.in_uses then
@@ -588,6 +598,11 @@ implementation
                           begin
                              tsymtable(pu.u.globalsymtable).next:=symtablestack;
                              symtablestack:=tsymtable(pu.u.globalsymtable);
+                             if (m_mac in aktmodeswitches) and assigned(pu.u.globalmacrosymtable) then
+                               begin
+                                 tsymtable(pu.u.globalmacrosymtable).next:=macrosymtablestack;
+                                 macrosymtablestack:=tsymtable(pu.u.globalmacrosymtable);
+                               end;
 {$ifdef DEBUG}
                              test_symtablestack;
 {$endif DEBUG}
@@ -596,6 +611,13 @@ implementation
                 end;
               pu:=tused_unit(pu.next);
            end;
+
+         if assigned (current_module.globalmacrosymtable) then
+           top_of_macrosymtable.next.next:= macrosymtablestack
+         else
+           top_of_macrosymtable.next:= macrosymtablestack;
+         macrosymtablestack:= top_of_macrosymtable;
+         consume(_SEMICOLON);
       end;
 
 
@@ -771,22 +793,6 @@ implementation
         if (cs_local_browser in aktmoduleswitches) and
            not(cs_browser in aktmoduleswitches) then
           exclude(aktmoduleswitches,cs_local_browser);
-
-        { define a symbol in delphi,objfpc,tp,gpc mode }
-        if (m_delphi in aktmodeswitches) then
-         current_scanner.def_macro('FPC_DELPHI')
-        else
-         if (m_tp7 in aktmodeswitches) then
-          current_scanner.def_macro('FPC_TP')
-        else
-         if (m_objfpc in aktmodeswitches) then
-          current_scanner.def_macro('FPC_OBJFPC')
-        else
-         if (m_gpc in aktmodeswitches) then
-          current_scanner.def_macro('FPC_GPC')
-        else
-         if (m_mac in aktmodeswitches) then
-          current_scanner.def_macro('FPC_MACPAS');
       end;
 
 
@@ -880,7 +886,15 @@ implementation
         release_main_proc(pd);
       end;
 
-
+    procedure delete_duplicate_macros(p:TNamedIndexItem; arg:pointer);
+    var
+      hp: tsymentry;
+    begin
+      hp:= current_module.localmacrosymtable.search(p.name);
+      if assigned(hp) then
+        current_module.localmacrosymtable.delete(hp);
+    end;
+    
     procedure proc_unit;
 
       function is_assembler_generated:boolean;
@@ -907,6 +921,12 @@ implementation
          unitname8 : string[8];
          has_impl: boolean;
       begin
+         if m_mac in aktmodeswitches then
+           begin
+             ConsolidateMode;
+             current_module.mode_switch_allowed:= false;
+           end;
+       
          consume(_UNIT);
          if compile_level=1 then
           Status.IsExe:=false;
@@ -956,6 +976,7 @@ implementation
          current_module.in_global:=false;
 
          { handle the global switches }
+         ConsolidateMode;
          setupglobalswitches;
 
          message1(unit_u_loading_interface_units,current_module.modulename^);
@@ -986,9 +1007,20 @@ implementation
          { with the same name as the unit                  }
          refsymtable.insert(tunitsym.create(current_module.realmodulename^,unitst));
 
+         macrosymtablestack:= initialmacrosymtable;
+
          { load default units, like the system unit }
          loaddefaultunits;
 
+         current_module.localmacrosymtable.next:=macrosymtablestack;
+         if assigned(current_module.globalmacrosymtable) then
+           begin
+             current_module.globalmacrosymtable.next:= current_module.localmacrosymtable;
+             macrosymtablestack:=current_module.globalmacrosymtable;
+           end
+         else
+           macrosymtablestack:=current_module.localmacrosymtable;
+
          { reset }
          make_ref:=true;
 
@@ -1054,13 +1086,7 @@ implementation
          if (m_mac in aktmodeswitches) and try_to_consume(_END) then
            has_impl:= false
          else
-           begin
-             consume(_IMPLEMENTATION);
-             has_impl:= true;
-           end;
-
-         if has_impl then
-           Message1(unit_u_loading_implementation_units,current_module.modulename^);
+           has_impl:= true;
 
          parse_only:=false;
 
@@ -1068,16 +1094,30 @@ implementation
          st:=tstaticsymtable.create(current_module.modulename^);
          current_module.localsymtable:=st;
 
+         { Swap the positions of the local and global macro sym table}        
+         if assigned(current_module.globalmacrosymtable) then
+           begin
+             macrosymtablestack:=current_module.localmacrosymtable;
+             current_module.globalmacrosymtable.next:= current_module.localmacrosymtable.next;
+             current_module.localmacrosymtable.next:=current_module.globalmacrosymtable;
+             
+             current_module.globalmacrosymtable.foreach_static(@delete_duplicate_macros, nil);
+           end;
+
          { remove the globalsymtable from the symtable stack }
          { to reinsert it after loading the implementation units }
          symtablestack:=unitst.next;
 
          { we don't want implementation units symbols in unitsymtable !! PM }
          refsymtable:=st;
-
-         { Read the implementation units }
+         
          if has_impl then
-           parse_implementation_uses;
+           begin
+             consume(_IMPLEMENTATION);     
+             Message1(unit_u_loading_implementation_units,current_module.modulename^);     
+             { Read the implementation units }
+             parse_implementation_uses;
+           end;
 
          if current_module.state=ms_compiled then
            exit;
@@ -1340,7 +1380,8 @@ implementation
          { global switches are read, so further changes aren't allowed }
          current_module.in_global:=false;
 
-         { setup things using the global switches }
+         { setup things using the switches }
+         ConsolidateMode;
          setupglobalswitches;
 
          { set implementation flag }
@@ -1353,9 +1394,14 @@ implementation
          current_module.localsymtable:=st;
          refsymtable:=st;
 
+         macrosymtablestack:= nil;
+
          { load standard units (system,objpas,profile unit) }
          loaddefaultunits;
 
+         current_module.localmacrosymtable.next:=macrosymtablestack;
+         macrosymtablestack:=current_module.localmacrosymtable;
+         
          {Load the units used by the program we compile.}
          if token=_USES then
            loadunits;
@@ -1554,7 +1600,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.178  2004-12-06 19:23:05  peter
+  Revision 1.179  2005-01-09 20:24:43  olle
+    * rework of macro subsystem
+    + exportable macros for mode macpas
+
+  Revision 1.178  2004/12/06 19:23:05  peter
   implicit load of variants unit
 
   Revision 1.177  2004/11/29 18:50:15  peter

compiler/ppu.pas

@@ -44,7 +44,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion=46;
+  CurrentPPUVersion=47;
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -79,8 +79,11 @@ const
   ibdefref               = 13;
   ibendsymtablebrowser   = 14;
   ibbeginsymtablebrowser = 15;
+{$IFDEF MACRO_DIFF_HINT}
   ibusedmacros           = 16;
+{$ENDIF}
   ibderefdata            = 17;
+  ibexportedmacros       = 18;
   {syms}
   ibtypesym        = 20;
   ibprocsym        = 21;
@@ -97,6 +100,7 @@ const
   ibrttisym        = 32;
   iblocalvarsym    = 33;
   ibparavarsym     = 34;
+  ibmacrosym       = 35;
   {definitions}
   iborddef         = 40;
   ibpointerdef     = 41;
@@ -1055,7 +1059,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.60  2004-12-06 19:23:05  peter
+  Revision 1.61  2005-01-09 20:24:43  olle
+    * rework of macro subsystem
+    + exportable macros for mode macpas
+
+  Revision 1.60  2004/12/06 19:23:05  peter
   implicit load of variants unit
 
   Revision 1.59  2004/11/15 23:35:31  peter

compiler/scandir.pas

@@ -37,6 +37,7 @@ implementation
       verbose,comphook,
       scanner,switches,
       fmodule,
+      symtable,
       rabase;
 
     const
@@ -617,17 +618,24 @@ implementation
 
 
     procedure dir_mode;
-      begin
-        if not current_module.in_global then
-         Message(scan_w_switch_is_global)
-        else
-          begin
-            current_scanner.skipspace;
-            current_scanner.readstring;
-            if not SetCompileMode(pattern,false) then
-             Message1(scan_w_illegal_switch,pattern);
-          end;
-      end;
+
+    begin
+      if not current_module.in_global then
+        Message(scan_w_switch_is_global)
+      else
+        begin
+          current_scanner.skipspace;
+          current_scanner.readstring;
+          if not current_module.mode_switch_allowed and 
+              not ((m_mac in aktmodeswitches) and (pattern='MACPAS')) then
+            Message1(scan_e_mode_switch_not_allowed,pattern)
+          else if SetCompileMode(pattern,false) then
+            ConsolidateMode
+          else
+            Message1(scan_w_illegal_switch,pattern)
+        end;
+      current_module.mode_switch_allowed:= false;
+    end;
 
     procedure dir_mmx;
       begin
@@ -779,18 +787,13 @@ implementation
     end;
 
     procedure dir_profile;
-      var
-        mac : tmacro;
       begin
         do_moduleswitch(cs_profile);
         { defined/undefine FPC_PROFILE }
-        mac:=tmacro(current_scanner.macros.search('FPC_PROFILE'));
-        if not assigned(mac) then
-         begin
-           mac:=tmacro.create('FPC_PROFILE');
-           current_scanner.macros.insert(mac);
-         end;
-        mac.defined:=(cs_profile in aktmoduleswitches);
+        if cs_profile in aktmoduleswitches then
+          def_system_macro('FPC_PROFILE')
+        else
+          undef_system_macro('FPC_PROFILE');
       end;
 
     procedure dir_push;
@@ -895,18 +898,13 @@ implementation
 {$endif}
 
     procedure dir_threading;
-      var
-        mac : tmacro;
       begin
         do_moduleswitch(cs_threading);
         { defined/undefine FPC_THREADING }
-        mac:=tmacro(current_scanner.macros.search('FPC_THREADING'));
-        if not assigned(mac) then
-         begin
-           mac:=tmacro.create('FPC_THREADING');
-           current_scanner.macros.insert(mac);
-         end;
-        mac.defined:=(cs_threading in aktmoduleswitches);
+        if cs_threading in aktmoduleswitches then
+          def_system_macro('FPC_THREADING')
+        else
+          undef_system_macro('FPC_THREADING');
       end;
 
     procedure dir_typedaddress;
@@ -1170,7 +1168,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.50  2005-01-06 02:13:03  karoly
+  Revision 1.51  2005-01-09 20:24:43  olle
+    * rework of macro subsystem
+    + exportable macros for mode macpas
+
+  Revision 1.50  2005/01/06 02:13:03  karoly
     * more SysV call support stuff for MorphOS
 
   Revision 1.49  2005/01/04 17:40:33  karoly

compiler/scanner.pas

@@ -36,30 +36,14 @@ interface
     const
        max_include_nesting=32;
        max_macro_nesting=16;
-       maxmacrolen=16*1024;
        preprocbufsize=32*1024;
 
 
     type
        tcommentstyle = (comment_none,comment_tp,comment_oldtp,comment_delphi,comment_c);
 
-       pmacrobuffer = ^tmacrobuffer;
-       tmacrobuffer = array[0..maxmacrolen-1] of char;
        tscannerfile = class;
 
-       tmacro = class(TNamedIndexItem)
-          defined : boolean; { normally true, but false when the macro is undef-ed}
-          defined_at_startup : boolean;
-          is_used : boolean;
-          is_compiler_var : boolean; { if this is a mac style compiler variable, in
-                                  which case no macro substitutions shall be done.}
-          buftext : pchar;
-          buflen  : longint;
-          fileinfo : tfileposinfo;
-          constructor Create(const n : string);
-          destructor  destroy;override;
-       end;
-
        preproctyp = (pp_ifdef,pp_ifndef,pp_if,pp_ifopt,pp_else,pp_elseif);
 
        tpreprocstack = class
@@ -103,7 +87,6 @@ interface
           lastasmgetchar : char;
           ignoredirectives : tstringlist; { ignore directives, used to give warnings only once }
           preprocstack   : tpreprocstack;
-          macros         : Tdictionary;
           in_asm_string  : boolean;
 
           preproc_pattern : string;
@@ -124,8 +107,6 @@ interface
           procedure reload;
           procedure insertmacro(const macname:string;p:pchar;len,line,fileindex:longint);
         { Scanner things }
-          procedure def_macro(const s : string);
-          procedure set_macro(const s : string;value : string);
           procedure gettokenpos;
           procedure inc_comment_level;
           procedure dec_comment_level;
@@ -200,6 +181,8 @@ interface
     procedure InitScanner;
     procedure DoneScanner;
 
+    {To be called when the language mode is finally determined}
+    procedure ConsolidateMode;
 
 implementation
 
@@ -251,6 +234,33 @@ implementation
       end;
 
 
+    {To be called when the language mode is finally determined}
+    procedure ConsolidateMode;
+
+    begin
+      if m_mac in aktmodeswitches then
+        if current_module.is_unit and not assigned(current_module.globalmacrosymtable) then
+          begin
+            current_module.globalmacrosymtable:= tmacrosymtable.create(true);
+            current_module.globalmacrosymtable.next:= current_module.localmacrosymtable;
+            macrosymtablestack:=current_module.globalmacrosymtable;
+          end;
+
+      { define a symbol in delphi,objfpc,tp,gpc,macpas mode }
+      if (m_delphi in aktmodeswitches) then
+        def_system_macro('FPC_DELPHI')
+      else if (m_tp7 in aktmodeswitches) then
+        def_system_macro('FPC_TP')
+      else if (m_objfpc in aktmodeswitches) then
+        def_system_macro('FPC_OBJFPC')
+      else if (m_gpc in aktmodeswitches) then
+        def_system_macro('FPC_GPC')
+      else if (m_mac in aktmodeswitches) then
+        def_system_macro('FPC_MACPAS');
+    end;
+
+
+
 {*****************************************************************************
                            Conditional Directives
 *****************************************************************************}
@@ -276,7 +286,7 @@ implementation
         hs:=current_scanner.readid;
         if hs='' then
           Message(scan_e_error_in_preproc_expr);
-        mac:=tmacro(current_scanner.macros.search(hs));
+        mac:=tmacro(search_macro(hs));
         if assigned(mac) then
           mac.is_used:=true;
         current_scanner.addpreprocstack(pp_ifdef,assigned(mac) and mac.defined,hs,scan_c_ifdef_found);
@@ -292,7 +302,7 @@ implementation
         hs:=current_scanner.readid;
         if hs='' then
           Message(scan_e_error_in_preproc_expr);
-        mac:=tmacro(current_scanner.macros.search(hs));
+        mac:=tmacro(search_macro(hs));
         if assigned(mac) then
           mac.is_used:=true;
         current_scanner.addpreprocstack(pp_ifndef,not(assigned(mac) and mac.defined),hs,scan_c_ifndef_found);
@@ -383,7 +393,7 @@ implementation
             For real macros also do recursive substitution. }
           macrocount:=0;
           repeat
-            mac:=tmacro(current_scanner.macros.search(result));
+            mac:=tmacro(search_macro(result));
 
             inc(macrocount);
             if macrocount>max_macro_nesting then
@@ -405,6 +415,7 @@ implementation
                   hs[0]:=char(len);
                   move(mac.buftext^,hs[1],len);
                   result:=upcase(hs);
+                  mac.is_used:=true;
                 end
               else
                 begin
@@ -445,9 +456,12 @@ implementation
                     if current_scanner.preproc_token =_ID then
                       begin
                         hs := current_scanner.preproc_pattern;
-                        mac := tmacro(current_scanner.macros.search(hs));
+                        mac := tmacro(search_macro(hs));
                         if assigned(mac) then
-                          hs := '1'
+                          begin
+                            hs := '1';
+                            mac.is_used:=true;
+                          end
                         else
                           hs := '0';
                         read_factor := hs;
@@ -469,9 +483,12 @@ implementation
                     if current_scanner.preproc_token =_ID then
                       begin
                         hs := current_scanner.preproc_pattern;
-                        mac := tmacro(current_scanner.macros.search(hs));
+                        mac := tmacro(search_macro(hs));
                         if assigned(mac) then
-                          hs := '0'
+                          begin
+                            hs := '0';
+                            mac.is_used:=true;
+                          end
                         else
                           hs := '1';
                         read_factor := hs;
@@ -757,13 +774,13 @@ implementation
       begin
         current_scanner.skipspace;
         hs:=current_scanner.readid;
-        mac:=tmacro(current_scanner.macros.search(hs));
-        if not assigned(mac) then
+        mac:=tmacro(search_macro(hs));
+        if not assigned(mac) or (mac.owner <> macrosymtablestack) then
           begin
             mac:=tmacro.create(hs);
             mac.defined:=true;
             Message1(parser_c_macro_defined,mac.name);
-            current_scanner.macros.insert(mac);
+            macrosymtablestack.insert(mac);
           end
         else
           begin
@@ -855,14 +872,14 @@ implementation
       begin
         current_scanner.skipspace;
         hs:=current_scanner.readid;
-        mac:=tmacro(current_scanner.macros.search(hs));
-        if not assigned(mac) then
+        mac:=tmacro(search_macro(hs));
+        if not assigned(mac) or (mac.owner <> macrosymtablestack) then
           begin
             mac:=tmacro.create(hs);
             mac.defined:=true;
             mac.is_compiler_var:=true;
             Message1(parser_c_macro_defined,mac.name);
-            current_scanner.macros.insert(mac);
+            macrosymtablestack.insert(mac);
           end
         else
           begin
@@ -920,13 +937,13 @@ implementation
       begin
         current_scanner.skipspace;
         hs:=current_scanner.readid;
-        mac:=tmacro(current_scanner.macros.search(hs));
-        if not assigned(mac) then
+        mac:=tmacro(search_macro(hs));
+        if not assigned(mac) or (mac.owner <> macrosymtablestack) then
           begin
              mac:=tmacro.create(hs);
              Message1(parser_c_macro_undefined,mac.name);
              mac.defined:=false;
-             current_scanner.macros.insert(mac);
+             macrosymtablestack.insert(mac);
           end
         else
           begin
@@ -1071,32 +1088,6 @@ implementation
       end;
 
 
-
-{*****************************************************************************
-                                 TMacro
-*****************************************************************************}
-
-    constructor tmacro.create(const n : string);
-      begin
-         inherited createname(n);
-         defined:=true;
-         defined_at_startup:=false;
-         fileinfo:=akttokenpos;
-         is_used:=false;
-         is_compiler_var:= false;
-         buftext:=nil;
-         buflen:=0;
-      end;
-
-
-    destructor tmacro.destroy;
-      begin
-         if assigned(buftext) then
-           freemem(buftext,buflen);
-         inherited destroy;
-      end;
-
-
 {*****************************************************************************
                             Preprocessor writting
 *****************************************************************************}
@@ -1206,7 +1197,6 @@ implementation
         lastasmgetchar:=#0;
         ignoredirectives:=TStringList.Create;
         in_asm_string:=false;
-        macros:=tdictionary.create;
       end;
 
 
@@ -1233,48 +1223,6 @@ implementation
         if not inputfile.closed then
           closeinputfile;
         ignoredirectives.free;
-        macros.free;
-      end;
-
-
-    procedure tscannerfile.def_macro(const s : string);
-      var
-        mac : tmacro;
-      begin
-         mac:=tmacro(macros.search(s));
-         if mac=nil then
-           begin
-             mac:=tmacro.create(s);
-             Message1(parser_c_macro_defined,mac.name);
-             macros.insert(mac);
-           end;
-         mac.defined:=true;
-         mac.defined_at_startup:=true;
-      end;
-
-
-    procedure tscannerfile.set_macro(const s : string;value : string);
-      var
-        mac : tmacro;
-      begin
-         mac:=tmacro(macros.search(s));
-         if mac=nil then
-           begin
-             mac:=tmacro.create(s);
-             macros.insert(mac);
-           end
-         else
-           begin
-             mac.is_compiler_var:=false;
-             if assigned(mac.buftext) then
-               freemem(mac.buftext,mac.buflen);
-           end;
-         Message2(parser_c_macro_set_to,mac.name,value);
-         mac.buflen:=length(value);
-         getmem(mac.buftext,mac.buflen);
-         move(value[1],mac.buftext^,mac.buflen);
-         mac.defined:=true;
-         mac.defined_at_startup:=true;
       end;
 
 
@@ -2483,11 +2431,12 @@ implementation
             { this takes some time ... }
               if (cs_support_macro in aktmoduleswitches) then
                begin
-                 mac:=tmacro(macros.search(pattern));
+                 mac:=tmacro(search_macro(pattern));
                  if assigned(mac) and (not mac.is_compiler_var) and (assigned(mac.buftext)) then
                   begin
                     if yylexcount<max_macro_nesting then
                      begin
+                       mac.is_used:=true;
                        inc(yylexcount);
                        insertmacro(pattern,mac.buftext,mac.buflen,
                          mac.fileinfo.line,mac.fileinfo.fileindex);
@@ -3310,7 +3259,11 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.97  2005-01-04 16:34:03  peter
+  Revision 1.98  2005-01-09 20:24:43  olle
+    * rework of macro subsystem
+    + exportable macros for mode macpas
+
+  Revision 1.97  2005/01/04 16:34:03  peter
     * give error when reading identifier > 255 chars
 
   Revision 1.96  2004/11/08 22:09:59  peter

compiler/symbase.pas

@@ -117,6 +117,8 @@ interface
           procedure foreach(proc2call : tnamedindexcallback;arg:pointer);
           procedure foreach_static(proc2call : tnamedindexstaticcallback;arg:pointer);
           procedure insert(sym : tsymentry);virtual;
+          { deletes a tsymentry and removes it from the tsymtable}
+          procedure delete(sym:tsymentry);
           procedure replace(oldsym,newsym:tsymentry);
           function  search(const s : stringid) : tsymentry;
           function  speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;virtual;
@@ -136,11 +138,16 @@ interface
 
        defaultsymtablestack : tsymtable;  { symtablestack after default units have been loaded }
        symtablestack     : tsymtable;     { linked list of symtables }
+       defaultmacrosymtablestack : tsymtable;{ macrosymtablestack after default units have been loaded }
+       macrosymtablestack: tsymtable;     { linked list of macro symtables }
 
        aktrecordsymtable : tsymtable;     { current record symtable }
        aktparasymtable   : tsymtable;     { current proc para symtable }
        aktlocalsymtable  : tsymtable;     { current proc local symtable }
 
+       initialmacrosymtable: tsymtable;   { macros initially defined by the compiler or
+                                            given on the command line. Is common
+                                            for all files compiled and do not change. }
 
 implementation
 
@@ -266,6 +273,13 @@ implementation
          symsearch.insert(sym);
       end;
 
+    procedure tsymtable.delete(sym:tsymentry);
+      begin
+         sym.owner:=nil;
+         { remove from index and search hash }
+         symsearch.delete(sym.name);
+         symindex.delete(sym);
+      end;
 
     procedure tsymtable.replace(oldsym,newsym:tsymentry);
       begin
@@ -331,7 +345,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  2004-10-15 09:14:17  mazen
+  Revision 1.24  2005-01-09 20:24:43  olle
+    * rework of macro subsystem
+    + exportable macros for mode macpas
+
+  Revision 1.23  2004/10/15 09:14:17  mazen
   - remove $IFDEF DELPHI and related code
   - remove $IFDEF FPCPROCVAR and related code
 

compiler/symconst.pas

@@ -334,7 +334,8 @@ type
     globalsymtable,staticsymtable,
     objectsymtable,recordsymtable,
     localsymtable,parasymtable,
-    withsymtable,stt_exceptsymtable
+    withsymtable,stt_exceptsymtable,
+    exportedmacrosymtable, localmacrosymtable
   );
 
 
@@ -439,7 +440,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.99  2005-01-06 02:13:03  karoly
+  Revision 1.100  2005-01-09 20:24:43  olle
+    * rework of macro subsystem
+    + exportable macros for mode macpas
+
+  Revision 1.99  2005/01/06 02:13:03  karoly
     * more SysV call support stuff for MorphOS
 
   Revision 1.98  2005/01/05 02:31:06  karoly

compiler/symsym.pas

@@ -340,6 +340,31 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
        end;
 
+    const
+       maxmacrolen=16*1024;
+
+    type
+       pmacrobuffer = ^tmacrobuffer;
+       tmacrobuffer = array[0..maxmacrolen-1] of char;
+
+       tmacro = class(tstoredsym)
+          {Normally true, but false when a previously defined macro is undef-ed}
+          defined : boolean; 
+          {True if this is a mac style compiler variable, in which case no macro
+           substitutions shall be done.}
+          is_compiler_var : boolean; 
+          {Whether the macro was used. NOTE: A use of a macro which was never defined}
+          {e. g. an IFDEF which returns false, will not be registered as used,}
+          {since there is no place to register its use. }
+          is_used : boolean; 
+          buftext : pchar;
+          buflen  : longint;
+          constructor create(const n : string);
+          constructor ppuload(ppufile:tcompilerppufile);
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          destructor  destroy;override;
+       end;
+
        { compiler generated symbol to point to rtti and init/finalize tables }
        trttisym = class(tstoredsym)
        private
@@ -2498,6 +2523,61 @@ implementation
       end;
 
 
+{*****************************************************************************
+                                 TMacro
+*****************************************************************************}
+
+    constructor tmacro.create(const n : string);
+      begin
+         inherited create(n);
+         typ:= macrosym;
+         owner:= nil;
+
+         defined:=false;
+         is_used:=false;
+         is_compiler_var:= false;
+         buftext:=nil;
+         buflen:=0;
+      end;
+
+    constructor tmacro.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(ppufile);
+         typ:=macrosym;
+         name:=ppufile.getstring;
+         defined:=boolean(ppufile.getbyte);
+         is_compiler_var:=boolean(ppufile.getbyte);
+         is_used:=false;
+         buflen:= ppufile.getlongint;
+         if buflen > 0 then
+           begin
+             getmem(buftext, buflen);
+             ppufile.getdata(buftext^, buflen)
+           end
+         else
+           buftext:=nil;
+      end;
+
+    destructor tmacro.destroy;
+      begin
+         if assigned(buftext) then
+           freemem(buftext,buflen);
+         inherited destroy;
+      end;
+
+    procedure tmacro.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         ppufile.putstring(name);
+         ppufile.putbyte(byte(defined));
+         ppufile.putbyte(byte(is_compiler_var));
+         ppufile.putlongint(buflen);
+         if buflen > 0 then
+           ppufile.putdata(buftext^,buflen);
+         ppufile.writeentry(ibmacrosym);
+      end;
+
+
 {****************************************************************************
                                   TRTTISYM
 ****************************************************************************}
@@ -2569,7 +2649,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.198  2005-01-04 16:38:54  peter
+  Revision 1.199  2005-01-09 20:24:43  olle
+    * rework of macro subsystem
+    + exportable macros for mode macpas
+
+  Revision 1.198  2005/01/04 16:38:54  peter
     * fix setting minval for enum with specified values
 
   Revision 1.197  2005/01/03 22:27:56  peter

compiler/symtable.pas

@@ -180,6 +180,11 @@ interface
           constructor create;
        end;
 
+       tmacrosymtable = class(tstoredsymtable)
+       public
+          constructor create(exported: boolean);
+          procedure ppuload(ppufile:tcompilerppufile);override;
+       end;
 
     var
        constsymtable  : tsymtable;      { symtable were the constants can be inserted }
@@ -208,11 +213,22 @@ interface
 {$endif notused}
     function  search_class_member(pd : tobjectdef;const s : string):tsym;
     function  search_assignment_operator(from_def,to_def:Tdef):Tprocdef;
+    {Looks for macro s (must be given in upper case) in the macrosymbolstack, }
+    {and returns it if found. Returns nil otherwise.}
+    function  search_macro(const s : string):tsym;
 
 {*** Object Helpers ***}
     procedure search_class_overloads(aprocsym : tprocsym);
     function search_default_property(pd : tobjectdef) : tpropertysym;
 
+{*** Macro Helpers ***}
+    {If called initially, the following procedures manipulate macros in }
+    {initialmacrotable, otherwise they manipulate system macros local to a module.}
+    {Name can be given in any case (it will be converted to upper case).}
+    procedure def_system_macro(const name : string);
+    procedure set_system_macro(const name, value : string);
+    procedure undef_system_macro(const name : string);
+
 {*** symtable stack ***}
 {$ifdef DEBUG}
     procedure test_symtablestack;
@@ -374,6 +390,7 @@ implementation
                iblabelsym : sym:=tlabelsym.ppuload(ppufile);
                  ibsyssym : sym:=tsyssym.ppuload(ppufile);
                 ibrttisym : sym:=trttisym.ppuload(ppufile);
+               ibmacrosym : sym:=tmacro.ppuload(ppufile);
                 ibendsyms : break;
                     ibend : Message(unit_f_ppu_read_error);
            else
@@ -1699,6 +1716,33 @@ implementation
       end;
 
 
+{****************************************************************************
+                          TMacroSymtable
+****************************************************************************}
+
+    constructor tmacrosymtable.create(exported: boolean);
+      begin
+        inherited create('');
+        if exported then
+          symtabletype:=exportedmacrosymtable
+        else
+          symtabletype:=localmacrosymtable;
+        symtablelevel:=main_program_level;
+      end;
+
+
+    procedure tmacrosymtable.ppuload(ppufile:tcompilerppufile);
+      begin
+        next:=macrosymtablestack;
+        macrosymtablestack:=self;
+
+        inherited ppuload(ppufile);
+
+        { restore symtablestack }
+        macrosymtablestack:=next;
+      end;
+
+
 {*****************************************************************************
                              Helper Routines
 *****************************************************************************}
@@ -2086,6 +2130,28 @@ implementation
         search_class_member:=nil;
       end;
 
+    function search_macro(const s : string):tsym;
+      var
+        p : tsymtable;
+        speedvalue : cardinal;
+        srsym      : tsym;
+
+      begin
+        speedvalue:= getspeedvalue(s);
+        p:=macrosymtablestack;
+        while assigned(p) do
+          begin
+             srsym:=tsym(p.speedsearch(s,speedvalue));
+             if assigned(srsym) then
+               begin
+                 search_macro:= srsym;
+                 exit;
+               end;
+             p:=p.next;
+          end;
+        search_macro:= nil;
+      end;
+
 
 {*****************************************************************************
                             Definition Helpers
@@ -2197,6 +2263,88 @@ implementation
         search_default_property:=_defaultprop;
      end;
 
+{****************************************************************************
+                              Macro Helpers
+****************************************************************************}
+{NOTE: Initially, macrosymtablestack contains initialmacrosymtable.}
+
+    procedure def_system_macro(const name : string);
+      var
+        mac : tmacro;
+        s: string;
+      begin
+         if name = '' then
+           internalerror(2004121201);
+         s:= upper(name);
+         mac:=tmacro(search_macro(s));
+         if not assigned(mac) then
+           begin
+             mac:=tmacro.create(s);
+             if macrosymtablestack.symtabletype=localmacrosymtable then
+               macrosymtablestack.insert(mac)
+             else
+               macrosymtablestack.next.insert(mac)
+           end;
+         if not mac.defined then
+           Message1(parser_c_macro_defined,mac.name); 
+         mac.defined:=true;
+      end;
+
+    procedure set_system_macro(const name, value : string);
+      var
+        mac : tmacro;
+        s: string;
+      begin
+        if name = '' then
+          internalerror(2004121201);
+         s:= upper(name);
+         mac:=tmacro(search_macro(s));
+         if not assigned(mac) then
+           begin
+             mac:=tmacro.create(s);
+             if macrosymtablestack.symtabletype=localmacrosymtable then
+               macrosymtablestack.insert(mac)
+             else
+               macrosymtablestack.next.insert(mac)
+           end
+         else
+           begin
+             mac.is_compiler_var:=false;
+             if assigned(mac.buftext) then
+               freemem(mac.buftext,mac.buflen);
+           end;
+         Message2(parser_c_macro_set_to,mac.name,value);
+         mac.buflen:=length(value);
+         getmem(mac.buftext,mac.buflen);
+         move(value[1],mac.buftext^,mac.buflen);
+         mac.defined:=true;
+      end;
+
+    procedure undef_system_macro(const name : string);
+      var
+        mac : tmacro;
+        s: string;
+      begin
+         if name = '' then
+           internalerror(2004121201);
+         s:= upper(name);
+         mac:=tmacro(search_macro(s));
+         if not assigned(mac) then
+           {If not found, then it's already undefined.}
+         else
+           begin
+             if mac.defined then
+               Message1(parser_c_macro_undefined,mac.name);
+             mac.defined:=false;
+             mac.is_compiler_var:=false;
+             { delete old definition }
+             if assigned(mac.buftext) then
+               begin
+                  freemem(mac.buftext,mac.buflen);
+                  mac.buftext:=nil;
+               end;
+           end;
+      end;
 
 {$ifdef UNITALIASES}
 {****************************************************************************
@@ -2290,6 +2438,7 @@ implementation
         { Reset symbolstack }
         registerdef:=false;
         symtablestack:=nil;
+        macrosymtablestack:=nil;
         systemunit:=nil;
 {$ifdef GDB}
         globaltypecount:=1;
@@ -2302,6 +2451,9 @@ implementation
         { unit aliases }
         unitaliases:=tdictionary.create;
 {$endif}
+        initialmacrosymtable:= tmacrosymtable.create(false);
+        macrosymtablestack:= initialmacrosymtable;
+
         dupnr:=0;
      end;
 
@@ -2313,12 +2465,17 @@ implementation
 {$ifdef UNITALIASES}
         unitaliases.free;
 {$endif}
+        initialmacrosymtable.Free;
      end;
 
 end.
 {
   $Log$
-  Revision 1.167  2004-12-27 16:35:48  peter
+  Revision 1.168  2005-01-09 20:24:43  olle
+    * rework of macro subsystem
+    + exportable macros for mode macpas
+
+  Revision 1.167  2004/12/27 16:35:48  peter
     * set flag if a procedure references a symbol in staticsymtable
 
   Revision 1.166  2004/12/21 08:38:16  michael

compiler/utils/ppudump.pp

@@ -1250,10 +1250,10 @@ begin
              readderef;
              writeln(space,'       ParaNr : ',getword);
              if (vo_has_explicit_paraloc in varoptions) then
-	       begin
-	         i:=getbyte;
-		 getdata(tempbuf,i);
-	       end;
+               begin
+                 i:=getbyte;
+                 getdata(tempbuf,i);
+               end;
            end;
 
          ibenumsym :
@@ -1276,6 +1276,24 @@ begin
              writeln(space,'    RTTI Type : ',getbyte);
            end;
 
+         ibmacrosym :
+           begin
+             readcommonsym('Macro symbol ');
+             writeln(space,'          Name: ',getstring);
+             writeln(space,'       Defined: ',getbyte);
+             writeln(space,'  Compiler var: ',getbyte);
+             len:=getlongint;
+             writeln(space,'  Value length: ',len);
+             if len > 0 then
+               begin
+                 getmem(pc,len+1);
+                 getdata(pc^,len);
+                 (pc+len)^:= #0;
+                 writeln(space,'         Value: "',pc,'"');
+                 freemem(pc,len+1);
+               end;
+           end;
+
          ibtypedconstsym :
            begin
              readcommonsym('Typed constant ');
@@ -1703,7 +1721,7 @@ begin
                 inc(sourcenumber);
               end;
            end;
-
+{$IFDEF MACRO_DIFF_HINT}
          ibusedmacros :
            begin
              while not EndOfEntry do
@@ -1721,7 +1739,7 @@ begin
                   writeln;
               end;
            end;
-
+{$ENDIF}
          ibloadunit :
            ReadLoadUnit;
 
@@ -1944,6 +1962,32 @@ begin
    end
   else
    ppufile.skipuntilentry(ibendsyms);
+
+{read the macro symbols}
+  if (verbose and v_syms)<>0 then
+   begin
+     Writeln;
+     Writeln('Interface Macro Symbols');
+     Writeln('-----------------------');
+   end;
+  if ppufile.readentry<>ibexportedmacros then
+    begin
+      Writeln('!! Error in PPU');
+      exit;
+    end;
+  if boolean(ppufile.getbyte) then
+    begin
+      {skip the definition section for macros (since they are never used) }
+      ppufile.skipuntilentry(ibenddefs);
+      {read the macro symbols}
+      if (verbose and v_syms)<>0 then
+        readsymbols('interface macro')
+      else
+        ppufile.skipuntilentry(ibendsyms);
+    end
+  else
+    Writeln('(no exported macros)');
+
 {read the implementation stuff}
   if (verbose and v_implementation)<>0 then
    begin
@@ -2064,7 +2108,7 @@ begin
      case upcase(para[2]) of
       'V' : begin
               verbose:=0;
-              for i:=3to length(para) do
+              for i:=3 to length(para) do
                case upcase(para[i]) of
                 'H' : verbose:=verbose or v_header;
                 'I' : verbose:=verbose or v_interface;
@@ -2088,7 +2132,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.63  2004-11-19 08:33:02  marco
+  Revision 1.64  2005-01-09 20:24:43  olle
+    * rework of macro subsystem
+    + exportable macros for mode macpas
+
+  Revision 1.63  2004/11/19 08:33:02  marco
    * fix for " Split po_public into po_public and po_global"
 
   Revision 1.62  2004/11/19 08:17:02  michael