Browse Source

* high value insertion changed so it works also when 2 parameters
are passed

peter 22 years ago
parent
commit
d0725b2e7d
3 changed files with 72 additions and 65 deletions
  1. 53 58
      compiler/pdecsub.pas
  2. 7 2
      compiler/symconst.pas
  3. 12 5
      compiler/symsym.pas

+ 53 - 58
compiler/pdecsub.pas

@@ -106,50 +106,48 @@ implementation
 
 
     procedure checkparatype(p:tnamedindexitem;arg:pointer);
-      var
-        highname : string;
       begin
-        if tsym(p).typ<>varsym then
+        if (tsym(p).typ<>varsym) then
          exit;
         with tvarsym(p) do
          begin
-           if assigned(vartype.def) and
-              (vartype.def.deftype=arraydef) and
-              {not is_array_constructor(vartype.def) and}
-              not is_variant_array(vartype.def) and
-              not is_array_of_const(vartype.def) then
-            begin
-              if (varspez<>vs_var) then
-                Message(parser_h_c_arrays_are_references);
-            end;
-           if assigned(vartype.def) and
-              (is_array_of_const(vartype.def) or
-               is_open_array(vartype.def) or
-               is_shortstring(vartype.def)) then
-            begin
-              if is_open_string(vartype.def) then
-                begin
-                  { change type to normal short string }
-                  Message(parser_w_cdecl_no_openstring);
-                end;
-              if assigned(indexnext) and
-                 (tsym(indexnext).typ=varsym) and
-                 (copy(tvarsym(indexnext).name,1,4)='high') then
+           case vartype.def.deftype of
+             arraydef :
                begin
-                 { removing it is too complicated,
-                   we just hide it PM }
-                 highname:='hidden'+copy(tvarsym(indexnext).name,5,high(name));
-                 Message(parser_w_cdecl_has_no_high);
-                 owner.rename(tvarsym(indexnext).name,highname);
+                 if not is_variant_array(vartype.def) and
+                    not is_array_of_const(vartype.def) then
+                  begin
+                    if (varspez<>vs_var) then
+                      Message(parser_h_c_arrays_are_references);
+                  end;
+                 if is_array_of_const(vartype.def) or
+                    is_open_array(vartype.def) then
+                  begin
+                    if assigned(highvarsym) then
+                     begin
+                       Message(parser_w_cdecl_has_no_high);
+                       { removing it is too complicated, we just hide it PM }
+                       owner.rename(highvarsym.name,'hidden'+copy(highvarsym.name,5,high(name)));
+                     end;
+                  end;
                  if is_array_of_const(vartype.def) and
-                    assigned(indexnext.indexnext) then
+                    assigned(indexnext) and
+                    (tsym(indexnext).typ=varsym) and
+                    not(vo_is_high_value in tvarsym(indexnext).varoptions) then
                    Message(parser_e_C_array_of_const_must_be_last);
-               end
-              else
+               end;
+             stringdef :
                begin
-                 if is_array_of_const(vartype.def) and
-                    assigned(indexnext) then
-                   Message(parser_e_C_array_of_const_must_be_last);
+                 if is_open_string(vartype.def) then
+                  begin
+                    Message(parser_w_cdecl_no_openstring);
+                    if assigned(highvarsym) then
+                     begin
+                       Message(parser_w_cdecl_has_no_high);
+                       { removing it is too complicated, we just hide it PM }
+                       owner.rename(highvarsym.name,'hidden'+copy(highvarsym.name,5,high(name)));
+                     end;
+                  end;
                end;
             end;
          end;
@@ -366,10 +364,12 @@ implementation
                       begin
                         hvs:=tvarsym.create('$high'+vs.name,s32bittype);
                         hvs.varspez:=vs_const;
+                        include(hvs.varoptions,vo_is_high_value);
 {$ifdef vs_hidden}
                         aktprocdef.concatpara(s32bittype,hvs,vs_hidden,nil);
 {$endif vs_hidden}
                         currparast.insert(hvs);
+                        vs.highvarsym:=hvs;
                       end;
                      aktprocdef.concatpara(tt,vs,varspez,tdefaultvalue);
                      vs:=tvarsym(vs.listnext);
@@ -1697,14 +1697,13 @@ const
     procedure calc_parasymtable_addresses(def:tprocdef);
       var
         lastps,
-        highps,ps : tsym;
+        ps : tsym;
         st : tsymtable;
       begin
         st:=def.parast;
         if po_leftright in def.procoptions then
          begin
            { pushed in reversed order, left to right }
-           highps:=nil;
            lastps:=nil;
            while assigned(st.symindex.first) and (lastps<>tsym(st.symindex.first)) do
             begin
@@ -1712,27 +1711,14 @@ const
               while assigned(ps.indexnext) and (tsym(ps.indexnext)<>lastps) do
                 ps:=tsym(ps.indexnext);
               if (ps.typ=varsym) and
