Browse Source

* update smartlinking, uses getdatalabel
* renamed ptree.value vars to value_str,value_real,value_set

peter 27 years ago
parent
commit
12a80cf3dc

+ 7 - 3
compiler/cg386add.pas

@@ -230,8 +230,8 @@ implementation
                cmpop:=true;
              { generate better code for s='' and s<>'' }
                if (p^.treetype in [equaln,unequaln]) and
-                  (((p^.left^.treetype=stringconstn) and (p^.left^.values^='')) or
-                   ((p^.right^.treetype=stringconstn) and (p^.right^.values^=''))) then
+                  (((p^.left^.treetype=stringconstn) and (p^.left^.value_str^='')) or
+                   ((p^.right^.treetype=stringconstn) and (p^.right^.value_str^=''))) then
                  begin
                     secondpass(p^.left);
                     { are too few registers free? }
@@ -1277,7 +1277,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.10  1998-09-04 10:05:04  florian
+  Revision 1.11  1998-09-07 18:45:52  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.10  1998/09/04 10:05:04  florian
     * ugly fix for STRCAT, nevertheless it needs more fixing !!!!!!!
       we need an new version of STRCAT which takes a length parameter
 

+ 72 - 80
compiler/cg386con.pas

@@ -33,7 +33,7 @@ interface
     procedure secondfixconst(var p : ptree);
     procedure secondordconst(var p : ptree);
     procedure secondstringconst(var p : ptree);
-    procedure secondsetcons(var p : ptree);
+    procedure secondsetconst(var p : ptree);
     procedure secondniln(var p : ptree);
 
 
@@ -52,13 +52,10 @@ implementation
       var
          hp1 : pai;
          lastlabel : plabel;
-         found : boolean;
       begin
-         clear_reference(p^.location.reference);
          lastlabel:=nil;
-         found:=false;
          { const already used ? }
-         if p^.labnumber=-1 then
+         if not assigned(p^.lab_real) then
            begin
               { tries to found an old entry }
               hp1:=pai(consts^.first);
@@ -70,12 +67,12 @@ implementation
                      begin
                         if (hp1^.typ=p^.realtyp) and (lastlabel<>nil) then
                           begin
-                             if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.valued)) or
-                               ((p^.realtyp=ait_real_extended) and (pai_extended(hp1)^.value=p^.valued)) or
-                               ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.valued)) then
+                             if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.value_real)) or
+                               ((p^.realtyp=ait_real_extended) and (pai_extended(hp1)^.value=p^.value_real)) or
+                               ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.value_real)) then
                                begin
                                   { found! }
-                                  p^.labnumber:=lastlabel^.nb;
+                                  p^.lab_real:=lastlabel;
                                   break;
                                end;
                           end;
@@ -84,25 +81,25 @@ implementation
                    hp1:=pai(hp1^.next);
                 end;
               { :-(, we must generate a new entry }
-              if p^.labnumber=-1 then
+              if not assigned(p^.lab_real) then
                 begin
-                   getlabel(lastlabel);
-                   p^.labnumber:=lastlabel^.nb;
-                   concat_constlabel(lastlabel,constreal);
+                   getdatalabel(lastlabel);
+                   p^.lab_real:=lastlabel;
+                   if (cs_smartlink in aktmoduleswitches) then
+                    consts^.concat(new(pai_cut,init));
+                   consts^.concat(new(pai_label,init(lastlabel)));
                    case p^.realtyp of
-                     ait_real_64bit : consts^.concat(new(pai_double,init(p^.valued)));
-                     ait_real_32bit : consts^.concat(new(pai_single,init(p^.valued)));
-                  ait_real_extended : consts^.concat(new(pai_extended,init(p^.valued)));
+                     ait_real_64bit : consts^.concat(new(pai_double,init(p^.value_real)));
+                     ait_real_32bit : consts^.concat(new(pai_single,init(p^.value_real)));
+                  ait_real_extended : consts^.concat(new(pai_extended,init(p^.value_real)));
                    else
                      internalerror(10120);
                    end;
                 end;
            end;
-         stringdispose(p^.location.reference.symbol);
-         if assigned(lastlabel) then
-           p^.location.reference.symbol:=stringdup(constlabel2str(lastlabel,constreal))
-         else
-           p^.location.reference.symbol:=stringdup(constlabelnb2str(p^.labnumber,constreal));
+         clear_reference(p^.location.reference);
+         p^.location.reference.symbol:=stringdup(lab2str(p^.lab_real));
+         p^.location.loc:=LOC_MEM;
       end;
 
 
@@ -115,7 +112,7 @@ implementation
          { an fix comma const. behaves as a memory reference }
          p^.location.loc:=LOC_MEM;
          p^.location.reference.isintvalue:=true;
-         p^.location.reference.offset:=p^.valuef;
+         p^.location.reference.offset:=p^.value_fix;
       end;
 
 
@@ -141,18 +138,15 @@ implementation
          hp1 : pai;
 {$ifdef UseAnsiString}
          l1,
-{$endif}        
-
-         lastlabel : plabel;
-         pc : pchar;
+{$endif}
+         lastlabel   : plabel;
+         pc          : pchar;
          same_string : boolean;
-         i : word;
-
+         i           : longint;
       begin
-         clear_reference(p^.location.reference);
          lastlabel:=nil;
          { const already used ? }
-         if p^.labstrnumber=-1 then
+         if not assigned(p^.lab_str) then
            begin
               { tries to found an old entry }
               hp1:=pai(consts^.first);
@@ -173,20 +167,16 @@ implementation
                           (pai_string(hp1)^.len=p^.length+2) then
 {$else UseAnsiString}
                         if (hp1^.typ=ait_string) and (lastlabel<>nil) and
-                          (pai_string(hp1)^.len=length(p^.values^)+2) then
+                          (pai_string(hp1)^.len=length(p^.value_str^)+2) then
 {$endif UseAnsiString}
-
                           begin
                              same_string:=true;
 {$ifndef UseAnsiString}
-                             { weird error here !!!   }
-                             { pchar ' ' was found equal to string '' !!!! }
-                             { gave strange output in exceptions !! PM }
-                             for i:=0 to length(p^.values^) do
-                               if pai_string(hp1)^.str[i]<>p^.values^[i] then
+                             for i:=0 to length(p^.value_str^) do
+                               if pai_string(hp1)^.str[i]<>p^.value_str^[i] then
 {$else}
                              for i:=0 to p^.length do
-                               if pai_string(hp1)^.str[i]<>p^.values[i] then
+                               if pai_string(hp1)^.str[i]<>p^.value_str[i] then
 {$endif}
                                  begin
                                     same_string:=false;
@@ -195,7 +185,7 @@ implementation
                              if same_string then
                                begin
                                   { found! }
-                                  p^.labstrnumber:=lastlabel^.nb;
+                                  p^.lab_str:=lastlabel;
                                   break;
                                end;
                           end;
@@ -204,38 +194,37 @@ implementation
                    hp1:=pai(hp1^.next);
                 end;
               { :-(, we must generate a new entry }
-              if p^.labstrnumber=-1 then
+              if not assigned(p^.lab_str) then
                 begin
-                   getlabel(lastlabel);
-                   p^.labstrnumber:=lastlabel^.nb;
+                   getdatalabel(lastlabel);
+                   p^.lab_str:=lastlabel;
+                   if (cs_smartlink in aktmoduleswitches) then
+                    consts^.concat(new(pai_cut,init));
+                   consts^.concat(new(pai_label,init(lastlabel)));
 {$ifndef UseAnsiString}
-                   getmem(pc,length(p^.values^)+3);
-                   move(p^.values^,pc^,length(p^.values^)+1);
-                   pc[length(p^.values^)+1]:=#0;
-                   concat_constlabel(lastlabel,conststring);
+                   getmem(pc,length(p^.value_str^)+3);
+                   move(p^.value_str^,pc^,length(p^.value_str^)+1);
+                   pc[length(p^.value_str^)+1]:=#0;
                    { we still will have a problem if there is a #0 inside the pchar }
-                   consts^.concat(new(pai_string,init_length_pchar(pc,length(p^.values^)+2)));
+                   consts^.concat(new(pai_string,init_length_pchar(pc,length(p^.value_str^)+2)));
 {$else UseAnsiString}
-
                    { generate an ansi string ? }
                    case p^.stringtype of
                       st_ansistring:
                         begin
                            { an empty ansi string is nil! }
-                           concat_constlabel(lastlabel,conststring);
                            if p^.length=0 then
                              consts^.concat(new(pai_const,init_32bit(0)))
                            else
                              begin
                                 getlabel(l1);
                                 consts^.concat(new(pai_const,init_symbol(strpnew(lab2str(l1)))));
-
                                 consts^.concat(new(pai_const,init_32bit(p^.length)));
                                 consts^.concat(new(pai_const,init_32bit(p^.length)));
                                 consts^.concat(new(pai_const,init_32bit(-1)));
                                 consts^.concat(new(pai_label,init(l1)));
                                 getmem(pc,p^.length+1);
-                                move(p^.values^,pc^,p^.length+1);
+                                move(p^.value_str^,pc^,p^.length+1);
                                 { to overcome this problem we set the length explicitly }
                                 { with the ending null char }
                                 consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+1)));
