Преглед изворни кода

* fixed message methods
* fixed typo with win32 dll import from implementation
* released external check

peter пре 21 година
родитељ
комит
29d3a94892
2 измењених фајлова са 47 додато и 28 уклоњено
  1. 38 16
      compiler/pdecsub.pas
  2. 9 12
      compiler/symdef.pas

+ 38 - 16
compiler/pdecsub.pas

@@ -306,7 +306,6 @@ implementation
          end;
       end;
 
-
     procedure check_c_para(p:tnamedindexitem;arg:pointer);
       begin
         if (tsym(p).typ<>paravarsym) then
@@ -333,6 +332,23 @@ implementation
       end;
 
 
+    procedure check_msg_para(p:tnamedindexitem;arg:pointer);
+      begin
+        if (tsym(p).typ<>paravarsym) then
+         exit;
+        with tparavarsym(p) do
+          begin
+            { Count parameters }
+            if (paranr>=10) then
+              inc(plongint(arg)^);
+            { First parameter must be var }
+            if (paranr=10) and
+               (varspez<>vs_var) then
+              Message(parser_e_ill_msg_param);
+          end;
+      end;
+
+
     procedure check_inline_para(p:tnamedindexitem;arg:pointer);
       var
         pd : tabstractprocdef absolute arg;
@@ -599,7 +615,7 @@ implementation
       var
         orgsp,sp : stringid;
         sym : tsym;
-	srsym : tsym;
+        srsym : tsym;
         srsymtable : tsymtable;
         storepos,
         procstartfilepos : tfileposinfo;
@@ -743,10 +759,10 @@ implementation
 
              { Check if overloaded is a procsym }
              if assigned(srsym) then
-	       begin
-	         if srsym.typ=procsym then
-		   aprocsym:=tprocsym(srsym)
-		 else
+               begin
+                 if srsym.typ=procsym then
+                   aprocsym:=tprocsym(srsym)
+                 else
                    begin
                      { when the other symbol is a unit symbol then hide the unit
                        symbol }
@@ -766,7 +782,7 @@ implementation
                           error when inserting the symbol in the symtable }
                         orgsp:=orgsp+'$'+tostr(aktfilepos.line);
                       end;
- 	           end;
+                   end;
               end;
            until not searchagain;
          end;
@@ -1149,15 +1165,16 @@ end;
 procedure pd_message(pd:tabstractprocdef);
 var
   pt : tnode;
+  paracnt : longint;
 begin
   if pd.deftype<>procdef then
     internalerror(2003042613);
   if not is_class(tprocdef(pd)._class) then
     Message(parser_e_msg_only_for_classes);
   { check parameter type }
-  if ((pd.minparacount<>1) or
-      (pd.maxparacount<>1) or
-      (tparavarsym(pd.paras[0]).varspez<>vs_var)) then
+  paracnt:=0;
+  pd.parast.foreach_static(@check_msg_para,@paracnt);
+  if paracnt<>1 then
     Message(parser_e_ill_msg_param);
   pt:=comp_expr(true);
   if pt.nodetype=stringconstn then
@@ -1812,7 +1829,8 @@ const
                       with Delphi and TP7 }
                     if not(
                            assigned(pd.import_dll) and
-                           (target_info.system in [system_i386_win32,system_i386_wdosx])
+                           (target_info.system in [system_i386_win32,system_i386_wdosx,
+                                                   system_i386_emx,system_i386_os2])
                           ) then
                       pd.setmangledname(pd.import_name^);
                   end
@@ -2177,16 +2195,15 @@ const
                      { Body declaration is external? }
                      if (po_external in pd.procoptions) then
                        begin
-{$ifdef EXTDEBUG}
                          { Win32 supports declaration in interface and external in
                            implementation for dll imports. Support this for backwards
                            compatibility with Tp7 and Delphi }
                          if not(
-                                (target_info.system in [system_i386_win32,system_i386_wdosx]) and
+                                (target_info.system in [system_i386_win32,system_i386_wdosx,
+                                                        system_i386_emx,system_i386_os2]) and
                                 assigned(pd.import_dll)
                                ) then
                            MessagePos(pd.fileinfo,parser_e_proc_no_external_allowed);
-{$endif EXTDEBUG}
                        end;
 
                    { Check parameters }
@@ -2242,7 +2259,7 @@ const
                    if assigned(pd.import_dll) then
                      begin
                        stringdispose(hd.import_dll);
-                       hd.import_name:=stringdup(pd.import_dll^);
+                       hd.import_dll:=stringdup(pd.import_dll^);
                      end;
                    if assigned(pd.import_name) then
                      begin
@@ -2329,7 +2346,12 @@ const
 end.
 {
   $Log$
-  Revision 1.210  2004-11-19 08:17:01  michael
+  Revision 1.211  2004-11-21 16:33:19  peter
+    * fixed message methods
+    * fixed typo with win32 dll import from implementation
+    * released external check
+
+  Revision 1.210  2004/11/19 08:17:01  michael
   * Split po_public into po_public and po_global (Peter)
 
   Revision 1.209  2004/11/17 22:41:41  peter

+ 9 - 12
compiler/symdef.pas

@@ -2888,13 +2888,13 @@ implementation
         cachedelecount:=elecount;
         { prevent overflow, return -1 to indicate overflow }
         if (cachedelesize <> 0) and
-	   (
-	    (cachedelecount < 0) or
+           (
+            (cachedelecount < 0) or
             ((high(aint) div cachedelesize) < cachedelecount) or
             { also lowrange*elesize must be < high(aint) to prevent overflow when
               accessing the array, see ncgmem (PFV) }
             ((high(aint) div cachedelesize) < abs(lowrange))
- 	   ) then
+           ) then
           result:=-1
         else
           result:=cachedelesize*cachedelecount;
@@ -4368,19 +4368,11 @@ implementation
 
     procedure tprocdef.setmangledname(const s : string);
       begin
-{$ifdef EXTDEBUG}
         { This is not allowed anymore, the forward declaration
           already needs to create the correct mangledname, no changes
           afterwards are allowed (PFV) }
         if assigned(_mangledname) then
           internalerror(200411171);
-{$else}
-        if assigned(_mangledname) then
-          begin
-            objectlibrary.renameasmsymbol(_mangledname^,s);
-            stringdispose(_mangledname);
-          end;
-{$endif EXTDEBUG}
       {$ifdef compress}
         _mangledname:=stringdup(minilzw_encode(s));
       {$else}
@@ -6142,7 +6134,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.274  2004-11-17 22:41:41  peter
+  Revision 1.275  2004-11-21 16:33:19  peter
+    * fixed message methods
+    * fixed typo with win32 dll import from implementation
+    * released external check
+
+  Revision 1.274  2004/11/17 22:41:41  peter
     * make some checks EXTDEBUG only for now so linux cycles again
 
   Revision 1.273  2004/11/17 22:21:35  peter