-                 (copy(ps.name,1,6)<>'hidden') then
+                 not(vo_is_high_value in tvarsym(ps).varoptions) then
                begin
-                 { Wait with inserting the high value, it needs to be inserted
-                   after the corresponding parameter }
-                 if Copy(ps.name,1,4)='high' then
-                  highps:=ps
-                 else
-                  begin
-                    st.insertvardata(ps);
-                    { add also the high tree if it was saved }
-                    if assigned(highps) then
-                     begin
-                       st.insertvardata(highps);
-                       highps:=nil;
-                     end;
-                  end;
+                 st.insertvardata(ps);
+                 if assigned(tvarsym(ps).highvarsym) then
+                   st.insertvardata(tvarsym(ps).highvarsym);
                end;
               lastps:=ps;
             end;
-           if assigned(highps) then
-            internalerror(200208257);
          end
         else
          begin
@@ -1740,8 +1726,13 @@ const
            ps:=tsym(st.symindex.first);
            while assigned(ps) do
             begin
-              if ps.typ=varsym then
-               st.insertvardata(ps);
+              if (ps.typ=varsym) and
+                 not(vo_is_high_value in tvarsym(ps).varoptions) then
+               begin
+                 st.insertvardata(ps);
+                 if assigned(tvarsym(ps).highvarsym) then
+                   st.insertvardata(tvarsym(ps).highvarsym);
+               end;
               ps:=tsym(ps.indexnext);
             end;
          end;
@@ -2129,7 +2120,11 @@ const
 end.
 {
   $Log$
-  Revision 1.98  2003-01-01 14:35:33  peter
+  Revision 1.99  2003-01-01 22:51:03  peter
+    * high value insertion changed so it works also when 2 parameters
+      are passed
+
+  Revision 1.98  2003/01/01 14:35:33  peter
     * don't check for export directive repeat
 
   Revision 1.97  2002/12/29 18:16:06  peter

+ 7 - 2
compiler/symconst.pas

@@ -245,7 +245,8 @@ type
     vo_fpuregable,
     vo_is_local_copy,
     vo_is_const,  { variable is declared as const (parameter) and can't be written to }
-    vo_is_exported
+    vo_is_exported,
+    vo_is_high_value
   );
   tvaroptions=set of tvaroption;
 
@@ -338,7 +339,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.40  2002-12-29 14:57:50  peter
+  Revision 1.41  2003-01-01 22:51:03  peter
+    * high value insertion changed so it works also when 2 parameters
+      are passed
+
+  Revision 1.40  2002/12/29 14:57:50  peter
     * unit loading changed to first register units and load them
       afterwards. This is needed to support uses xxx in yyy correctly
     * unit dependency check fixed

+ 12 - 5
compiler/symsym.pas

@@ -174,6 +174,7 @@ interface
        tvarsym = class(tstoredsym)
           address       : longint;
           localvarsym   : tvarsym;
+          highvarsym    : tvarsym;
           vartype       : ttype;
           varoptions    : tvaroptions;
           reg           : tregister; { if reg<>R_NO, then the variable is an register variable }
@@ -1596,6 +1597,7 @@ implementation
          varspez:=vs_value;
          address:=0;
          localvarsym:=nil;
+         highvarsym:=nil;
          refs:=0;
          varstate:=vs_used;
          varoptions:=[];
@@ -1638,6 +1640,7 @@ implementation
          varspez:=tvarspez(ppufile.getbyte);
          address:=ppufile.getlongint;
          localvarsym:=nil;
+         highvarsym:=nil;
          ppufile.gettype(vartype);
          ppufile.getsmallset(varoptions);
          if (vo_is_C_var in varoptions) then
@@ -1716,9 +1719,9 @@ implementation
 
 {$ifdef var_notification}
     procedure Tvarsym.trigger_notifications(what:Tnotification_flag);
-    
+
     var n:Tnotification;
-    
+
     begin
         if assigned(notifications) then
           begin
@@ -1731,7 +1734,7 @@ implementation
               end;
           end;
     end;
-    
+
     function Tvarsym.register_notification(flags:Tnotification_flags;callback:
                                            Tnotification_callback):cardinal;
 
@@ -1746,7 +1749,7 @@ implementation
     end;
 
     procedure Tvarsym.unregister_notification(id:cardinal);
-    
+
     var n:Tnotification;
 
     begin
@@ -2563,7 +2566,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.87  2002-12-31 09:55:58  daniel
+  Revision 1.88  2003-01-01 22:51:03  peter
+    * high value insertion changed so it works also when 2 parameters
+      are passed
+
+  Revision 1.87  2002/12/31 09:55:58  daniel
    + Notification implementation complete
    + Add for loop code optimization using notifications
      results in 1.5-1.9% speed improvement in nestloop benchmark