@@ -244,9 +233,8 @@ implementation
                       st_shortstring:
                         begin
                            getmem(pc,p^.length+3);
-                           move(p^.values^,pc[1],p^.length+1);
+                           move(p^.value_str^,pc[1],p^.length+1);
                            pc[0]:=chr(p^.length);
-                           concat_constlabel(lastlabel,conststring);
                            { to overcome this problem we set the length explicitly }
                            { with the ending null char }
                            consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+2)));
@@ -255,12 +243,9 @@ implementation
 {$endif UseAnsiString}
                 end;
            end;
-         stringdispose(p^.location.reference.symbol);
-         if assigned(lastlabel) then
-           p^.location.reference.symbol:=stringdup(constlabel2str(lastlabel,conststring))
-         else
-           p^.location.reference.symbol:=stringdup(constlabelnb2str(p^.labstrnumber,conststring));
-         p^.location.loc := LOC_MEM;
+         clear_reference(p^.location.reference);
+         p^.location.reference.symbol:=stringdup(lab2str(p^.lab_str));
+         p^.location.loc:=LOC_MEM;
       end;
 
 
@@ -268,47 +253,50 @@ implementation
                              SecondSetCons
 *****************************************************************************}
 
-    procedure secondsetcons(var p : ptree);
+    procedure secondsetconst(var p : ptree);
       var
-         l    : plabel;
-         i    : longint;
-         href : treference;
+         lastlabel : plabel;
+         i : longint;
       begin
 {$ifdef SMALLSETORD}
         if psetdef(p^.resulttype)^.settype=smallset then
          begin
            p^.location.loc:=LOC_MEM;
            p^.location.reference.isintvalue:=true;
-           p^.location.reference.offset:=p^.constset^[0];
+           p^.location.reference.offset:=p^.value_set^[0];
          end
         else
          begin
-           reset_reference(href);
-           getlabel(l);
-           stringdispose(p^.location.reference.symbol);
-           href.symbol:=stringdup(constlabel2str(l,constseta));
-           concat_constlabel(l,constseta);
+           getdatalabel(lastlabel);
+           p^.lab_set:=lastlabel;
+           if (cs_smartlink in aktmoduleswitches) then
+            consts^.concat(new(pai_cut,init));
+           consts^.concat(new(pai_label,init(duplabel(lastlabel))));
            for i:=0 to 31 do
-             consts^.concat(new(pai_const,init_8bit(p^.constset^[i])));
-           p^.location.reference:=href;
+             consts^.concat(new(pai_const,init_8bit(p^.value_set^[i])));
+           clear_reference(p^.location.reference);
+           p^.location.reference.symbol:=stringdup(lab2str(p^.lab_set));
+           p^.location.loc:=LOC_MEM;
          end;
 {$else}
-        reset_reference(href);
-        getlabel(l);
-        stringdispose(p^.location.reference.symbol);
-        href.symbol:=stringdup(constlabel2str(l,constseta));
-        concat_constlabel(l,constseta);
+        getdatalabel(lastlabel);
+        p^.lab_set:=lastlabel;
+        if (cs_smartlink in aktmoduleswitches) then
+         consts^.concat(new(pai_cut,init));
+        consts^.concat(new(pai_label,init(lastlabel)));
         if psetdef(p^.resulttype)^.settype=smallset then
          begin
-           move(p^.constset^,i,sizeof(longint));
+           move(p^.value_set^,i,sizeof(longint));
            consts^.concat(new(pai_const,init_32bit(i)));
          end
         else
          begin
            for i:=0 to 31 do
-             consts^.concat(new(pai_const,init_8bit(p^.constset^[i])));
+             consts^.concat(new(pai_const,init_8bit(p^.value_set^[i])));
          end;
-        p^.location.reference:=href;
+        clear_reference(p^.location.reference);
+        p^.location.reference.symbol:=stringdup(lab2str(p^.lab_set));
+        p^.location.loc:=LOC_MEM;
 {$endif SMALLSETORD}
       end;
 
@@ -328,7 +316,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  1998-08-28 10:56:57  peter
+  Revision 1.13  1998-09-07 18:45:53  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.12  1998/08/28 10:56:57  peter
     * removed warnings
 
   Revision 1.11  1998/08/14 18:18:39  peter

+ 7 - 3
compiler/cg386set.pas

@@ -87,7 +87,7 @@ implementation
          href,href2 : Treference;
          l,l2       : plabel;
 
-         function analizeset(Aset:Pconstset;is_small:boolean):boolean;
+         function analizeset(Aset:pconstset;is_small:boolean):boolean;
            type
              byteset=set of byte;
            var
@@ -173,7 +173,7 @@ implementation
 
          { Can we generate jumps? Possible for all types of sets }
          if (p^.right^.treetype=setconstn) and
-            analizeset(p^.right^.constset,use_small) then
+            analizeset(p^.right^.value_set,use_small) then
           begin
             { It gives us advantage to check for the set elements
               separately instead of using the SET_IN_BYTE procedure.
@@ -775,7 +775,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  1998-09-05 23:51:05  florian
+  Revision 1.13  1998-09-07 18:45:54  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.12  1998/09/05 23:51:05  florian
     * possible bug with too few registers in first/secondin fixed
 
   Revision 1.11  1998/09/04 08:41:41  peter

+ 7 - 3
compiler/cg68kadd.pas

@@ -300,9 +300,9 @@ implementation
                            if (p^.treetype in [equaln,unequaln]) and
                              (
                                ((p^.left^.treetype=stringconstn) and
-                                (p^.left^.values^='')) or
+                                (p^.left^.value_str^='')) or
                                ((p^.right^.treetype=stringconstn) and
-                                (p^.right^.values^=''))
+                                (p^.right^.value_str^=''))
                              ) then
                              begin
                                 { only one node can be stringconstn }
@@ -1263,7 +1263,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  1998-09-04 08:41:42  peter
+  Revision 1.3  1998-09-07 18:45:55  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.2  1998/09/04 08:41:42  peter
     * updated some error messages
 
   Revision 1.1  1998/09/01 09:07:09  peter

+ 69 - 81
compiler/cg68kcon.pas

@@ -33,7 +33,7 @@ interface
     procedure secondfixconst(var p : ptree);
     procedure secondordconst(var p : ptree);
     procedure secondstringconst(var p : ptree);
-    procedure secondsetcons(var p : ptree);
+    procedure secondsetconst(var p : ptree);
     procedure secondniln(var p : ptree);
 
 
@@ -53,13 +53,10 @@ implementation
       var
          hp1 : pai;
          lastlabel : plabel;
-         found : boolean;
       begin
-         clear_reference(p^.location.reference);
          lastlabel:=nil;
-         found:=false;
          { const already used ? }
-         if p^.labnumber=-1 then
+         if not assigned(p^.lab_real) then
            begin
               { tries to found an old entry }
               hp1:=pai(consts^.first);
@@ -71,12 +68,12 @@ implementation
                      begin
                         if (hp1^.typ=p^.realtyp) and (lastlabel<>nil) then
                           begin
-                             if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.valued)) or
-                               ((p^.realtyp=ait_real_extended) and (pai_extended(hp1)^.value=p^.valued)) or
-                               ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.valued)) then
+                             if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.value_real)) or
+                               ((p^.realtyp=ait_real_extended) and (pai_extended(hp1)^.value=p^.value_real)) or
+                               ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.value_real)) then
                                begin
                                   { found! }
-                                  p^.labnumber:=lastlabel^.nb;
+                                  p^.lab_real:=lastlabel;
                                   break;
                                end;
                           end;
