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);
     procedure checkparatype(p:tnamedindexitem;arg:pointer);
-      var
-        highname : string;
       begin
       begin
-        if tsym(p).typ<>varsym then
+        if (tsym(p).typ<>varsym) then
          exit;
          exit;
         with tvarsym(p) do
         with tvarsym(p) do
          begin
          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
                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
                  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);
                    Message(parser_e_C_array_of_const_must_be_last);
-               end
-              else
+               end;
+             stringdef :
                begin
                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;
             end;
          end;
          end;
@@ -366,10 +364,12 @@ implementation
                       begin
                       begin
                         hvs:=tvarsym.create('$high'+vs.name,s32bittype);
                         hvs:=tvarsym.create('$high'+vs.name,s32bittype);
                         hvs.varspez:=vs_const;
                         hvs.varspez:=vs_const;
+                        include(hvs.varoptions,vo_is_high_value);
 {$ifdef vs_hidden}
 {$ifdef vs_hidden}
                         aktprocdef.concatpara(s32bittype,hvs,vs_hidden,nil);
                         aktprocdef.concatpara(s32bittype,hvs,vs_hidden,nil);
 {$endif vs_hidden}
 {$endif vs_hidden}
                         currparast.insert(hvs);
                         currparast.insert(hvs);
+                        vs.highvarsym:=hvs;
                       end;
                       end;
                      aktprocdef.concatpara(tt,vs,varspez,tdefaultvalue);
                      aktprocdef.concatpara(tt,vs,varspez,tdefaultvalue);
                      vs:=tvarsym(vs.listnext);
                      vs:=tvarsym(vs.listnext);
@@ -1697,14 +1697,13 @@ const
     procedure calc_parasymtable_addresses(def:tprocdef);
     procedure calc_parasymtable_addresses(def:tprocdef);
       var
       var
         lastps,
         lastps,
-        highps,ps : tsym;
+        ps : tsym;
         st : tsymtable;
         st : tsymtable;
       begin
       begin
         st:=def.parast;
         st:=def.parast;
         if po_leftright in def.procoptions then
         if po_leftright in def.procoptions then
          begin
          begin
            { pushed in reversed order, left to right }
            { pushed in reversed order, left to right }
-           highps:=nil;
            lastps:=nil;
            lastps:=nil;
            while assigned(st.symindex.first) and (lastps<>tsym(st.symindex.first)) do
            while assigned(st.symindex.first) and (lastps<>tsym(st.symindex.first)) do
             begin
             begin
@@ -1712,27 +1711,14 @@ const
               while assigned(ps.indexnext) and (tsym(ps.indexnext)<>lastps) do
               while assigned(ps.indexnext) and (tsym(ps.indexnext)<>lastps) do
                 ps:=tsym(ps.indexnext);
                 ps:=tsym(ps.indexnext);
               if (ps.typ=varsym) and
               if (ps.typ=varsym) and
-                 (copy(ps.name,1,6)<>'hidden') then
+                 not(vo_is_high_value in tvarsym(ps).varoptions) then
                begin
                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;
                end;
               lastps:=ps;
               lastps:=ps;
             end;
             end;
-           if assigned(highps) then
-            internalerror(200208257);
          end
          end
         else
         else
          begin
          begin
@@ -1740,8 +1726,13 @@ const
            ps:=tsym(st.symindex.first);
            ps:=tsym(st.symindex.first);
            while assigned(ps) do
            while assigned(ps) do
             begin
             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);
               ps:=tsym(ps.indexnext);
             end;
             end;
          end;
          end;
@@ -2129,7 +2120,11 @@ const
 end.
 end.
 {
 {
   $Log$
   $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
     * don't check for export directive repeat
 
 
   Revision 1.97  2002/12/29 18:16:06  peter
   Revision 1.97  2002/12/29 18:16:06  peter

+ 7 - 2
compiler/symconst.pas

@@ -245,7 +245,8 @@ type
     vo_fpuregable,
     vo_fpuregable,
     vo_is_local_copy,
     vo_is_local_copy,
     vo_is_const,  { variable is declared as const (parameter) and can't be written to }
     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;
   tvaroptions=set of tvaroption;
 
 
@@ -338,7 +339,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
     * unit loading changed to first register units and load them
       afterwards. This is needed to support uses xxx in yyy correctly
       afterwards. This is needed to support uses xxx in yyy correctly
     * unit dependency check fixed
     * unit dependency check fixed

+ 12 - 5
compiler/symsym.pas

@@ -174,6 +174,7 @@ interface
        tvarsym = class(tstoredsym)
        tvarsym = class(tstoredsym)
           address       : longint;
           address       : longint;
           localvarsym   : tvarsym;
           localvarsym   : tvarsym;
+          highvarsym    : tvarsym;
           vartype       : ttype;
           vartype       : ttype;
           varoptions    : tvaroptions;
           varoptions    : tvaroptions;
           reg           : tregister; { if reg<>R_NO, then the variable is an register variable }
           reg           : tregister; { if reg<>R_NO, then the variable is an register variable }
@@ -1596,6 +1597,7 @@ implementation
          varspez:=vs_value;
          varspez:=vs_value;
          address:=0;
          address:=0;
          localvarsym:=nil;
          localvarsym:=nil;
+         highvarsym:=nil;
          refs:=0;
          refs:=0;
          varstate:=vs_used;
          varstate:=vs_used;
          varoptions:=[];
          varoptions:=[];
@@ -1638,6 +1640,7 @@ implementation
          varspez:=tvarspez(ppufile.getbyte);
          varspez:=tvarspez(ppufile.getbyte);
          address:=ppufile.getlongint;
          address:=ppufile.getlongint;
          localvarsym:=nil;
          localvarsym:=nil;
+         highvarsym:=nil;
          ppufile.gettype(vartype);
          ppufile.gettype(vartype);
          ppufile.getsmallset(varoptions);
          ppufile.getsmallset(varoptions);
          if (vo_is_C_var in varoptions) then
          if (vo_is_C_var in varoptions) then
@@ -1716,9 +1719,9 @@ implementation
 
 
 {$ifdef var_notification}
 {$ifdef var_notification}
     procedure Tvarsym.trigger_notifications(what:Tnotification_flag);
     procedure Tvarsym.trigger_notifications(what:Tnotification_flag);
-    
+
     var n:Tnotification;
     var n:Tnotification;
-    
+
     begin
     begin
         if assigned(notifications) then
         if assigned(notifications) then
           begin
           begin
@@ -1731,7 +1734,7 @@ implementation
               end;
               end;
           end;
           end;
     end;
     end;
-    
+
     function Tvarsym.register_notification(flags:Tnotification_flags;callback:
     function Tvarsym.register_notification(flags:Tnotification_flags;callback:
                                            Tnotification_callback):cardinal;
                                            Tnotification_callback):cardinal;
 
 
@@ -1746,7 +1749,7 @@ implementation
     end;
     end;
 
 
     procedure Tvarsym.unregister_notification(id:cardinal);
     procedure Tvarsym.unregister_notification(id:cardinal);
-    
+
     var n:Tnotification;
     var n:Tnotification;
 
 
     begin
     begin
@@ -2563,7 +2566,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
    + Notification implementation complete
    + Add for loop code optimization using notifications
    + Add for loop code optimization using notifications
      results in 1.5-1.9% speed improvement in nestloop benchmark
      results in 1.5-1.9% speed improvement in nestloop benchmark