فهرست منبع

* Message system uses open arrays internally
* Bugfix for string handling in array constructor node
* Micro code reductions in pdecl.pas

daniel 21 سال پیش
والد
کامیت
4e89e4be76
4فایلهای تغییر یافته به همراه100 افزوده شده و 123 حذف شده
  1. 37 75
      compiler/cmsgs.pas
  2. 11 2
      compiler/ncgld.pas
  3. 35 34
      compiler/pdecl.pas
  4. 17 12
      compiler/verbose.pas

+ 37 - 75
compiler/cmsgs.pas

@@ -53,11 +53,7 @@ type
     procedure ClearIdx;
     procedure CreateIdx;
     function  GetPChar(nr:longint):pchar;
-    function  Get(nr:longint):string;
-    function  Get4(nr:longint;const s1,s2,s3,s4:string):string;
-    function  Get3(nr:longint;const s1,s2,s3:string):string;
-    function  Get2(nr:longint;const s1,s2:string):string;
-    function  Get1(nr:longint;const s1:string):string;
+    function  Get(nr:longint;const args:array of string):string;
   end;
 
 { this will read a line until #10 or #0 and also increase p }
@@ -75,43 +71,33 @@ uses
 {$endif DELPHI}
 
 
-    function MsgReplace(const s,s1,s2,s3,s4:string):string;
-      var
-        last,
-        i  : longint;
-        hs : string;
-      begin
-        if s='' then
-         begin
-           MsgReplace:='';
-           exit;
-         end;
-        hs:='';
-        i:=0;
-        last:=0;
-        while (i<length(s)-1) do
-         begin
-           inc(i);
-           if (s[i]='$') and
-              (s[i+1] in ['1'..'4']) then
-            begin
-              hs:=hs+copy(s,last+1,i-last-1);
-              case s[i+1] of
-               '1' :
-                 hs:=hs+s1;
-               '2' :
-                 hs:=hs+s2;
-               '3' :
-                 hs:=hs+s3;
-               '4' :
-                 hs:=hs+s4;
-              end;
-              inc(i);
-              last:=i;
-            end;
-         end;
-        MsgReplace:=hs+copy(s,last+1,length(s)-last);;
-      end;
+function MsgReplace(const s:string;const args:array of string):string;
+var
+  last,
+  i  : longint;
+  hs : string;
+
+begin
+  if s='' then
+    begin
+      MsgReplace:='';
+      exit;
+    end;
+  hs:='';
+  i:=0;
+  last:=0;
+  while (i<length(s)-1) do
+    begin
+      inc(i);
+      if (s[i]='$') and (s[i+1] in ['1'..'9']) then
+        begin
+          hs:=hs+copy(s,last+1,i-last-1)+args[byte(s[i+1])-byte('1')];
+          inc(i);
+          last:=i;
+        end;
+    end;
+  MsgReplace:=hs+copy(s,last+1,length(s)-last);;
+end;
 
 
 
@@ -418,50 +404,26 @@ begin
 end;
 
 
-function TMessage.Get(nr:longint):string;
+function TMessage.Get(nr:longint;const args:array of string):string;
 var
-  s : string[16];
   hp : pchar;
 begin
   hp:=msgidx[nr div 1000]^[nr mod 1000];
   if hp=nil then
-   begin
-     Str(nr,s);
-     Get:='msg nr '+s;
-   end
+    Get:='msg nr '+tostr(nr)
   else
-   Get:=StrPas(hp);
+    Get:=MsgReplace(strpas(hp),args);
 end;
 
-
-function TMessage.Get4(nr:longint;const s1,s2,s3,s4:string):string;
-begin
-  Get4:=MsgReplace(Get(nr),s1,s2,s3,s4);
-end;
-
-
-function TMessage.Get3(nr:longint;const s1,s2,s3:string):string;
-begin
-  Get3:=MsgReplace(Get(nr),s1,s2,s3,'');
-end;
-
-
-function TMessage.Get2(nr:longint;const s1,s2:string):string;
-begin
-  Get2:=MsgReplace(Get(nr),s1,s2,'','');
-end;
-
-
-function TMessage.Get1(nr:longint;const s1:string):string;
-begin
-  Get1:=MsgReplace(Get(nr),s1,'','','');
-end;
-
-
 end.
 {
   $Log$
-  Revision 1.9  2004-01-28 15:36:46  florian
+  Revision 1.10  2004-02-20 19:49:21  daniel
+    * Message system uses open arrays internally
+    * Bugfix for string handling in array constructor node
+    * Micro code reductions in pdecl.pas
+
+  Revision 1.9  2004/01/28 15:36:46  florian
     * fixed another couple of arm bugs
 
   Revision 1.8  2003/05/10 23:57:23  florian

+ 11 - 2
compiler/ncgld.pas

@@ -868,7 +868,11 @@ implementation
                    LOC_CREFERENCE :
                      begin
                        location_release(exprasmlist,hp.left.location);
-                       cg.g_concatcopy(exprasmlist,hp.left.location.reference,href,elesize,freetemp,false);
+                       if is_shortstring(hp.left.resulttype.def) then
+                         cg.g_copyshortstring(exprasmlist,hp.left.location.reference,href,
+                                              Tstringdef(hp.left.resulttype.def).len,freetemp,false)
+                       else
+                         cg.g_concatcopy(exprasmlist,hp.left.location.reference,href,elesize,freetemp,false);
                      end;
                    else
                      begin
@@ -899,7 +903,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.108  2004-02-08 17:45:53  jonas
+  Revision 1.109  2004-02-20 19:49:21  daniel
+    * Message system uses open arrays internally
+    * Bugfix for string handling in array constructor node
+    * Micro code reductions in pdecl.pas
+
+  Revision 1.108  2004/02/08 17:45:53  jonas
     * fixed regvars
 
   Revision 1.107  2004/02/05 01:24:08  florian

+ 35 - 34
compiler/pdecl.pas

@@ -428,13 +428,7 @@ implementation
            consume(_ID);
            consume(_EQUAL);
            { support 'ttype=type word' syntax }
-           if token=_TYPE then
-             begin
-                Consume(_TYPE);
-                unique:=true;
-             end
-           else
-             unique:=false;
+           unique:=try_to_consume(_TYPE);
            { is the type already defined? }
            searchsym(typename,sym,srsymtable);
            newtype:=nil;
@@ -551,28 +545,29 @@ implementation
                 it can contain a reference to that data (PFV)
                 This is not for forward classes }
               if (tt.def.deftype=objectdef) then
-               begin
-                 if not(oo_is_forward in tobjectdef(tt.def).objectoptions) then
-                   begin
-                     ch:=cclassheader.create(tobjectdef(tt.def));
-                     { generate and check virtual methods, must be done
-                       before RTTI is written }
-                     ch.genvmt;
-                     { Generate RTTI for class }
-                     generate_rtti(newtype);
-                     if is_interface(tobjectdef(tt.def)) then
-                       ch.writeinterfaceids;
-                     if (oo_has_vmt in tobjectdef(tt.def).objectoptions) then
-                       ch.writevmt;
-                     ch.free;
-                   end;
-               end
+                with Tobjectdef(tt.def) do
+                  begin
+                    if not(oo_is_forward in objectoptions) then
+                      begin
+                        ch:=cclassheader.create(tobjectdef(tt.def));
+                        { generate and check virtual methods, must be done
+                          before RTTI is written }
+                        ch.genvmt;
+                        { Generate RTTI for class }
+                        generate_rtti(newtype);
+                        if is_interface(tobjectdef(tt.def)) then
+                          ch.writeinterfaceids;
+                        if (oo_has_vmt in objectoptions) then
+                          ch.writevmt;
+                        ch.free;
+                      end;
+                   end
               else
-               begin
-                 { Always generate RTTI info for all types. This is to have typeinfo() return
-                   the same pointer }
-                 generate_rtti(newtype);
-               end;
+                begin
+                  { Always generate RTTI info for all types. This is to have typeinfo() return
+                    the same pointer }
+                  generate_rtti(newtype);
+                end;
 
               aktfilepos:=oldfilepos;
             end;
@@ -658,11 +653,12 @@ implementation
                              Message(cg_e_illegal_expression);
                         end;
                       stringconstn:
-                        begin
-                           getmem(sp,tstringconstnode(p).len+1);
-                           move(tstringconstnode(p).value_str^,sp^,tstringconstnode(p).len+1);
-                           symtablestack.insert(tconstsym.create_string(orgname,constresourcestring,sp,tstringconstnode(p).len));
-                        end;
+                        with Tstringconstnode(p) do
+                          begin
+                             getmem(sp,len+1);
+                             move(value_str^,sp^,len+1);
+                             symtablestack.insert(tconstsym.create_string(orgname,constresourcestring,sp,len));
+                          end;
                       else
                         Message(cg_e_illegal_expression);
                    end;
@@ -679,7 +675,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.81  2004-02-17 19:37:16  daniel
+  Revision 1.82  2004-02-20 19:49:21  daniel
+    * Message system uses open arrays internally
+    * Bugfix for string handling in array constructor node
+    * Micro code reductions in pdecl.pas
+
+  Revision 1.81  2004/02/17 19:37:16  daniel
     * No longer treat threadvar is normakl var if threading off
 
   Revision 1.80  2004/02/17 17:38:11  daniel

+ 17 - 12
compiler/verbose.pas

@@ -289,7 +289,7 @@ var
           s : string;
           idx : longint;
         begin
-          s:=msg^.get(w);
+          s:=msg^.get(w,[]);
           idx:=pos('_',s);
           if idx>0 then
            Loadprefix:=Copy(s,idx+1,255)
@@ -579,35 +579,35 @@ var
     procedure Message(w:longint);
       begin
         MaybeLoadMessageFile;
-        Msg2Comment(msg^.Get(w));
+        Msg2Comment(msg^.Get(w,[]));
       end;
 
 
     procedure Message1(w:longint;const s1:string);
       begin
         MaybeLoadMessageFile;
-        Msg2Comment(msg^.Get1(w,s1));
+        Msg2Comment(msg^.Get(w,[s1]));
       end;
 
 
     procedure Message2(w:longint;const s1,s2:string);
       begin
         MaybeLoadMessageFile;
-        Msg2Comment(msg^.Get2(w,s1,s2));
+        Msg2Comment(msg^.Get(w,[s1,s2]));
       end;
 
 
     procedure Message3(w:longint;const s1,s2,s3:string);
       begin
         MaybeLoadMessageFile;
-        Msg2Comment(msg^.Get3(w,s1,s2,s3));
+        Msg2Comment(msg^.Get(w,[s1,s2,s3]));
       end;
 
 
     procedure Message4(w:longint;const s1,s2,s3,s4:string);
       begin
         MaybeLoadMessageFile;
-        Msg2Comment(msg^.Get4(w,s1,s2,s3,s4));
+        Msg2Comment(msg^.Get(w,[s1,s2,s3,s4]));
       end;
 
 
@@ -618,7 +618,7 @@ var
         oldpos:=aktfilepos;
         aktfilepos:=pos;
         MaybeLoadMessageFile;
-        Msg2Comment(msg^.Get(w));
+        Msg2Comment(msg^.Get(w,[]));
         aktfilepos:=oldpos;
       end;
 
@@ -630,7 +630,7 @@ var
         oldpos:=aktfilepos;
         aktfilepos:=pos;
         MaybeLoadMessageFile;
-        Msg2Comment(msg^.Get1(w,s1));
+        Msg2Comment(msg^.Get(w,[s1]));
         aktfilepos:=oldpos;
       end;
 
@@ -642,7 +642,7 @@ var
         oldpos:=aktfilepos;
         aktfilepos:=pos;
         MaybeLoadMessageFile;
-        Msg2Comment(msg^.Get2(w,s1,s2));
+        Msg2Comment(msg^.Get(w,[s1,s2]));
         aktfilepos:=oldpos;
       end;
 
@@ -654,7 +654,7 @@ var
         oldpos:=aktfilepos;
         aktfilepos:=pos;
         MaybeLoadMessageFile;
-        Msg2Comment(msg^.Get3(w,s1,s2,s3));
+        Msg2Comment(msg^.Get(w,[s1,s2,s3]));
         aktfilepos:=oldpos;
       end;
 
@@ -666,7 +666,7 @@ var
         oldpos:=aktfilepos;
         aktfilepos:=pos;
         MaybeLoadMessageFile;
-        Msg2Comment(msg^.Get4(w,s1,s2,s3,s4));
+        Msg2Comment(msg^.Get(w,[s1,s2,s3,s4]));
         aktfilepos:=oldpos;
       end;
 
@@ -823,7 +823,12 @@ finalization
 end.
 {
   $Log$
-  Revision 1.29  2004-02-15 12:17:59  peter
+  Revision 1.30  2004-02-20 19:49:21  daniel
+    * Message system uses open arrays internally
+    * Bugfix for string handling in array constructor node
+    * Micro code reductions in pdecl.pas
+
+  Revision 1.29  2004/02/15 12:17:59  peter
     * reset compiling_module, fixes crash in ide with second compile
 
   Revision 1.28  2003/10/08 19:17:43  peter