@@ -85,25 +82,25 @@ implementation
                    hp1:=pai(hp1^.next);
                 end;
               { :-(, we must generate a new entry }
-              if p^.labnumber=-1 then
+              if not assigned(p^.lab_real) then
                 begin
-                   getlabel(lastlabel);
-                   p^.labnumber:=lastlabel^.nb;
-                   concat_constlabel(lastlabel,constreal);
+                   getdatalabel(lastlabel);
+                   p^.lab_real:=lastlabel;
+                   if (cs_smartlink in aktmoduleswitches) then
+                    consts^.concat(new(pai_cut,init));
+                   consts^.concat(new(pai_label,init(lastlabel)));
                    case p^.realtyp of
-                     ait_real_64bit : consts^.concat(new(pai_double,init(p^.valued)));
-                     ait_real_32bit : consts^.concat(new(pai_single,init(p^.valued)));
-                  ait_real_extended : consts^.concat(new(pai_extended,init(p^.valued)));
+                     ait_real_64bit : consts^.concat(new(pai_double,init(p^.value_real)));
+                     ait_real_32bit : consts^.concat(new(pai_single,init(p^.value_real)));
+                  ait_real_extended : consts^.concat(new(pai_extended,init(p^.value_real)));
                    else
                      internalerror(10120);
                    end;
                 end;
            end;
-         stringdispose(p^.location.reference.symbol);
-         if assigned(lastlabel) then
-           p^.location.reference.symbol:=stringdup(constlabel2str(lastlabel,constreal))
-         else
-           p^.location.reference.symbol:=stringdup(constlabelnb2str(p^.labnumber,constreal));
+         clear_reference(p^.location.reference);
+         p^.location.reference.symbol:=stringdup(lab2str(p^.lab_real));
+         p^.location.loc:=LOC_MEM;
       end;
 
 
@@ -116,7 +113,7 @@ implementation
          { an fix comma const. behaves as a memory reference }
          p^.location.loc:=LOC_MEM;
          p^.location.reference.isintvalue:=true;
-         p^.location.reference.offset:=p^.valuef;
+         p^.location.reference.offset:=p^.value_fix;
       end;
 
 
@@ -143,18 +140,14 @@ implementation
 {$ifdef UseAnsiString}
          l1,
 {$endif}
-
-
-         lastlabel : plabel;
-         pc : pchar;
+         lastlabel   : plabel;
+         pc          : pchar;
          same_string : boolean;
-         i : word;
-
+         i           : longint;
       begin
-         clear_reference(p^.location.reference);
          lastlabel:=nil;
          { const already used ? }
-         if p^.labstrnumber=-1 then
+         if not assigned(p^.lab_str) then
            begin
               { tries to found an old entry }
               hp1:=pai(consts^.first);
@@ -175,20 +168,16 @@ implementation
                           (pai_string(hp1)^.len=p^.length+2) then
 {$else UseAnsiString}
                         if (hp1^.typ=ait_string) and (lastlabel<>nil) and
-                          (pai_string(hp1)^.len=length(p^.values^)+2) then
+                          (pai_string(hp1)^.len=length(p^.value_str^)+2) then
 {$endif UseAnsiString}
-
                           begin
                              same_string:=true;
 {$ifndef UseAnsiString}
-                             { weird error here !!!   }
-                             { pchar ' ' was found equal to string '' !!!! }
-                             { gave strange output in exceptions !! PM }
-                             for i:=0 to length(p^.values^) do
-                               if pai_string(hp1)^.str[i]<>p^.values^[i] then
+                             for i:=0 to length(p^.value_str^) do
+                               if pai_string(hp1)^.str[i]<>p^.value_str^[i] then
 {$else}
                              for i:=0 to p^.length do
-                               if pai_string(hp1)^.str[i]<>p^.values[i] then
+                               if pai_string(hp1)^.str[i]<>p^.value_str[i] then
 {$endif}
                                  begin
                                     same_string:=false;
@@ -197,7 +186,7 @@ implementation
                              if same_string then
                                begin
                                   { found! }
-                                  p^.labstrnumber:=lastlabel^.nb;
+                                  p^.lab_str:=lastlabel;
                                   break;
                                end;
                           end;
@@ -206,38 +195,37 @@ implementation
                    hp1:=pai(hp1^.next);
                 end;
               { :-(, we must generate a new entry }
-              if p^.labstrnumber=-1 then
+              if not assigned(p^.lab_str) then
                 begin
-                   getlabel(lastlabel);
-                   p^.labstrnumber:=lastlabel^.nb;
+                   getdatalabel(lastlabel);
+                   p^.lab_str:=lastlabel;
+                   if (cs_smartlink in aktmoduleswitches) then
+                    consts^.concat(new(pai_cut,init));
+                   consts^.concat(new(pai_label,init(lastlabel)));
 {$ifndef UseAnsiString}
-                   getmem(pc,length(p^.values^)+3);
-                   move(p^.values^,pc^,length(p^.values^)+1);
-                   pc[length(p^.values^)+1]:=#0;
-                   concat_constlabel(lastlabel,conststring);
+                   getmem(pc,length(p^.value_str^)+3);
+                   move(p^.value_str^,pc^,length(p^.value_str^)+1);
+                   pc[length(p^.value_str^)+1]:=#0;
                    { we still will have a problem if there is a #0 inside the pchar }
-                   consts^.concat(new(pai_string,init_length_pchar(pc,length(p^.values^)+2)));
+                   consts^.concat(new(pai_string,init_length_pchar(pc,length(p^.value_str^)+2)));
 {$else UseAnsiString}
-
                    { generate an ansi string ? }
                    case p^.stringtype of
                       st_ansistring:
                         begin
                            { an empty ansi string is nil! }
-                           concat_constlabel(lastlabel,conststring);
                            if p^.length=0 then
                              consts^.concat(new(pai_const,init_32bit(0)))
                            else
                              begin
                                 getlabel(l1);
                                 consts^.concat(new(pai_const,init_symbol(strpnew(lab2str(l1)))));
-
                                 consts^.concat(new(pai_const,init_32bit(p^.length)));
                                 consts^.concat(new(pai_const,init_32bit(p^.length)));
                                 consts^.concat(new(pai_const,init_32bit(-1)));
                                 consts^.concat(new(pai_label,init(l1)));
                                 getmem(pc,p^.length+1);
-                                move(p^.values^,pc^,p^.length+1);
+                                move(p^.value_str^,pc^,p^.length+1);
                                 { to overcome this problem we set the length explicitly }
                                 { with the ending null char }
                                 consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+1)));
@@ -246,9 +234,8 @@ implementation
                       st_shortstring:
                         begin
                            getmem(pc,p^.length+3);
-                           move(p^.values^,pc[1],p^.length+1);
+                           move(p^.value_str^,pc[1],p^.length+1);
                            pc[0]:=chr(p^.length);
-                           concat_constlabel(lastlabel,conststring);
                            { to overcome this problem we set the length explicitly }
                            { with the ending null char }
                            consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+2)));
@@ -257,12 +244,9 @@ implementation
 {$endif UseAnsiString}
                 end;
            end;
-         stringdispose(p^.location.reference.symbol);
-         if assigned(lastlabel) then
-           p^.location.reference.symbol:=stringdup(constlabel2str(lastlabel,conststring))
-         else
-           p^.location.reference.symbol:=stringdup(constlabelnb2str(p^.labstrnumber,conststring));
-         p^.location.loc := LOC_MEM;
+         clear_reference(p^.location.reference);
+         p^.location.reference.symbol:=stringdup(lab2str(p^.lab_str));
+         p^.location.loc:=LOC_MEM;
       end;
 
 
@@ -270,47 +254,50 @@ implementation
                              SecondSetCons
 *****************************************************************************}
 
-    procedure secondsetcons(var p : ptree);
+    procedure secondsetconst(var p : ptree);
       var
-         l    : plabel;
-         i    : longint;
-         href : treference;
+         lastlabel : plabel;
+         i : longint;
       begin
 {$ifdef SMALLSETORD}
         if psetdef(p^.resulttype)^.settype=smallset then
          begin
            p^.location.loc:=LOC_MEM;
            p^.location.reference.isintvalue:=true;
-           p^.location.reference.offset:=p^.constset^[0];
+           p^.location.reference.offset:=p^.value_set^[0];
          end
         else
          begin
-           reset_reference(href);
-           getlabel(l);
-           stringdispose(p^.location.reference.symbol);
-           href.symbol:=stringdup(constlabel2str(l,constseta));
-           concat_constlabel(l,constseta);
+           getdatalabel(lastlabel);
+           p^.lab_set:=lastlabel;
+           if (cs_smartlink in aktmoduleswitches) then
+            consts^.concat(new(pai_cut,init));
+           consts^.concat(new(pai_label,init(duplabel(lastlabel))));
            for i:=0 to 31 do
