+ aktmodeswitches

compiler/htypechk.pas

@@ -314,7 +314,7 @@ implementation
                        procvardef : begin
                                       { procedure variable can be assigned to an void pointer }
                                       { Not anymore. Use the @ operator now.}
-                                      if not(cs_tp_compatible in aktmoduleswitches) and
+                                      if not(m_tp_procvar in aktmodeswitches) and
                                          (ppointerdef(def_to)^.definition^.deftype=orddef) and
                                          (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
                                        begin
@@ -639,7 +639,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  1998-09-24 09:02:14  peter
+  Revision 1.3  1998-09-24 23:49:05  peter
+    + aktmodeswitches
+
+  Revision 1.2  1998/09/24 09:02:14  peter
     * rewritten isconvertable to use case
     * array of .. and single variable are compatible
 

compiler/msgtxt.inc

@@ -1,4 +1,4 @@
-const msgtxt : array[0..00087,1..240] of char=(+
+const msgtxt : array[0..00088,1..240] of char=(+
   'U_Compiler: $1'#000+
   'D_Source OS: $1'#000+
   'I_Target OS: $1'#000+
@@ -215,7 +215,7 @@ const msgtxt : array[0..00087,1..240] of char=(+
   'E_illegal type declaration of set element','s'#000+
   'E_Forward class definition not resolved $1'#000+
   'H_Parameter not used $1'#000+
-  'W_Local variable not used $1'#000+
+  'N_Local variable not used $1'#000+
   'E_Set type expected'#000+
   'W_Function result does not seem to be set'#000+
   'E_Unknown field identifier'#000+
@@ -470,17 +470,17 @@ const msgtxt : array[0..00087,1..240] of char=(+
   '                [email protected]'#000+
   '**0*_+ switch option on, - off'#000+
   '**1a_the compiler doesn'#039't delete the generated assembler file'#000+
-  '**2al_list sourcecode lines in assembler file  (still BETA !!)'#000+
+  '**2al_list sourcecode lines in assembler file'#000+
   '*t1b_use EMS'#000+
-  '**1B_build',' all modules'#000+
-  '**1C_code generation options'#000+
+  '**1B_build all modules'#000+
+  '**1C','_code generation options'#000+
   '3*2CD_create dynamic library'#000+
   '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#000+
   '**2Ci_IO-checking'#000+
   '**2Cn_omit linking stage'#000+
   '**2Co_check overflow of integer operations'#000+
   '**2Cr_range checking'#000+
-  '**2Cs<n>_s','et stack size to <n>'#000+
+  '**2Cs<n>_set stack size to ','<n>'#000+
   '**2Ct_stack checking'#000+
   '3*2CS_create static library'#000+
   '3*2Cx_use smartlinking'#000+
@@ -489,47 +489,49 @@ const msgtxt : array[0..00087,1..240] of char=(+
   '*O2Dd<x>_set description to <x>'#000+
   '*O2Dw_PM application'#000+
   '**1e<x>_set path to executable'#000+
-  '**1E_sa','me as -Cn'#000+
-  '**1F_set file names and paths'#000+
+  '**1E_same as -Cn'#000+
+  '**1F_se','t file names and paths'#000+
   '**2Fe<x>_redirect error output to <x>'#000+
+  '**2FU<x>_set exe/unit output path to <x>'#000+
   '*L2Fg<x>_same as -Fl'#000+
   '**2Fi<x>_adds <x> to include path'#000+
   '**2Fl<x>_adds <x> to library path'#000+
   '*L2FL<x>_uses <x> as dynamic linker'#000+
-  '**2Fo<x>_adds <x> to object path'#000+
-  '**2F','r<x>_load error message file <x>'#000+
+  '**2Fo<x>_adds',' <x> to object path'#000+
+  '**2Fr<x>_load error message file <x>'#000+
   '**2Fu<x>_adds <x> to unit path'#000+
+  '**2FU<x>_set unit output path to <x>, overrides -FE'#000+
   '*g1g_generate debugger information'#000+
   '*g2gg_use gsym'#000+
   '*g2gd_use dbx'#000+
   '**1i_information'#000+
-  '**1I<x>_adds <x> to include path'#000+
+  '**1I<x>_adds <x> to',' include path'#000+
   '**1k<x>_Pass <x> to the linker'#000+
   '**1l_write logo'#000+
-  '**1n_don'#039't read',' the default config file'#000+
+  '**1n_don'#039't read the default config file'#000+
   '**1o<x>_change the name of the executable produced to <x>'#000+
   '**1pg_generate profile code for gprof'#000+
-  '*L1P_use pipes instead of creating temporary assembler files'#000+
+  '*L1P_use pipes instead of creating temporar','y assembler files'#000+
   '**1S_syntax options'#000+
-  '**2S2_switch some Delphi 2 extensions ','on'#000+
+  '**2S2_switch some Delphi 2 extensions on'#000+
   '**2Sc_supports operators like C (*=,+=,/= and -=)'#000+
-  '**2Sd_compiler disposes asm lists (uses less memory but slower)'#000+
+  '**2Sd_tries to be Delphi compatible'#000+
   '**2Se_compiler stops after the first error'#000+
   '**2Sg_allow LABEL and GOTO'#000+
-  '**2Si_support C++ stlyed INLINE'#000+
-  '**2Sm_support macros ','like C (global)'#000+
+  '**2Si','_support C++ stlyed INLINE'#000+
+  '**2Sm_support macros like C (global)'#000+
   '**2So_tries to be TP/BP 7.0 compatible'#000+
   '**2Sp_tries to be gpc compatible'#000+
   '**2Ss_constructor name must be init (destructor must be done)'#000+
   '**2St_allow static keyword in objects'#000+
-  '**2Sv_allow variable directives (cvar,external,publi','c,export)'#000+
+  '**2S','v_allow variable directives (cvar,external,public,export)'#000+
   '**1s_don'#039't call assembler and linker (only with -a)'#000+
   '**1T<x>_Target operating system'#000+
   '3*2TGO32V1_version 1 of DJ Delorie DOS extender'#000+
   '3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+
-  '3*2TLINUX_Linux'#000+
+  '3*','2TLINUX_Linux'#000+
   '3*2TOS2_OS/2 2.x'#000+
-  '3*2TWin32_Windows',' 32 Bit'#000+
+  '3*2TWin32_Windows 32 Bit'#000+
   '6*2TAMIGA_Commodore Amiga'#000+
   '6*2TATARI_Atari ST/STe/TT'#000+
   '6*2TMACOS_Macintosh m68k'#000+
@@ -537,61 +539,61 @@ const msgtxt : array[0..00087,1..240] of char=(+
   '**1u<x>_undefines the symbol <x>'#000+
   '**1U_unit options'#000+
   '**2Un_don'#039't check the unit name'#000+
-  '**2Up<x>_same as -Fu<x>'#000+
-  '**2Us_compile a system unit'#000,+
+  '**2U','p<x>_same as -Fu<x>'#000+
+  '**2Us_compile a system unit'#000+
   '**1v<x>_Be verbose. <x> is a combination of the following letters :'#000+
   '**2*_e : Show errors (default)       d : Show debug info'#000+
   '**2*_w : Show warnings               u : Show used files'#000+
-  '**2*_n : Show notes                  t : Show tried files'#000,+
+  '**2*_n : S','how notes                  t : Show tried files'#000+
   '**2*_h : Show hints                  m : Show defined macros'#000+
   '**2*_i : Show general info           p : Show compiled procedures'#000+
   '**2*_l : Show linenumbers            c : Show conditionals'#000+
-  '**2*_a : Show everything             0 : Show nothing ','(except errors'+
+  '**2*_a',' : Show everything             0 : Show nothing (except errors'+
   ')'#000+
   '**2*_b : Show all procedure'#000+
   '**2*_    declarations if an error'#000+
   '**2*_    occurs'#000+
   '**1X_executable options'#000+
   '*L2Xc_link with the c library'#000+
-  '**2XD_link with dynamic libraries (defines FPC_LINK_DYNAMIC)'#000+
-  '**2Xs_strip all symbols from ex','ecutable'#000+
+  '**2XD_link with dynamic libraries (defines F','PC_LINK_DYNAMIC)'#000+
+  '**2Xs_strip all symbols from executable'#000+
   '**2XS_link with static libraries (defines FPC_LINK_STATIC)'#000+
   '**0*_Processor specific options:'#000+
   '3*1A_output format'#000+
   '3*2Ao_coff file using GNU AS'#000+
   '3*2Anasmcoff_coff file using Nasm'#000+
-  '3*2Anasmelf_elf32 (linux) file using Nasm'#000+
-  '3*2Anasmobj_obj',' file using Nasm'#000+
+  '3*2Anasme','lf_elf32 (linux) file using Nasm'#000+
+  '3*2Anasmobj_obj file using Nasm'#000+
   '3*2Amasm_obj using Masm (Mircosoft)'#000+
   '3*2Atasm_obj using Tasm (Borland)'#000+
   '3*1R_assembler reading style'#000+
   '3*2Ratt_read AT&T style assembler'#000+
   '3*2Rintel_read Intel style assembler'#000+
-  '3*2Rdirect_copy assembler text directly to assembler ','file'#000+
+  '3*2Rd','irect_copy assembler text directly to assembler file'#000+
   '3*1O<x>_optimizations'#000+
   '3*2Og_generate smaller code'#000+
   '3*2OG_generate faster code (default)'#000+
   '3*2Or_keep certain variables in registers (still BUGGY!!!)'#000+
-  '3*2Ou_enable uncertain optimizations (see docs)'#000+
-  '3*2O1_level 1 optimizations (quick optimi','zations)'#000+
+  '3*2Ou_enable uncertain optimizations (see',' docs)'#000+
+  '3*2O1_level 1 optimizations (quick optimizations)'#000+
   '3*2O2_level 2 optimizations (-O1 + slower optimizations)'#000+
   '3*2O3_level 3 optimizations (same as -O2u)'#000+
   '3*2Op_target processor'#000+
   '3*3Op1_set target processor to 386/486'#000+
-  '3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#000+
-  '3*3Op3_set tar','get processor to PPro/PII/c6x86/K6 (tm)'#000+
+  '3*3Op2_set target pro','cessor to Pentium/PentiumMMX (tm)'#000+
+  '3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#000+
   '6*1A_output format'#000+
   '6*2Ao_Unix o-file using GNU AS'#000+
   '6*2Agas_GNU Motorola assembler'#000+
   '6*2Amit_MIT Syntax (old GAS)'#000+
   '6*2Amot_Standard Motorola assembler'#000+
-  '6*1O_optimizations'#000+
+  '6*1O_o','ptimizations'#000+
   '6*2Oa_turn on the optimizer'#000+
-  '6*2Og_g','enerate smaller code'#000+
+  '6*2Og_generate smaller code'#000+
   '6*2OG_generate faster code (default)'#000+
   '6*2Ox_optimize maximum (still BUGGY!!!)'#000+
   '6*2O2_set target processor to a MC68020+'#000+
   '**1*_'#000+
   '**1?_shows this help'#000+
-  '**1h_shows this help without waiting'#000
+  '**1h_shows this help witho','ut waiting'#000
 );

compiler/parser.pas

@@ -188,9 +188,13 @@ unit parser;
 
        { reset symtable }
          symtablestack:=nil;
+         defaultsymtablestack:=nil;
+         systemunit:=nil;
+         objpasunit:=nil;
          refsymtable:=nil;
-         procprefix:='';
          aktprocsym:=nil;
+         procprefix:='';
+         registerdef:=true;
          { macros }
          macros:=new(psymtable,init(macrosymtable));
          macros^.name:=stringdup('Conditionals for '+filename);
@@ -219,6 +223,7 @@ unit parser;
        { Load current state from the init values }
          aktlocalswitches:=initlocalswitches;
          aktmoduleswitches:=initmoduleswitches;
+         aktmodeswitches:=initmodeswitches;
          aktpackrecords:=initpackrecords;
          aktpackenum:=initpackenum;
          aktoutputformat:=initoutputformat;
@@ -246,18 +251,6 @@ unit parser;
             AsmRes.Init('ppas');
           end;
 
-         { load system unit always }
-         loadsystemunit;
-
-         registerdef:=true;
-         make_ref:=true;
-
-         { current return type is void }
-         procinfo.retdef:=voiddef;
-
-         { reset lexical level }
-         lexlevel:=0;
-
          { If the compile level > 1 we get a nice "unit expected" error
            message if we are trying to use a program as unit.}
          if (token=_UNIT) or (compile_level>1) then
@@ -283,15 +276,7 @@ unit parser;
 
          { restore old state, close trees, > 0.99.5 has heapblocks, so
            it's the default to release the trees }
-{$ifdef VER0_99_5}
-         if dispose_asm_lists then
-           codegen_donemodule;
-{$else}
-  {$ifdef TP}
-         if dispose_asm_lists then
-  {$endif}
-           codegen_donemodule;
-{$endif}
+         codegen_donemodule;
 
 {$ifdef GDB}
          if cs_debuginfo in aktmoduleswitches then
@@ -386,7 +371,10 @@ unit parser;
 end.
 {
   $Log$
-  Revision 1.49  1998-09-23 15:39:07  pierre
+  Revision 1.50  1998-09-24 23:49:08  peter
+    + aktmodeswitches
+
+  Revision 1.49  1998/09/23 15:39:07  pierre
     * browser bugfixes
       was adding a reference when looking for the symbol
       if -bSYM_NAME was used

compiler/pdecl.pas

@@ -242,14 +242,14 @@ unit pdecl;
              C_name:=orgpattern;
              sc:=idlist;
              consume(COLON);
-             if (cs_gpc_compatible in aktmoduleswitches) and
-               not(is_record or is_object) and
-               (token=ID) and (orgpattern='__asmname__') then
-                 begin
-                    consume(ID);
-                    C_name:=get_stringconst;
-                    Is_gpc_name:=true;
-                 end;
+             if (m_gpc in aktmodeswitches) and
+                not(is_record or is_object) and
+                (token=ID) and (orgpattern='__asmname__') then
+               begin
+                 consume(ID);
+                 C_name:=get_stringconst;
+                 Is_gpc_name:=true;
+               end;
              p:=read_type('');
              symdone:=false;
              if is_gpc_name then
@@ -1029,7 +1029,7 @@ unit pdecl;
            Message(parser_e_no_local_objects);
 
          storetypeforwardsallowed:=typecanbeforward;
-         if cs_tp_compatible in aktmoduleswitches then
+         if m_tp in aktmodeswitches then
            typecanbeforward:=false;
 
          { distinguish classes and objects }
@@ -1465,7 +1465,7 @@ unit pdecl;
          symtablestack:=symtable;
          consume(_RECORD);
          storetypeforwardsallowed:=typecanbeforward;
-         if cs_tp_compatible in aktmoduleswitches then
+         if m_tp in aktmodeswitches then
            typecanbeforward:=false;
          read_var_decs(true,false);
 
@@ -1484,7 +1484,7 @@ unit pdecl;
 
       var
          recsymtable : psymtable;
-         
+
       begin
          if (p^.typ=typesym) then
          if ((p^.properties and sp_forwarddef)<>0) then
@@ -2056,7 +2056,10 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.56  1998-09-23 15:39:09  pierre
+  Revision 1.57  1998-09-24 23:49:09  peter
+    + aktmodeswitches
+
+  Revision 1.56  1998/09/23 15:39:09  pierre
     * browser bugfixes
       was adding a reference when looking for the symbol
       if -bSYM_NAME was used

compiler/pexpr.pas

@@ -683,11 +683,11 @@ unit pexpr;
                { is this an access to a function result ? }
                if assigned(p^.funcretsym) and
                   ((pfuncretsym(sym)=p^.funcretsym) or
-                  ((pvarsym(sym)=opsym) and
-                  ((p^.flags and pi_operator)<>0))) and
+                   ((pvarsym(sym)=opsym) and
+                    ((p^.flags and pi_operator)<>0))) and
                   (p^.retdef<>pdef(voiddef)) and
                   (token<>LKLAMMER) and
-                  (not ((cs_tp_compatible in aktmoduleswitches) and
+                  (not ((m_tp in aktmodeswitches) and
                   (afterassignment or in_args))) then
                  begin
                     p1:=genzeronode(funcretn);
@@ -719,7 +719,7 @@ unit pexpr;
          begin
            { allow post fix operators }
            again:=true;
-           if (cs_delphi2_compatible in aktmoduleswitches) and
+           if (m_result in aktmodeswitches) and
               (pattern='RESULT') and
               assigned(aktprocsym) and
               (procinfo.retdef<>pdef(voiddef)) then
@@ -1748,7 +1748,10 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.54  1998-09-23 15:46:39  florian
+  Revision 1.55  1998-09-24 23:49:10  peter
+    + aktmodeswitches
+
+  Revision 1.54  1998/09/23 15:46:39  florian
     * problem with with and classes fixed
 
   Revision 1.53  1998/09/23 09:58:54  peter

compiler/pmodules.pas

@@ -26,7 +26,6 @@ unit pmodules;
 
   interface
 
-    procedure loadsystemunit;
     procedure proc_unit;
     procedure proc_program(islibrary : boolean);
 
@@ -381,35 +380,51 @@ unit pmodules;
       end;
 
 
-    procedure loadsystemunit;
+    procedure loaddefaultunits;
       var
         hp : pmodule;
       begin
-      { if the current file isn't a system unit the the system unit
-        will be loaded }
-        if not(cs_compilesystem in aktmoduleswitches) then
-          begin
-            hp:=loadunit(upper(target_info.system_unit),true);
-            systemunit:=hp^.symtable;
-          { add to the used units }
-            current_module^.used_units.concat(new(pused_unit,init(hp,true)));
-          { read default constant definitions }
-            make_ref:=false;
-            readconstdefs;
-          { we could try to overload caret by default }
-            symtablestack:=systemunit;
-          { if POWER is defined in the RTL then use it for starstar overloading }
-            getsym('POWER',false);
-            if assigned(srsym) and (srsym^.typ=procsym) and
-               (overloaded_operators[STARSTAR]=nil) then
-              overloaded_operators[STARSTAR]:=pprocsym(srsym);
-            make_ref:=true;
-          end
+      { are we compiling the system unit? }
+        if (cs_compilesystem in aktmoduleswitches) then
+         begin
+         { create system defines }
+           createconstdefs;
+         { we don't need to reset anything, it's already done in parser.pas }
+           exit;
+         end;
+     { insert the system unit, it is allways the first }
+        hp:=loadunit(upper(target_info.system_unit),true);
+        systemunit:=hp^.symtable;
+        { it's always the first unit }
+        systemunit^.next:=nil;
+        symtablestack:=systemunit;
+        { add to the used units }
+        current_module^.used_units.concat(new(pused_unit,init(hp,true)));
+        refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
+        { read default constant definitions }
+        make_ref:=false;
+        readconstdefs;
+        make_ref:=true;
+        { if POWER is defined in the RTL then use it for starstar overloading }
+        getsym('POWER',false);
+        if assigned(srsym) and (srsym^.typ=procsym) and (overloaded_operators[STARSTAR]=nil) then
+          overloaded_operators[STARSTAR]:=pprocsym(srsym);
+      { Objpas unit? }
+        if m_objpas in aktmodeswitches then
+         begin
+           hp:=loadunit('OBJPAS',false);
+           objpasunit:=hp^.symtable;
+           { insert in stack }
+           objpasunit^.next:=symtablestack;
+           symtablestack:=objpasunit;
+           { add to the used units }
+           current_module^.used_units.concat(new(pused_unit,init(hp,true)));
+           refsymtable^.insert(new(punitsym,init('OBJPAS',objpasunit)));
+         end
         else
-          begin
-             createconstdefs;
-             systemunit:=nil;
-          end;
+         objpasunit:=nil;
+      { save default symtablestack }
+        defaultsymtablestack:=symtablestack;
       end;
 
 
@@ -447,7 +462,7 @@ unit pmodules;
          consume(SEMICOLON);
 
          { set the symtable to systemunit so it gets reorderd correctly }
-         symtablestack:=systemunit;
+         symtablestack:=defaultsymtablestack;
 
          { now insert the units in the symtablestack }
          hp:=pused_unit(current_module^.used_units.first);
@@ -519,7 +534,7 @@ unit pmodules;
          if token=ID then
           begin
           { create filenames and unit name }
-             current_module^.SetFileName(current_scanner^.inputfile^.path^+current_scanner^.inputfile^.name^);
+             current_module^.SetFileName(current_scanner^.inputfile^.path^+current_scanner^.inputfile^.name^,true);
              stringdispose(current_module^.modulename);
              current_module^.modulename:=stringdup(upper(pattern));
           { check for system unit }
@@ -555,6 +570,10 @@ unit pmodules;
          { update status }
          status.currentmodule:=current_module^.modulename^;
 
+         { maybe turn off m_objpas if we are compiling objpas }
+         if (current_module^.modulename^='OBJPAS') then
+           aktmodeswitches:=aktmodeswitches-[m_objpas];
+
          { this should be placed after uses !!}
 {$ifndef UseNiceNames}
          procprefix:='_'+current_module^.modulename^+'$$';
@@ -574,23 +593,21 @@ unit pmodules;
          { this also forbids to have another symbol         }
          { with the same name as the unit                   }
          refsymtable^.insert(new(punitsym,init(current_module^.modulename^,unitst)));
-         { set the symbol table for the current unit }
-         { this must be set later for interdependency }
-         { current_module^.symtable:=psymtable(p); }
 
          { a unit compiled at command line must be inside the loaded_unit list }
          if (compile_level=1) then
            loaded_units.insert(current_module);
 
+         { load default units, like the system unit }
+         loaddefaultunits;
+
+         { reset }
+         make_ref:=true;
+         lexlevel:=0;
+
          { insert qualifier for the system unit (allows system.writeln) }
          if not(cs_compilesystem in aktmoduleswitches) then
            begin
-              { insert the system unit }
-              { it is allways the first }
-              systemunit^.next:=nil;
-              symtablestack:=systemunit;
-              refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
-
               if token=_USES then
                 begin
                    unitst^.symtabletype:=unitsymtable;
@@ -600,7 +617,6 @@ unit pmodules;
                      exit;
                    unitst^.symtabletype:=globalsymtable;
                 end;
-
               { ... but insert the symbol table later }
               p^.next:=symtablestack;
               symtablestack:=p;
@@ -667,6 +683,7 @@ unit pmodules;
          { Read the implementation units }
          parse_implementation_uses(unitst);
 
+         { All units are read, now give them a number }
          numberunits;
 
          { now we can change refsymtable }
@@ -739,7 +756,7 @@ unit pmodules;
 
          { avoid self recursive destructor call !! PM }
          aktprocsym^.definition^.localst:=nil;
-         
+
          { unsed static symbols ? }
          symtablestack^.allsymbolsused;
 
@@ -850,12 +867,11 @@ unit pmodules;
          { insert after the unit symbol tables the static symbol table }
          { of the program                                              }
          st:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
-
          current_module^.symtable:=st;
+
          { necessary for browser }
          loaded_units.insert(current_module);
 
-
          {Generate a procsym.}
          make_ref:=false;
          { this was missing !!
@@ -875,12 +891,12 @@ unit pmodules;
 
          refsymtable:=st;
 
+         { load standard units (system,objpas unit) }
+         loaddefaultunits;
 
-         {Insert the symbols of the system unit into the stack of symbol
-          tables.}
-         symtablestack:=systemunit;
-         systemunit^.next:=nil;
-         refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
+         { reset }
+         make_ref:=true;
+         lexlevel:=0;
 
          {Load the units used by the program we compile.}
          if token=_USES then
@@ -926,7 +942,7 @@ unit pmodules;
 
          { avoid self recursive destructor call !! PM }
          aktprocsym^.definition^.localst:=nil;
-         
+
          codegen_doneprocedure;
 
          consume(POINT);
@@ -968,7 +984,10 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.53  1998-09-23 12:20:50  pierre
+  Revision 1.54  1998-09-24 23:49:12  peter
+    + aktmodeswitches
+
+  Revision 1.53  1998/09/23 12:20:50  pierre
     * main program tmodule had no symtable (crashed browser)
     * unit symbols problem fixed !!
 

compiler/pp.pas

@@ -242,10 +242,8 @@ end;
 begin
   oldexit:=exitproc;
   exitproc:=@myexit;
-{$ifndef VER0_99_5}
-  {$ifndef TP}
-    heapblocks:=true;
-  {$endif}
+{$ifndef TP}
+  heapblocks:=true;
 {$endif}
 {$ifdef UseOverlay}
   InitOverlay;
@@ -256,7 +254,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.29  1998-09-17 09:42:41  peter
+  Revision 1.30  1998-09-24 23:49:13  peter
+    + aktmodeswitches
+
+  Revision 1.29  1998/09/17 09:42:41  peter
     + pass_2 for cg386
     * Message() -> CGMessage() for pass_1/pass_2
 

compiler/ppu.pas

@@ -60,7 +60,7 @@ const
   ibdbxcount       = 9;
   ibsymref         = 10;
   ibdefref         = 11;
-  ibendsymtablebrowser = 12;
+  ibendsymtablebrowser   = 12;
   ibbeginsymtablebrowser = 13;
   {syms}
   ibtypesym       = 20;
@@ -112,7 +112,6 @@ type
   ppureal=extended;
 {$endif}
 
-type
   tppuerror=(ppuentrytoobig,ppuentryerror);
 
   tppuheader=packed record
@@ -194,8 +193,6 @@ type
 
 implementation
 
-uses
-  verbose;
 {*****************************************************************************
                                    Crc 32
 *****************************************************************************}
@@ -394,8 +391,6 @@ begin
   blockread(f,buf^,ppubufsize,bufsize);
 {$endif}
   bufidx:=0;
-  if bufsize=0 then
-    Message(unit_f_ppu_read_unexpected_end);
 end;
 
 
@@ -530,7 +525,6 @@ begin
   if change_endian then
    getword:=swap(w)
   else
-
    getword:=w;
   inc(entryidx,2);
 end;
@@ -552,7 +546,6 @@ begin
   if change_endian then
    getlongint:=swap(l shr 16) or (longint(swap(l and $ffff)) shl 16)
   else
-
    getlongint:=l;
   inc(entryidx,4);
 end;
@@ -602,6 +595,7 @@ begin
   skipuntilentry:=(b=untilb);
 end;
 
+
 {*****************************************************************************
                                 TPPUFile Writing
 *****************************************************************************}
@@ -740,7 +734,6 @@ begin
 end;
 
 
-
 procedure tppufile.putbyte(b:byte);
 begin
   writedata(b,1);
@@ -779,7 +772,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.15  1998-09-23 15:39:10  pierre
+  Revision 1.16  1998-09-24 23:49:14  peter
+    + aktmodeswitches
+
+  Revision 1.15  1998/09/23 15:39:10  pierre
     * browser bugfixes
       was adding a reference when looking for the symbol
       if -bSYM_NAME was used

compiler/pstatmnt.pas

@@ -1027,7 +1027,7 @@ unit pstatmnt;
            begin
               if (token=INTCONST) or
                 ((token=ID) and
-                not((cs_delphi2_compatible in aktmoduleswitches) and
+                not((m_result in aktmodeswitches) and
                 (pattern='RESULT'))) then
                 begin
                    getsym(pattern,true);
@@ -1226,7 +1226,10 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.40  1998-09-23 21:53:04  florian
+  Revision 1.41  1998-09-24 23:49:15  peter
+    + aktmodeswitches
+
+  Revision 1.40  1998/09/23 21:53:04  florian
     * the following doesn't work: on texception do, was a parser error, fixed
 
   Revision 1.39  1998/09/21 10:26:07  peter

compiler/psystem.pas

@@ -196,8 +196,11 @@ procedure createconstdefs;
 {
   Create all default definitions for consts for the system unit
 }
+var
+  oldregisterdef : boolean;
 begin
   { create definitions for constants }
+  oldregisterdef:=registerdef;
   registerdef:=false;
   voiddef:=new(porddef,init(uvoid,0,0));
   u8bitdef:=new(porddef,init(u8bit,0,255));
@@ -226,13 +229,17 @@ begin
   { some other definitions }
   voidpointerdef:=new(ppointerdef,init(voiddef));
   cfiledef:=new(pfiledef,init(ft_untyped,nil));
+  registerdef:=oldregisterdef;
 end;
 
 
 end.
 {
   $Log$
-  Revision 1.5  1998-08-10 14:50:19  peter
+  Revision 1.6  1998-09-24 23:49:17  peter
+    + aktmodeswitches
+
+  Revision 1.5  1998/08/10 14:50:19  peter
     + localswitches, moduleswitches, globalswitches splitting
 
   Revision 1.4  1998/06/25 14:04:24  peter

compiler/ptconst.pas

@@ -418,7 +418,7 @@ unit ptconst;
                    exit;
                 end
               else
-              if not(cs_tp_compatible in aktmoduleswitches) then
+              if not(m_tp_procvar in aktmodeswitches) then
                 if token=KLAMMERAFFE then
                   consume(KLAMMERAFFE);
               getsym(pattern,true);
@@ -511,7 +511,10 @@ unit ptconst;
 end.
 {
   $Log$
-  Revision 1.15  1998-09-07 18:46:11  peter
+  Revision 1.16  1998-09-24 23:49:18  peter
+    + aktmodeswitches
+
+  Revision 1.15  1998/09/07 18:46:11  peter
     * update smartlinking, uses getdatalabel
     * renamed ptree.value vars to value_str,value_real,value_set
 

compiler/scandir.inc

@@ -35,7 +35,7 @@ type
      _DIR_I,_DIR_I386_ATT,_DIR_I386_DIRECT,_DIR_I386_INTEL,_DIR_IOCHECKS,
        _DIR_IF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_INCLUDE,_DIR_INFO,
      _DIR_L,_DIR_LINK,_DIR_LINKLIB,_DIR_LOCALSYMBOLS,_DIR_LONGSTRINGS,
-     _DIR_M,_DIR_MEMORY,_DIR_MESSAGE,_DIR_MINENUMSIZE,_DIR_MMX,
+     _DIR_M,_DIR_MEMORY,_DIR_MESSAGE,_DIR_MINENUMSIZE,_DIR_MMX,_DIR_MODE,
      _DIR_NOTE,_DIR_NOTES,
      _DIR_OPENSTRINGS,_DIR_OUTPUT_FORMAT,_DIR_OVERFLOWCHECKS,
      _DIR_PACKENUM,_DIR_PACKRECORDS,
@@ -61,7 +61,7 @@ const
      'I','I386_ATT','I386_DIRECT','I386_INTEL','IOCHECKS',
        'IF','IFDEF','IFNDEF','IFOPT','INCLUDE','INFO',
      'L','LINK','LINKLIB','LOCALSYMBOLS','LONGSTRINGS',
-     'M','MEMORY','MESSAGE','MINENUMSIZE','MMX',
+     'M','MEMORY','MESSAGE','MINENUMSIZE','MMX','MODE',
      'NOTE','NOTES',
      'OPENSTRINGS','OUTPUT_FORMAT','OVERFLOWCHECKS',
      'PACKENUM','PACKRECORDS',
@@ -603,6 +603,35 @@ const
       end;
 
 
+    procedure dir_mode(t:tdirectivetoken);
+      begin
+        if not current_module^.in_global then
+         Message(scan_w_switch_is_global)
+        else
+          begin
+            current_scanner^.skipspace;
+            current_scanner^.readstring;
+            if pattern='DEFAULT' then
+             aktmodeswitches:=initmodeswitches
+            else
+             if pattern='DELPHI' then
+              aktmodeswitches:=delphimodeswitches
+            else
+             if pattern='TP' then
+              aktmodeswitches:=tpmodeswitches
+            else
+             if pattern='FPC' then
+              aktmodeswitches:=fpcmodeswitches
+            else
+             if pattern='OBJFPC' then
+              aktmodeswitches:=objfpcmodeswitches
+            else
+             if pattern='GPC' then
+              aktmodeswitches:=gpcmodeswitches;
+          end;
+      end;
+
+
     procedure dir_packrecords(t:tdirectivetoken);
       var
         hs : string;
@@ -742,16 +771,16 @@ const
            if l>1024 then
             heapsize:=l;
          end;
-	if c=',' then
-	 begin
-	   current_scanner^.readchar;
-	   current_scanner^.skipspace;
-	   l:=current_scanner^.readval;
-	   if l>1024 then
-		maxheapsize:=l;
-	 end;
-	if heapsize>maxheapsize then
-	    message(scan_w_illegal_switch);
+        if c=',' then
+         begin
+           current_scanner^.readchar;
+           current_scanner^.skipspace;
+           l:=current_scanner^.readval;
+           if l>1024 then
+            maxheapsize:=l;
+         end;
+        if heapsize>maxheapsize then
+          message(scan_w_illegal_switch);
       end;
 
 
@@ -814,6 +843,7 @@ const
          {_DIR_MESSAGE} dir_message,
          {_DIR_MINENUMSIZE} dir_packenum,
          {_DIR_MMX} dir_localswitch,
+         {_DIR_MODE} dir_mode,
          {_DIR_NOTE} dir_message,
          {_DIR_NOTES} dir_setverbose,
          {_DIR_OPENSTRINGS} dir_delphiswitch,
@@ -867,9 +897,9 @@ const
                hs:=current_scanner^.readid;
                if (hs='') then
                 begin
-                  if (c='$') and not(cs_tp_compatible in aktmoduleswitches) then
+                  if (c='$') and (m_fpc in aktmodeswitches) then
                    begin
-                     current_scanner^.readchar; { skip $ }
+                     current_scanner^.readchar;  { skip $ }
                      hs:=current_scanner^.readid;
                    end;
                   if (hs='') then
@@ -905,7 +935,10 @@ const
 
 {
   $Log$
-  Revision 1.31  1998-09-18 16:03:44  florian
+  Revision 1.32  1998-09-24 23:49:19  peter
+    + aktmodeswitches
+
+  Revision 1.31  1998/09/18 16:03:44  florian
     * some changes to compile with Delphi
 
   Revision 1.30  1998/09/16 16:41:47  peter

compiler/scanner.pas

@@ -523,11 +523,10 @@ implementation
 
     procedure tscannerfile.dec_comment_level;
       begin
-         if (cs_tp_compatible in aktmoduleswitches) or
-            (cs_delphi2_compatible in aktmoduleswitches) then
-           comment_level:=0
+         if (m_nested_comment in aktmodeswitches) then
+           dec(comment_level)
          else
-           dec(comment_level);
+           comment_level:=0;
       end;
 
 
@@ -1510,7 +1509,10 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.52  1998-09-18 16:03:45  florian
+  Revision 1.53  1998-09-24 23:49:20  peter
+    + aktmodeswitches
+
+  Revision 1.52  1998/09/18 16:03:45  florian
     * some changes to compile with Delphi
 
   Revision 1.51  1998/09/16 16:41:49  peter

compiler/tccnv.pas

@@ -628,7 +628,7 @@ implementation
            own resulttype. They will therefore always be incompatible with
            a procvar. Because isconvertable cannot check for procedures we
            use an extra check for them.}
-           if (cs_tp_compatible in aktmoduleswitches) and
+           if (m_tp_procvar in aktmodeswitches) and
              ((is_procsym_load(p^.left) or is_procsym_call(p^.left)) and
              (p^.resulttype^.deftype=procvardef)) then
              begin
@@ -814,7 +814,7 @@ implementation
             if (p^.left^.treetype=ordconstn) and is_ordinal(p^.resulttype) then
               begin
                  { perform range checking }
-                 if not(p^.explizit and (cs_tp_compatible in aktmoduleswitches)) then
+                 if not(p^.explizit and (m_tp in aktmodeswitches)) then
                    testrange(p^.resulttype,p^.left^.value);
                  hp:=genordinalconstnode(p^.left^.value,p^.resulttype);
                  disposetree(p);
@@ -898,7 +898,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  1998-09-23 20:42:24  peter
+  Revision 1.2  1998-09-24 23:49:22  peter
+    + aktmodeswitches
+
+  Revision 1.1  1998/09/23 20:42:24  peter
     * splitted pass_1
 
 }

compiler/tcmem.pas

@@ -178,7 +178,7 @@ implementation
                    { result is a procedure variable }
                    { No, to be TP compatible, you must return a pointer to
                      the procedure that is stored in the procvar.}
-                   if not(cs_tp_compatible in aktmoduleswitches) then
+                   if not(m_tp_procvar in aktmodeswitches) then
                      begin
                         p^.resulttype:=new(pprocvardef,init);
 
@@ -500,7 +500,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  1998-09-23 20:42:24  peter
+  Revision 1.2  1998-09-24 23:49:24  peter
+    + aktmodeswitches
+
+  Revision 1.1  1998/09/23 20:42:24  peter
     * splitted pass_1
 
 }