ソースを参照

* classes get a vmt allways
* better error info (tried to remove
several error strings introduced by the tpexcept handling)

pierre 27 年 前
コミット
1dfbb756e9
6 ファイル変更53 行追加17 行削除
  1. 7 1
      compiler/comphook.pas
  2. 1 1
      compiler/msgidx.inc
  3. 1 1
      compiler/msgtxt.inc
  4. 14 3
      compiler/pdecl.pas
  5. 20 8
      compiler/pmodules.pas
  6. 10 3
      compiler/verbose.pas

+ 7 - 1
compiler/comphook.pas

@@ -58,6 +58,7 @@ type
   { Settings for the output }
     verbosity     : longint;
     maxerrorcount : longint;
+    skip_error,
     use_stderr,
     use_redir,
     use_gccoutput : boolean;
@@ -253,7 +254,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.9  1998-10-26 17:15:16  pierre
+  Revision 1.10  1998-10-27 13:45:25  pierre
+    * classes get a vmt allways
+    * better error info (tried to remove
+      several error strings introduced by the tpexcept handling)
+
+  Revision 1.9  1998/10/26 17:15:16  pierre
     + added two level of longjump to
       allow clean freeing of used memory on errors
 

+ 1 - 1
compiler/msgidx.inc

@@ -71,7 +71,7 @@ type tmsgconst=(
   parser_w_destructor_should_be_public,
   parser_n_only_one_destructor,
   parser_e_no_local_objects,
-  parser_e_no_anonym_objects,
+  parser_f_no_anonym_objects,
   parser_e_illegal_parameter_list,
   parser_e_wrong_parameter_type,
   parser_e_wrong_parameter_size,

+ 1 - 1
compiler/msgtxt.inc

@@ -71,7 +71,7 @@ const msgtxt : array[0..00094,1..240] of char=(
   'W_Destructor should be public'#000+
   'N_Class should have one destructor only'#000+
   'E_Local class definitions ar','e not allowed'#000+
-  'E_Anonym class definitions are not allowed'#000+
+  'F_Anonym class definitions are not allowed'#000+
   'E_Illegal parameter list'#000+
   'E_Wrong parameter type specified'#000+
   'E_Wrong amount of parameters specified'#000+

+ 14 - 3
compiler/pdecl.pas

@@ -1114,7 +1114,9 @@ unit pdecl;
                 begin
                    { also anonym objects aren't allow (o : object a : longint; end;) }
                    if n='' then
-                    Message(parser_e_no_anonym_objects);
+                    begin
+                       Message(parser_f_no_anonym_objects)
+                    end;
                    if n='TOBJECT' then
                      begin
                         aktclass:=new(pobjectdef,init(n,nil));
@@ -1123,6 +1125,10 @@ unit pdecl;
                    else
                      aktclass:=new(pobjectdef,init(n,nil));
                    aktclass^.options:=aktclass^.options or oo_is_class or oo_isforward;
+                   { all classes must have a vmt !!  at offset zero }
+                   if (aktclass^.options and oo_hasvmt)=0 then
+                     aktclass^.insertvmt;
+                   
                    object_dec:=aktclass;
                    exit;
                 end;
@@ -1130,7 +1136,7 @@ unit pdecl;
 
          { also anonym objects aren't allow (o : object a : longint; end;) }
          if n='' then
-           Message(parser_e_no_anonym_objects);
+           Message(parser_f_no_anonym_objects);
 
          { read the parent class }
          if token=LKLAMMER then
@@ -2082,7 +2088,12 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.77  1998-10-26 22:58:20  florian
+  Revision 1.78  1998-10-27 13:45:33  pierre
+    * classes get a vmt allways
+    * better error info (tried to remove
+      several error strings introduced by the tpexcept handling)
+
+  Revision 1.77  1998/10/26 22:58:20  florian
     * new introduded problem with classes fix, the parent class wasn't set
       correct, if the class was defined forward before
 

+ 20 - 8
compiler/pmodules.pas

@@ -616,7 +616,8 @@ unit pmodules;
 
       function is_assembler_generated:boolean;
       begin
-        is_assembler_generated:=not(
+        is_assembler_generated:=(status.errorcount=0) and
+          not(
           codesegment^.empty and
           datasegment^.empty and
           bsssegment^.empty and
@@ -763,9 +764,10 @@ unit pmodules;
 {$endif GDB}
 
          { leave when we got an error }
-         if status.errorcount>0 then
+         if (status.errorcount>0) and not status.skip_error then
           begin
             Message1(unit_f_errors_in_unit,tostr(status.errorcount));
+            status.skip_error:=true;
             exit;
           end;
 
@@ -876,7 +878,8 @@ unit pmodules;
          { absence does not matter here !! }
          aktprocsym^.definition^.forwarddef:=false;
          { test static symtable }
-         st^.allsymbolsused;
+         if (status.errorcount=0) then
+           st^.allsymbolsused;
 
          { size of the static data }
          datasize:=st^.datasize;
@@ -893,7 +896,8 @@ unit pmodules;
 {$endif GDB}
 
          { tests, if all (interface) forwards are resolved }
-         symtablestack^.check_forwards;
+         if (status.errorcount=0) then
+           symtablestack^.check_forwards;
 
          { now we have a correct unit, change the symtable type }
          current_module^.in_implementation:=false;
@@ -903,9 +907,10 @@ unit pmodules;
 {$endif GDB}
 
          { leave when we got an error }
-         if status.errorcount>0 then
+         if (status.errorcount>0) and not status.skip_error then
           begin
             Message1(unit_f_errors_in_unit,tostr(status.errorcount));
+            status.skip_error:=true;
             exit;
           end;
 
@@ -921,7 +926,8 @@ unit pmodules;
            current_module^.flags:=current_module^.flags or uf_in_library;
 
          { Write out the ppufile }
-         writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack));
+         if (status.errorcount=0) then
+           writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack));
 
          { write local browser }
 {$ifdef UseBrowser}
@@ -1052,9 +1058,10 @@ unit pmodules;
          consume(POINT);
 
          { leave when we got an error }
-         if status.errorcount>0 then
+         if (status.errorcount>0) and not status.skip_error then
           begin
             Message1(unit_f_errors_in_unit,tostr(status.errorcount));
+            status.skip_error:=true;
             exit;
           end;
 
@@ -1091,7 +1098,12 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.74  1998-10-26 09:34:50  peter
+  Revision 1.75  1998-10-27 13:45:35  pierre
+    * classes get a vmt allways
+    * better error info (tried to remove
+      several error strings introduced by the tpexcept handling)
+
+  Revision 1.74  1998/10/26 09:34:50  peter
     * unit check name works now for all units, not only systemunit
 
   Revision 1.73  1998/10/22 23:53:27  peter

+ 10 - 3
compiler/verbose.pas

@@ -308,9 +308,10 @@ begin
 { show comment }
   if do_comment(l,s) or dostop then
    stop;
-  if (status.errorcount>=status.maxerrorcount) then
+  if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
    begin
      Message1(unit_f_errors_in_unit,tostr(status.errorcount));
+     status.skip_error:=true;
      stop;
    end;
 end;
@@ -370,9 +371,10 @@ begin
 { show comment }
   if do_comment(v,s) or dostop then
    stop;
-  if (status.errorcount>=status.maxerrorcount) then
+  if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
    begin
      Message1(unit_f_errors_in_unit,tostr(status.errorcount));
+     status.skip_error:=true;
      stop;
    end;
 end;
@@ -425,7 +427,12 @@ end.
 
 {
   $Log$
-  Revision 1.25  1998-10-22 15:18:49  florian
+  Revision 1.26  1998-10-27 13:45:38  pierre
+    * classes get a vmt allways
+    * better error info (tried to remove
+      several error strings introduced by the tpexcept handling)
+
+  Revision 1.25  1998/10/22 15:18:49  florian
     + switch -vx for win32 added
 
   Revision 1.24  1998/10/08 17:17:39  pierre