-             consts^.concat(new(pai_const,init_8bit(p^.constset^[i])));
-           p^.location.reference:=href;
+             consts^.concat(new(pai_const,init_8bit(p^.value_set^[i])));
+           clear_reference(p^.location.reference);
+           p^.location.reference.symbol:=stringdup(lab2str(p^.lab_set));
+           p^.location.loc:=LOC_MEM;
          end;
 {$else}
-        reset_reference(href);
-        getlabel(l);
-        stringdispose(p^.location.reference.symbol);
-        href.symbol:=stringdup(constlabel2str(l,constseta));
-        concat_constlabel(l,constseta);
+        getdatalabel(lastlabel);
+        p^.lab_set:=lastlabel;
+        if (cs_smartlink in aktmoduleswitches) then
+         consts^.concat(new(pai_cut,init));
+        consts^.concat(new(pai_label,init(lastlabel)));
         if psetdef(p^.resulttype)^.settype=smallset then
          begin
-           move(p^.constset^,i,sizeof(longint));
+           move(p^.value_set^,i,sizeof(longint));
            consts^.concat(new(pai_const,init_32bit(i)));
          end
         else
          begin
            for i:=0 to 31 do
-             consts^.concat(new(pai_const,init_8bit(p^.constset^[i])));
+             consts^.concat(new(pai_const,init_8bit(p^.value_set^[i])));
          end;
-        p^.location.reference:=href;
+        clear_reference(p^.location.reference);
+        p^.location.reference.symbol:=stringdup(lab2str(p^.lab_set));
+        p^.location.loc:=LOC_MEM;
 {$endif SMALLSETORD}
       end;
 
@@ -330,7 +317,8 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  1998-09-01 09:07:09  peter
-    * m68k fixes, splitted cg68k like cgi386
+  Revision 1.2  1998-09-07 18:45:56  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
 
 }

+ 7 - 3
compiler/cg68kmem.pas

@@ -146,7 +146,7 @@ implementation
          case p^.treetype of
            simpledisposen:
              begin
-                if ppointerdef(p^.left^.resulttype)^.definition^.needs_rtti then
+                if ppointerdef(p^.left^.resulttype)^.definition^.needs_inittable then
                   begin
 {!!!!!!!}               
 
@@ -168,7 +168,7 @@ implementation
            simplenewn:
              begin
                 emitcall('GETMEM',true);
-                if ppointerdef(p^.left^.resulttype)^.definition^.needs_rtti then
+                if ppointerdef(p^.left^.resulttype)^.definition^.needs_inittable then
                   begin
 {!!!!!!!}               
 
@@ -691,7 +691,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  1998-09-01 09:07:09  peter
+  Revision 1.2  1998-09-07 18:45:57  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.1  1998/09/01 09:07:09  peter
     * m68k fixes, splitted cg68k like cgi386
 
 }

+ 6 - 2
compiler/cg68kset.pas

@@ -281,7 +281,7 @@ implementation
              else
                 begin
                   if (p^.right^.treetype=setconstn) and
-                     analizeset(p^.right^.constset) then
+                     analizeset(p^.right^.value_set) then
                     begin
                       {It gives us advantage to check for the set elements
                         separately instead of using the SET_IN_BYTE procedure.
@@ -812,7 +812,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  1998-09-04 08:41:49  peter
+  Revision 1.3  1998-09-07 18:45:59  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.2  1998/09/04 08:41:49  peter
     * updated some error messages
 
   Revision 1.1  1998/09/01 09:07:09  peter

+ 8 - 4
compiler/cga68k.pas

@@ -138,7 +138,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                        { if it is a char, then simply    }
                        { load 0 length string            }
                        if (p^.right^.treetype=stringconstn) and
-                          (p^.right^.values^='') then
+                          (p^.right^.value_str^='') then
                         exprasmlist^.concat(new(pai68k,op_const_ref(
                            A_MOVE,S_B,0,newreference(p^.left^.location.reference))))
                        else
@@ -458,7 +458,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 
     { This routine needs to be further checked to see if it works correctly  }
     { because contrary to the intel version, all large set elements are read }
-    { as 32-bit values, and then decomposed to find the correct byte.        }
+    { as 32-bit value_str, and then decomposed to find the correct byte.        }
 
     { CHECKED : Depending on the result size, if reference, a load may be    }
     { required on word, long or byte.                                        }
@@ -1264,7 +1264,7 @@ end;
         if not ((cs_fp_emulation) in aktmoduleswitches) then
         begin
             { This permits the mixing of emulation and non-emulation routines }
-            { only possible for REAL = SINGLE values                          }
+            { only possible for REAL = SINGLE value_str                          }
             if not (location.fpureg in [R_FP0..R_FP7]) then
              Begin
                if s = S_FS then
@@ -1345,7 +1345,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.14  1998-09-04 08:41:50  peter
+  Revision 1.15  1998-09-07 18:46:00  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.14  1998/09/04 08:41:50  peter
     * updated some error messages
 
   Revision 1.13  1998/09/01 12:48:02  peter

+ 6 - 2
compiler/cgi386.pas

@@ -219,7 +219,7 @@ implementation
              secondstringconst,secondfuncret,secondselfn,
              secondnot,secondinline,secondniln,seconderror,
              secondnothing,secondhnewn,secondhdisposen,secondnewn,
-             secondsimplenewdispose,secondsetelement,secondsetcons,secondblockn,
+             secondsimplenewdispose,secondsetelement,secondsetconst,secondblockn,
              secondstatement,secondnothing,secondifn,secondbreakn,
              secondcontinuen,second_while_repeatn,second_while_repeatn,secondfor,
              secondexitn,secondwith,secondcase,secondlabel,
@@ -516,7 +516,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.52  1998-09-05 23:03:58  florian
+  Revision 1.53  1998-09-07 18:46:03  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.52  1998/09/05 23:03:58  florian
     * some fixes to get -Or work:
       - inc/dec didn't take care of CREGISTER
       - register calculcation of inc/dec was wrong

+ 10 - 90
compiler/hcodegen.pas

@@ -143,18 +143,16 @@ unit hcodegen;
     function case_get_min(root : pcaserecord) : longint;
 
     { concates/inserts the ASCII string to the data segment }
-    procedure generate_ascii(const hs : string);
-    procedure generate_ascii_insert(const hs : string);
+    procedure generate_ascii(a : paasmoutput;const hs : string);
     { concates/inserts the ASCII string from pchar to the data  segment }
     { WARNING : if hs has no #0 and strlen(hs)=length           }
     { the terminal zero is not written                          }
     procedure generate_pascii(a : paasmoutput;hs : pchar;length : longint);
-    procedure generate_pascii_insert(hs : pchar;length : longint);
 
     { convert/concats a label for constants in the consts section }
-    function constlabel2str(l : plabel;ctype:tconsttype):string;
+{    function constlabel2str(l : plabel;ctype:tconsttype):string;
     function constlabelnb2str(pnb : longint;ctype:tconsttype):string;
-    procedure concat_constlabel(p:plabel;ctype:tconsttype);
+    procedure concat_constlabel(p:plabel;ctype:tconsttype); }
 
     { to be able to force to have a global label for const }
     const
@@ -336,15 +334,9 @@ implementation
                               String Helpers
 *****************************************************************************}
 
-    procedure generate_ascii(const hs : string);
+    procedure generate_ascii(a : paasmoutput;const hs : string);
       begin
-         datasegment^.concat(new(pai_string,init(hs)))
-      end;
-
-
-    procedure generate_ascii_insert(const hs : string);
-      begin
-         datasegment^.insert(new(pai_string,init(hs)));
+         a^.concat(new(pai_string,init(hs)))
       end;
 
 
@@ -387,87 +379,15 @@ implementation
       end;
 
 
-    { inserts the ASCII string from pchar to the const segment }
-    procedure generate_pascii_insert(hs : pchar;length : longint);
-      var
-         real_end,current_begin,current_end : pchar;
-         c :char;
-      begin
-         if assigned(hs) then
-           begin
-              current_begin:=hs;
-              real_end:=strend(hs);
-              c:=hs[0];
-              length:=longint(real_end)-longint(hs);
-              while length>32 do
-                begin
-                   { restore the char displaced }
-                   current_begin[0]:=c;
-                   current_end:=current_begin+32;
-                   { store the char for next loop }
-                   c:=current_end[0];
-                   current_end[0]:=#0;
-                   datasegment^.insert(new(pai_string,init_length_pchar(strnew(current_begin,32),32)));
-                   length:=length-32;
-                end;
-              datasegment^.insert(new(pai_string,init_length_pchar(strnew(current_begin,length),length)));
-           end;
-      end;
-
-{*****************************************************************************
-                              Const Helpers
-*****************************************************************************}
-
-    const
-      consttypestr : array[tconsttype] of string[6]=
-        ('ord','string','real','bool','int','char','set');
-
-      { Peter this gives problems for my inlines !! }
-      { we must use the number directly !!! (PM) }
-    function constlabel2str(l : plabel;ctype:tconsttype):string;
-      begin
-        if (cs_smartlink in aktmoduleswitches) or
-           make_const_global {or (aktoutputformat in [as_tasm])} then
-         constlabel2str:='_$'+current_module^.modulename^+'$'+consttypestr[ctype]+'_const_'+tostr(l^.nb)
-        else
-         constlabel2str:=lab2str(l);
-      end;
-
-    function constlabelnb2str(pnb : longint;ctype:tconsttype):string;
-      begin
-        if (cs_smartlink in aktmoduleswitches) or
-           make_const_global {or (aktoutputformat in [as_tasm])} then
-         constlabelnb2str:='_$'+current_module^.modulename^+'$'+consttypestr[ctype]+'_const_'+tostr(pnb)
-        else
-         constlabelnb2str:=target_asm.labelprefix+tostr(pnb);
-      end;
-
-
-    procedure concat_constlabel(p:plabel;ctype:tconsttype);
-      var
-        s : string;
-      begin
-        if (cs_smartlink in aktmoduleswitches) or
-           make_const_global {or (aktoutputformat in [as_tasm])} then
-         begin
-           s:='_$'+current_module^.modulename^+'$'+consttypestr[ctype]+'_const_'+tostr(p^.nb);
-           if (cs_smartlink in aktmoduleswitches) then
-            begin
-              consts^.concat(new(pai_cut,init));
-              consts^.concat(new(pai_symbol,init_global(s)))
-            end
-           else
-            consts^.concat(new(pai_symbol,init_global(s)));
-         end
-        else
-         consts^.concat(new(pai_label,init(p)));
-      end;
-
 end.
 
 {
   $Log$
-  Revision 1.15  1998-09-01 09:02:51  peter
+  Revision 1.16  1998-09-07 18:46:04  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.15  1998/09/01 09:02:51  peter
     * moved message() to hcodegen, so pass_2 also uses them
 
   Revision 1.14  1998/08/21 14:08:43  pierre

+ 27 - 23
compiler/pass_1.pas

@@ -840,8 +840,8 @@ unit pass_1;
        { both real constants ? }
          if (lt=realconstn) and (rt=realconstn) then
            begin
-              lvd:=p^.left^.valued;
-              rvd:=p^.right^.valued;
+              lvd:=p^.left^.value_real;
+              rvd:=p^.right^.value_real;
               case p^.treetype of
                  addn : t:=genrealconstnode(lvd+rvd);
                  subn : t:=genrealconstnode(lvd-rvd);
@@ -897,7 +897,7 @@ unit pass_1;
               s2:=strpnew(char(byte(p^.right^.value)));
               l2:=1;
 {$else UseAnsiString}
-              s1^:=p^.left^.values^;
+              s1^:=p^.left^.value_str^;
               s2^:=char(byte(p^.right^.value));
 {$endif UseAnsiString}
               concatstrings:=true;
@@ -914,7 +914,7 @@ unit pass_1;
               l2:=p^.right^.length;
 {$else UseAnsiString}
               s1^:=char(byte(p^.left^.value));
-              s2^:=p^.right^.values^;
+              s2^:=p^.right^.value_str^;
 {$endif UseAnsiString}
               concatstrings:=true;
            end
@@ -926,8 +926,8 @@ unit pass_1;
               s2:=getpcharcopy(p^.right);
               l2:=p^.right^.length;
 {$else UseAnsiString}
-              s1^:=p^.left^.values^;
-              s2^:=p^.right^.values^;
+              s1^:=p^.left^.value_str^;
+              s2^:=p^.right^.value_str^;
 {$endif UseAnsiString}
               concatstrings:=true;
            end;
@@ -1114,31 +1114,31 @@ unit pass_1;
                         addn : begin
                                   for i:=0 to 31 do
                                     resultset^[i]:=
-                                      p^.right^.constset^[i] or p^.left^.constset^[i];
+                                      p^.right^.value_set^[i] or p^.left^.value_set^[i];
                                   t:=gensetconstnode(resultset,psetdef(ld));
                                end;
                         muln : begin
                                   for i:=0 to 31 do
                                     resultset^[i]:=
-                                      p^.right^.constset^[i] and p^.left^.constset^[i];
+                                      p^.right^.value_set^[i] and p^.left^.value_set^[i];
                                   t:=gensetconstnode(resultset,psetdef(ld));
                                end;
                         subn : begin
                                   for i:=0 to 31 do
                                     resultset^[i]:=
-                                      p^.left^.constset^[i] and not(p^.right^.constset^[i]);
+                                      p^.left^.value_set^[i] and not(p^.right^.value_set^[i]);
                                   t:=gensetconstnode(resultset,psetdef(ld));
                                end;
                      symdifn : begin
                                   for i:=0 to 31 do
                                     resultset^[i]:=
-                                      p^.left^.constset^[i] xor p^.right^.constset^[i];
+                                      p^.left^.value_set^[i] xor p^.right^.value_set^[i];
                                   t:=gensetconstnode(resultset,psetdef(ld));
                                end;
                     unequaln : begin
                                  b:=true;
                                  for i:=0 to 31 do
-                                  if p^.right^.constset^[i]=p^.left^.constset^[i] then
+                                  if p^.right^.value_set^[i]=p^.left^.value_set^[i] then
                                    begin
                                      b:=false;
                                      break;
@@ -1148,7 +1148,7 @@ unit pass_1;
                       equaln : begin
                                  b:=true;
                                  for i:=0 to 31 do
-                                  if p^.right^.constset^[i]<>p^.left^.constset^[i] then
+                                  if p^.right^.value_set^[i]<>p^.left^.value_set^[i] then
                                    begin
                                      b:=false;
                                      break;
@@ -1607,7 +1607,7 @@ unit pass_1;
       begin
          {why this !!! lost of dummy type definitions
          one per const string !!!
-         p^.resulttype:=new(pstringdef,init(length(p^.values^)));}
+         p^.resulttype:=new(pstringdef,init(length(p^.value_str^)));}
          if cs_ansistrings in aktlocalswitches then
            p^.resulttype:=cansistringdef
          else
@@ -1646,7 +1646,7 @@ unit pass_1;
 {$endif}
            then
            begin
-              t:=genrealconstnode(-p^.left^.valued);
+              t:=genrealconstnode(-p^.left^.value_real);
               disposetree(p);
               firstpass(t);
               p:=t;
@@ -2303,7 +2303,7 @@ unit pass_1;
            begin
               { convert constants direct }
               p^.treetype:=fixconstn;
-              p^.valuef:=p^.left^.value shl 16;
+              p^.value_fix:=p^.left^.value shl 16;
               p^.disposetyp:=dt_nothing;
               disposetree(p^.left);
               p^.location.loc:=LOC_MEM;
@@ -2323,7 +2323,7 @@ unit pass_1;
            begin
               { convert constants direct }
               p^.treetype:=fixconstn;
-              p^.valuef:=round(p^.left^.valued*65536);
+              p^.value_fix:=round(p^.left^.value_real*65536);
               p^.disposetyp:=dt_nothing;
               disposetree(p^.left);
               p^.location.loc:=LOC_MEM;
@@ -2346,7 +2346,7 @@ unit pass_1;
            begin
               { convert constants direct }
               p^.treetype:=realconstn;
-              p^.valued:=round(p^.left^.valuef/65536.0);
+              p^.value_real:=round(p^.left^.value_fix/65536.0);
               p^.disposetyp:=dt_nothing;
               disposetree(p^.left);
               p^.location.loc:=LOC_MEM;
@@ -2567,7 +2567,7 @@ unit pass_1;
           exit;
         end;
 
-       { load the values from the left part }
+       { load the value_str from the left part }
        p^.registers32:=p^.left^.registers32;
        p^.registersfpu:=p^.left^.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -3688,7 +3688,7 @@ unit pass_1;
          if ret_in_param(p^.retdef) or
             (@procinfo<>pprocinfo(p^.funcretprocinfo)) then
            p^.registers32:=1;
-         { no claim if setting higher return values }
+         { no claim if setting higher return value_str }
          if must_be_valid and
             (@procinfo=pprocinfo(p^.funcretprocinfo)) and
             not procinfo.funcret_is_valid then
@@ -3768,7 +3768,7 @@ unit pass_1;
           begin
             isreal:=(p^.left^.treetype=realconstn);
             vl:=p^.left^.value;
-            vr:=p^.left^.valued;
+            vr:=p^.left^.value_real;
             case p^.inlinenumber of
          in_const_trunc : begin
                             if isreal then
@@ -3970,7 +3970,7 @@ unit pass_1;
 {$ifdef UseAnsiString}
                        hp:=genordinalconstnode(p^.left^.length,s32bitdef);
 {$else UseAnsiString}
-                       hp:=genordinalconstnode(length(p^.left^.values^),s32bitdef);
+                       hp:=genordinalconstnode(length(p^.left^.value_str^),s32bitdef);
 {$endif UseAnsiString}
                        disposetree(p);
                        firstpass(hp);
@@ -4950,7 +4950,7 @@ unit pass_1;
       begin
          { it's a f... to determine the used registers }
          { should be done by getnode
-           I think also, that all values should be set to their maximum (FK)
+           I think also, that all value_str should be set to their maximum (FK)
          p^.registers32:=0;
          p^.registersfpu:=0;
          p^.registersmmx:=0;
@@ -5456,7 +5456,11 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.75  1998-09-05 23:51:06  florian
+  Revision 1.76  1998-09-07 18:46:05  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.75  1998/09/05 23:51:06  florian
     * possible bug with too few registers in first/secondin fixed
 
   Revision 1.74  1998/09/05 23:04:00  florian

+ 6 - 12
compiler/pass_2.pas

@@ -72,7 +72,6 @@ implementation
 
 
     procedure seconderror(var p : ptree);
-
       begin
          p^.error:=true;
          codegenerror:=true;
@@ -110,15 +109,12 @@ implementation
          if not p^.object_preserved then
           begin
 {$ifdef i386}   
-
             maybe_loadesi;
 {$endif}
 {$ifdef m68k}
             maybe_loada5;
 {$endif}        
-
           end;
-
        end;
 
 
@@ -173,7 +169,7 @@ implementation
              secondnewn,        {newn}
              secondsimplenewdispose, {simpledisposen}
              secondsetelement,  {setelementn}
-             secondsetcons,     {setconstn}
+             secondsetconst,    {setconstn}
              secondblockn,      {blockn}
              secondstatement,   {statementn}
              secondnothing,     {loopn}
@@ -213,7 +209,6 @@ implementation
             oldcodegenerror:=codegenerror;
             oldlocalswitches:=aktlocalswitches;
             oldpos:=aktfilepos;
-        
 
             aktfilepos:=p^.fileinfo;
             aktlocalswitches:=p^.localswitches;
@@ -221,7 +216,6 @@ implementation
             procedures[p^.treetype](p);
             p^.error:=codegenerror;
         
-
             codegenerror:=codegenerror or oldcodegenerror;
             aktlocalswitches:=oldlocalswitches;
             aktfilepos:=oldpos;
@@ -248,10 +242,8 @@ implementation
        parasym : boolean;
 
     procedure searchregvars(p : psym);
-
       var
          i,j,k : longint;
-
       begin
          if (p^.typ=varsym) and ((pvarsym(p)^.var_options and vo_regable)<>0) then
            begin
@@ -403,7 +395,6 @@ implementation
 
                                        regvars[i]^.reg:=reg32toreg8(varregs[i]);
 {$endif}                                
-
                                        regsize:=S_B;
                                     end
                                   else if  (regvars[i]^.definition^.deftype=orddef) and
@@ -413,7 +404,6 @@ implementation
 
                                        regvars[i]^.reg:=reg32toreg16(varregs[i]);
 {$endif}                                
-
                                        regsize:=S_W;
                                     end
                                   else
@@ -485,7 +475,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  1998-09-01 09:07:12  peter
+  Revision 1.2  1998-09-07 18:46:07  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.1  1998/09/01 09:07:12  peter
     * m68k fixes, splitted cg68k like cgi386
 
 }

+ 12 - 9
compiler/pdecl.pas

@@ -114,26 +114,25 @@ unit pdecl;
                            else internalerror(111);
                         end;
                       stringconstn:
-                        {values is disposed with p so I need a copy !}
+                        {value_str is disposed with p so I need a copy !}
 {$ifdef USEANSISTRING}  begin
                            getmem(sp,p^.length+1);
-                           move(p^.values^,sp^[1],p^.length);
+                           move(p^.value_str^,sp^[1],p^.length);
                            sp^[0]:=chr(p^.length);
                            symtablestack^.insert(new(pconstsym,init(name,conststring,longint(sp),nil)));
                         end;
 {$else USEANSISTRING}
-                        symtablestack^.insert(new(pconstsym,init(name,conststring,longint(stringdup(p^.values^)),nil)));
+                        symtablestack^.insert(new(pconstsym,init(name,conststring,longint(stringdup(p^.value_str^)),nil)));
 {$endif USEANSISTRING}
                       realconstn : begin
                                       new(pd);
-                                      pd^:=p^.valued;
+                                      pd^:=p^.value_real;
                                       symtablestack^.insert(new(pconstsym,init(name,constreal,longint(pd),nil)));
                                    end;
                        setconstn : begin
                                       new(ps);
-                                      ps^:=p^.constset^;
-                                      symtablestack^.insert(new(pconstsym,init(name,
-                                        constseta,longint(ps),p^.resulttype)));
+                                      ps^:=p^.value_set^;
+                                      symtablestack^.insert(new(pconstsym,init(name,constset,longint(ps),p^.resulttype)));
                                    end;
                       else Message(cg_e_illegal_expression);
                    end;
@@ -1670,7 +1669,7 @@ unit pdecl;
             LKLAMMER:
               begin
                  consume(LKLAMMER);
-                 { allow negativ values }
+                 { allow negativ value_str }
                  l:=-1;
                  aufsym := Nil;
                  aufdef:=new(penumdef,init);
@@ -1970,7 +1969,11 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.49  1998-09-07 17:37:00  florian
+  Revision 1.50  1998-09-07 18:46:08  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.49  1998/09/07 17:37:00  florian
     * first fixes for published properties
 
   Revision 1.48  1998/09/04 08:42:02  peter

+ 11 - 7
compiler/pexpr.pas

@@ -911,7 +911,7 @@ unit pexpr;
                               constchar : p1:=genordinalconstnode(pconstsym(srsym)^.value,cchardef);
                               constreal : p1:=genrealconstnode(pbestreal(pconstsym(srsym)^.value)^);
                               constbool : p1:=genordinalconstnode(pconstsym(srsym)^.value,booldef);
-                              constseta : p1:=gensetconstnode(pconstset(pconstsym(srsym)^.value),
+                               constset : p1:=gensetconstnode(pconstset(pconstsym(srsym)^.value),
                                                 psetdef(pconstsym(srsym)^.definition));
                                constord : p1:=genordinalconstnode(pconstsym(srsym)^.value,
                                                 pconstsym(srsym)^.definition);
@@ -1018,7 +1018,7 @@ unit pexpr;
            constsetlo:=0;
            constsethi:=0;
            constp:=gensinglenode(setconstn,nil);
-           constp^.constset:=constset;
+           constp^.value_set:=constset;
            buildp:=constp;
            pd:=nil;
            if token<>RECKKLAMMER then
@@ -1102,8 +1102,8 @@ unit pexpr;
                            if not(is_equal(pd,cchardef)) then
                             Message(type_e_typeconflict_in_set)
                            else
-                            for l:=1 to length(pstring(p2^.values)^) do
-                             do_set(ord(pstring(p2^.values)^[l]));
+                            for l:=1 to length(pstring(p2^.value_str)^) do
+                             do_set(ord(pstring(p2^.value_str)^[l]));
                            disposetree(p2);
                          end;
                  else
@@ -1147,7 +1147,7 @@ unit pexpr;
          ---------------------------------------------}
 
         procedure postfixoperators;
-        { p1 and p2 must contain valid values }
+        { p1 and p2 must contain valid value_str }
         begin
           check_tokenpos;
           while again do
@@ -1850,14 +1850,18 @@ unit pexpr;
             Message(cg_e_illegal_expression);
         end
       else
-        get_stringconst:=p^.values^;
+        get_stringconst:=p^.value_str^;
       disposetree(p);
     end;
 
 end.
 {
   $Log$
-  Revision 1.46  1998-09-04 08:42:03  peter
+  Revision 1.47  1998-09-07 18:46:10  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.46  1998/09/04 08:42:03  peter
     * updated some error messages
 
   Revision 1.45  1998/09/01 17:39:49  peter

+ 22 - 19
compiler/ptconst.pas

@@ -131,7 +131,7 @@ unit ptconst;
               p:=comp_expr(true);
               do_firstpass(p);
               if is_constrealnode(p) then
-                value:=p^.valued
+                value:=p^.value_real
               else if is_constintnode(p) then
                 value:=p^.value
               else
@@ -159,11 +159,11 @@ unit ptconst;
                 if (ppointerdef(def)^.definition^.deftype=orddef) and
                    (porddef(ppointerdef(def)^.definition)^.typ=uchar) then
                   begin
-                    getlabel(ll);
+                    getdatalabel(ll);
                     datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(ll)))));
                     consts^.concat(new(pai_label,init(ll)));
                     if p^.treetype=stringconstn then
-                      consts^.concat(new(pai_string,init(p^.values^+#0)))
+                      consts^.concat(new(pai_string,init(p^.value_str^+#0)))
                     else
                       if is_constcharnode(p) then
                         consts^.concat(new(pai_string,init(char(byte(p^.value))+#0)))
@@ -219,7 +219,7 @@ unit ptconst;
                      begin
 {$ifdef i386}
                         for l:=0 to def^.savesize-1 do
-                          datasegment^.concat(new(pai_const,init_8bit(p^.constset^[l])));
+                          datasegment^.concat(new(pai_const,init_8bit(p^.value_set^[l])));
 {$endif}
 {$ifdef m68k}
                         j:=0;
@@ -227,10 +227,10 @@ unit ptconst;
                         { HORRIBLE HACK because of endian        }
                         { now use intel endian for constant sets }
                          begin
-                           datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j+3])));
-                           datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j+2])));
-                           datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j+1])));
-                           datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j])));
+                           datasegment^.concat(new(pai_const,init_8bit(p^.value_set^[j+3])));
+                           datasegment^.concat(new(pai_const,init_8bit(p^.value_set^[j+2])));
+                           datasegment^.concat(new(pai_const,init_8bit(p^.value_set^[j+1])));
+                           datasegment^.concat(new(pai_const,init_8bit(p^.value_set^[j])));
                            Inc(j,4);
                          end;
 {$endif}
@@ -272,19 +272,18 @@ unit ptconst;
                              strlength:=p^.length;
                            datasegment^.concat(new(pai_const,init_8bit(strlength)));
                            { this can also handle longer strings }
-                           generate_pascii(datasegment,p^.values,strlength);
+                           generate_pascii(datasegment,p^.value_str,strlength);
 {$else UseAnsiString}
-                           if length(p^.values^)>=def^.size then
+                           if length(p^.value_str^)>=def^.size then
                              begin
                                strlength:=def^.size-1;
-                               generate_ascii(char(strlength)+copy(p^.values^,1,strlength));
+                               generate_ascii(datasegment,char(strlength)+copy(p^.value_str^,1,strlength));
                              end
                            else
                              begin
-                               strlength:=length(p^.values^);
-                               generate_ascii(char(strlength)+p^.values^);
+                               strlength:=length(p^.value_str^);
+                               generate_ascii(datasegment,char(strlength)+p^.value_str^);
                              end;
-
 {$endif UseAnsiString}
                         end
                       else if is_constcharnode(p) then
@@ -319,7 +318,7 @@ unit ptconst;
                      if p^.treetype=stringconstn then
                        begin
                           { this can also handle longer strings }
-                          generate_pascii(consts,p^.values,p^.length);
+                          generate_pascii(consts,p^.value_str,p^.length);
                        end
                      else if is_constcharnode(p) then
                        begin
@@ -338,7 +337,7 @@ unit ptconst;
                         datasegment^.concat(new(pai_const,init_32bit(0)))
                       else
                         begin
-                           getlabel(ll);
+                           getdatalabel(ll);
                            datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(ll)))));
                            { first write the maximum size }
                            consts^.concat(new(pai_const,init_32bit(p^.length)));
@@ -355,7 +354,7 @@ unit ptconst;
                            if p^.treetype=stringconstn then
                              begin
                                 { this can also handle longer strings }
-                                generate_pascii(consts,p^.values,p^.length);
+                                generate_pascii(consts,p^.value_str,p^.length);
                              end
                            else if is_constcharnode(p) then
                              begin
@@ -388,7 +387,7 @@ unit ptconst;
                    p:=comp_expr(true);
                    do_firstpass(p);
                    if p^.treetype=stringconstn then
-                     s:=p^.values^
+                     s:=p^.value_str^
                    else if is_constcharnode(p) then
                      s:=char(byte(p^.value))
                    else Message(cg_e_illegal_expression);
@@ -512,7 +511,11 @@ unit ptconst;
 end.
 {
   $Log$
-  Revision 1.14  1998-09-04 08:42:07  peter
+  Revision 1.15  1998-09-07 18:46:11  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.14  1998/09/04 08:42:07  peter
     * updated some error messages
 
   Revision 1.13  1998/09/01 09:05:36  peter

+ 9 - 5
compiler/symsym.inc

@@ -1277,7 +1277,7 @@
                          pd^:=readreal;
                          value:=longint(pd);
                        end;
-           constseta : begin
+            constset : begin
                          definition:=readdefref;
                          new(ps);
                          readnormalset(ps^);
@@ -1294,7 +1294,7 @@
         case consttype of
          conststring : stringdispose(pstring(value));
            constreal : dispose(pbestreal(value));
-           constseta : dispose(pnormalset(value));
+            constset : dispose(pnormalset(value));
         end;
         inherited done;
       end;
@@ -1308,7 +1308,7 @@
 
     procedure tconstsym.deref;
       begin
-        if consttype in [constord,constseta] then
+        if consttype in [constord,constset] then
          resolvedef(pdef(definition));
       end;
 
@@ -1327,7 +1327,7 @@
                        end;
          conststring : writestring(pstring(value)^);
            constreal : writereal(pbestreal(value)^);
-           constseta : begin
+            constset : begin
                          writedefref(definition);
                          writenormalset(pointer(value)^);
                        end;
@@ -1624,7 +1624,11 @@
 
 {
   $Log$
-  Revision 1.40  1998-09-07 17:37:04  florian
+  Revision 1.41  1998-09-07 18:46:12  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.40  1998/09/07 17:37:04  florian
     * first fixes for published properties
 
   Revision 1.39  1998/09/05 22:11:02  florian

+ 57 - 64
compiler/tree.pas

@@ -151,9 +151,8 @@ unit tree;
 
        { allows to determine which elementes are to be replaced }
        tdisposetyp = (dt_nothing,dt_leftright,dt_left,
-                      dt_mbleft,dt_string,dt_typeconv,dt_inlinen,
-                      dt_mbleft_and_method,dt_constset,dt_loop,dt_case,
-                      dt_with,dt_onn);
+                      dt_mbleft,dt_typeconv,dt_inlinen,
+                      dt_mbleft_and_method,dt_loop,dt_case,dt_with,dt_onn);
 
       { different assignment types }
 
@@ -210,23 +209,21 @@ unit tree;
                       methodpointer : ptree;
                       no_check,unit_specific,return_value_used : boolean);
              ordconstn : (value : longint);
-             realconstn : (valued : bestreal;labnumber : longint;realtyp : tait);
-             fixconstn : (valuef: longint);
+             realconstn : (value_real : bestreal;lab_real : plabel;realtyp : tait);
+             fixconstn : (value_fix: longint);
              funcretn : (funcretprocinfo : pointer;retdef : pdef);
              subscriptn : (vs : pvarsym);
              vecn : (memindex,memseg:boolean);
-             { stringconstn : (length : longint; values : pstring;labstrnumber : longint); }
-             { string const can be longer then 255 with ansistring !! }
 {$ifdef UseAnsiString}
-             stringconstn : (values : pchar;length : longint; labstrnumber : longint;stringtype : tstringtype);
+             stringconstn : (value_str : pchar;length : longint; lab_str : plabel;stringtype : tstringtype);
 {$else UseAnsiString}
-             stringconstn : (values : pstring; labstrnumber : longint;stringtype : tstringtype);
+             stringconstn : (value_str : pstring; lab_str:plabel;stringtype : tstringtype);
 {$endif UseAnsiString}
              typeconvn : (convtyp : tconverttype;explizit : boolean);
              inlinen : (inlinenumber : longint;inlineconst:boolean);
              procinlinen : (inlineprocdef : pprocdef;
                             retoffset,para_offset,para_size : longint);
-             setconstn : (constset : pconstset);
+             setconstn : (value_set : pconstset;lab_set:plabel);
              loopn : (t1,t2 : ptree;backward : boolean);
              asmn : (p_asm : paasmoutput;object_preserved : boolean);
              casen : (nodes : pcaserecord;elseblock : ptree);
@@ -333,21 +330,22 @@ unit tree;
          case p^.treetype of
           asmn : if assigned(p^.p_asm) then
                   dispose(p^.p_asm,done);
-     setconstn : if assigned(p^.constset) then
-                  dispose(p^.constset);
+  stringconstn : begin
+{$ifndef UseAnsiString}
+                   stringdispose(p^.value_str);
+{$else UseAnsiString}
+                   ansistringdispose(p^.value_str,p^.length);
+{$endif UseAnsiString}
+                 end;
+     setconstn : begin
+                   if assigned(p^.value_set) then
+                     dispose(p^.value_set);
+                 end;
          end;
          { reference info }
          if (p^.location.loc in [LOC_MEM,LOC_REFERENCE]) and
             assigned(p^.location.reference.symbol) then
            stringdispose(p^.location.reference.symbol);
-
-{$ifndef UseAnsiString}
-         if p^.disposetyp=dt_string then
-           stringdispose(p^.values);
-{$else UseAnsiString}
-         if p^.disposetyp=dt_string then
-           ansistringdispose(p^.values,p^.length);
-{$endif UseAnsiString}
 {$ifdef extdebug}
          if p^.firstpasscount>maxfirstpasscount then
             maxfirstpasscount:=p^.firstpasscount;
@@ -397,20 +395,27 @@ unit tree;
                  if assigned(p^.t2) then
                    hp^.t2:=getcopy(p^.t2);
               end;
-{$ifdef UseAnsiString}
-            dt_string : begin
-                           hp^.values:=getpcharcopy(p);
-                           hp^.length:=p^.length;
-                        end;
-{$else UseAnsiString}
-            dt_string : hp^.values:=stringdup(p^.values^);
-{$endif UseAnsiString}
             dt_typeconv : hp^.left:=getcopy(p^.left);
             dt_inlinen :
               if assigned(p^.left) then
                 hp^.left:=getcopy(p^.left);
             else internalerror(11);
          end;
+       { now check treetype }
+         case p^.treetype of
+  stringconstn : begin
+{$ifdef UseAnsiString}
+                   hp^.value_str:=getpcharcopy(p);
+                   hp^.length:=p^.length;
+{$else UseAnsiString}
+                   hp^.value_str:=stringdup(p^.value_str^);
+{$endif UseAnsiString}
+                 end;
+     setconstn : begin
+                   new(hp^.value_set);
+                   hp^.value_set:=p^.value_set;
+                 end;
+         end;
          getcopy:=hp;
       end;
 
@@ -436,7 +441,6 @@ unit tree;
     end;
 
 
-
     procedure disposetree(p : ptree);
 
       begin
@@ -473,21 +477,6 @@ unit tree;
                  if assigned(p^.left) then disposetree(p^.left);
                  disposetree(p^.methodpointer);
               end;
-{$ifdef UseAnsiString}
-            dt_string : ansistringdispose(p^.values,p^.length);
-{$else UseAnsiString}
-            dt_string : stringdispose(p^.values);
-{$endif UseAnsiString}
-            dt_constset :
-              begin
-                 if assigned(p^.constset) then
-                   begin
-                      dispose(p^.constset);
-                      p^.constset:=nil;
-                   end;
-                 if assigned(p^.left) then
-                   disposetree(p^.left);
-              end;
             dt_typeconv : disposetree(p^.left);
             dt_inlinen :
               if assigned(p^.left) then
@@ -740,17 +729,17 @@ unit tree;
 {$endif SUPPORT_MMX}
 {$ifdef i386}
          p^.resulttype:=c64floatdef;
-         p^.valued:=v;
+         p^.value_real:=v;
          { default value is double }
          p^.realtyp:=ait_real_64bit;
 {$endif}
 {$ifdef m68k}
          p^.resulttype:=new(pfloatdef,init(s32real));
-         p^.valued:=v;
+         p^.value_real:=v;
          { default value is double }
          p^.realtyp:=ait_real_32bit;
 {$endif}
-         p^.labnumber:=-1;
+         p^.lab_real:=nil;
          genrealconstnode:=p;
       end;
 
@@ -763,7 +752,7 @@ unit tree;
 {$endif UseAnsiString}
       begin
          p:=getnode;
-         p^.disposetyp:=dt_string;
+         p^.disposetyp:=dt_nothing;
          p^.treetype:=stringconstn;
          p^.registers32:=0;
 {         p^.registers16:=0;
@@ -777,13 +766,13 @@ unit tree;
          l:=length(s);
          p^.length:=l;
          { stringdup write even past a #0 }
-         getmem(p^.values,l+1);
-         move(s[1],p^.values^,l);
-         p^.values[l]:=#0;
+         getmem(p^.value_str,l+1);
+         move(s[1],p^.value_str^,l);
+         p^.value_str[l]:=#0;
 {$else UseAnsiString}
-         p^.values:=stringdup(s);
+         p^.value_str:=stringdup(s);
 {$endif UseAnsiString}
-         p^.labstrnumber:=-1;
+         p^.lab_str:=nil;
          p^.stringtype:=st_shortstring;
          genstringconstnode:=p;
       end;
@@ -800,7 +789,7 @@ unit tree;
          { Peter can you change that ? }
          if pc=nil then
            Message(general_f_no_memory_left);
-         move(p^.values^,pc^,p^.length+1);
+         move(p^.value_str^,pc^,p^.length+1);
          getpcharcopy:=pc;
       end;
 
@@ -811,7 +800,7 @@ unit tree;
 
       begin
          p:=getnode;
-         p^.disposetyp:=dt_string;
+         p^.disposetyp:=dt_nothing;
          p^.treetype:=stringconstn;
          p^.registers32:=0;
 {         p^.registers16:=0;
@@ -822,8 +811,8 @@ unit tree;
 {$endif SUPPORT_MMX}
          p^.resulttype:=cstringdef;
          p^.length:=length;
-         p^.values:=s;
-         p^.labstrnumber:=-1;
+         p^.value_str:=s;
+         p^.lab_str:=nil;
          genpcharconstnode:=p;
       end;
 {$endif UseAnsiString}
@@ -1137,7 +1126,7 @@ unit tree;
 
      begin
         p:=getnode;
-        p^.disposetyp:=dt_constset;
+        p^.disposetyp:=dt_nothing;
         p^.treetype:=setconstn;
         p^.registers32:=0;
         p^.registersfpu:=0;
@@ -1146,8 +1135,8 @@ unit tree;
 {$endif SUPPORT_MMX}
          p^.resulttype:=settype;
          p^.left:=nil;
-         new(p^.constset);
-         p^.constset^:=s^;
+         new(p^.value_set);
+         p^.value_set^:=s^;
          gensetconstnode:=p;
       end;
 
@@ -1389,12 +1378,12 @@ unit tree;
              funcretn : (funcretprocinfo : pointer;retdef : pdef);
              subscriptn : (vs : pvarsym);
              vecn : (memindex,memseg:boolean);
-             { stringconstn : (length : longint; values : pstring;labstrnumber : longint); }
+             { stringconstn : (length : longint; value_str : pstring;labstrnumber : longint); }
              { string const can be longer then 255 with ansistring !! }
 {$ifdef UseAnsiString}
-             stringconstn : (values : pchar;length : longint; labstrnumber : longint);
+             stringconstn : (value_str : pchar;length : longint; labstrnumber : longint);
 {$else UseAnsiString}
-             stringconstn : (values : pstring; labstrnumber : longint);
+             stringconstn : (value_str : pstring; labstrnumber : longint);
 {$endif UseAnsiString}
              typeconvn : (convtyp : tconverttype;explizit : boolean);
              inlinen : (inlinenumber : longint);
@@ -1556,7 +1545,11 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.35  1998-09-04 08:42:11  peter
+  Revision 1.36  1998-09-07 18:46:17  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.35  1998/09/04 08:42:11  peter
     * updated some error messages
 
   Revision 1.34  1998/09/01 17:39:54  peter