+ add methods for the const nodes to directly emit their constant data to a constant builder

Note: reduce code duplication, especially for the tsetconstnode (with its descendant tcgsetconstnode)

git-svn-id: trunk@42389 -

compiler/ncon.pas

@@ -28,11 +28,17 @@ interface
     uses
       globtype,widestr,constexp,
       node,
-      aasmbase,cpuinfo,globals,
+      aasmbase,aasmcnst,cpuinfo,globals,
       symconst,symtype,symdef,symsym;
 
     type
-       trealconstnode = class(tnode)
+       tconstnode = class abstract(tnode)
+         { directly emit a node's constant data as a constant and return the
+           amount of data written }
+         function emit_data(tcb:ttai_typedconstbuilder):sizeint;virtual;abstract;
+       end;
+
+       trealconstnode = class(tconstnode)
           typedef : tdef;
           typedefderef : tderef;
           value_real : bestreal;
@@ -48,13 +54,14 @@ interface
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+          function emit_data(tcb:ttai_typedconstbuilder):sizeint; override;
 {$ifdef DEBUG_NODE_XML}
           procedure XMLPrintNodeData(var T: Text); override;
 {$endif DEBUG_NODE_XML}
        end;
        trealconstnodeclass = class of trealconstnode;
 
-       tordconstnode = class(tnode)
+       tordconstnode = class(tconstnode)
           typedef : tdef;
           typedefderef : tderef;
           value : TConstExprInt;
@@ -73,6 +80,7 @@ interface
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+          function emit_data(tcb:ttai_typedconstbuilder):sizeint; override;
 {$ifdef DEBUG_NODE_XML}
           procedure XMLPrintNodeInfo(var T: Text); override;
           procedure XMLPrintNodeData(var T: Text); override;
@@ -80,7 +88,7 @@ interface
        end;
        tordconstnodeclass = class of tordconstnode;
 
-       tpointerconstnode = class(tnode)
+       tpointerconstnode = class(tconstnode)
           typedef : tdef;
           typedefderef : tderef;
           value   : TConstPtrUInt;
@@ -94,6 +102,7 @@ interface
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t : text); override;
+          function emit_data(tcb:ttai_typedconstbuilder):sizeint; override;
 {$ifdef DEBUG_NODE_XML}
           procedure XMLPrintNodeData(var T: Text); override;
 {$endif DEBUG_NODE_XML}
@@ -109,7 +118,7 @@ interface
          cst_unicodestring
        );
 
-       tstringconstnode = class(tnode)
+       tstringconstnode = class(tconstnode)
           value_str : pchar;
           len     : longint;
           lab_str : tasmlabel;
@@ -131,6 +140,7 @@ interface
           function docompare(p: tnode) : boolean; override;
           procedure changestringtype(def:tdef);
           function fullcompare(p: tstringconstnode): longint;
+          function emit_data(tcb:ttai_typedconstbuilder):sizeint; override;
           { returns whether this platform uses the nil pointer to represent
             empty dynamic strings }
           class function emptydynstrnil: boolean; virtual;
@@ -157,17 +167,19 @@ interface
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           function elements : AInt;
+          function emit_data(tcb:ttai_typedconstbuilder):sizeint;
        end;
        tsetconstnodeclass = class of tsetconstnode;
 
-       tnilnode = class(tnode)
+       tnilnode = class(tconstnode)
           constructor create;virtual;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
+          function emit_data(tcb:ttai_typedconstbuilder):sizeint; override;
        end;
        tnilnodeclass = class of tnilnode;
 
-       tguidconstnode = class(tnode)
+       tguidconstnode = class(tconstnode)
           value : tguid;
           lab_set : tasmsymbol;
           constructor create(const g:tguid);virtual;
@@ -177,6 +189,7 @@ interface
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
+          function emit_data(tcb:ttai_typedconstbuilder):sizeint; override;
        end;
        tguidconstnodeclass = class of tguidconstnode;
 
@@ -207,6 +220,7 @@ implementation
       cutils,
       verbose,systems,sysutils,
       defcmp,defutil,procinfo,
+      aasmdata,aasmtai,
       cgbase,
       nld;
 
@@ -501,12 +515,33 @@ implementation
       end;
 
 
-    procedure Trealconstnode.printnodedata(var t:text);
+    procedure trealconstnode.printnodedata(var t: text);
       begin
         inherited printnodedata(t);
         writeln(t,printnodeindention,'value = ',value_real);
       end;
 
+    function trealconstnode.emit_data(tcb:ttai_typedconstbuilder):sizeint;
+      begin
+        case tfloatdef(typedef).floattype of
+          s32real:
+            tcb.emit_tai(tai_realconst.create_s32real(value_real),s32floattype);
+          s64real:
+            tcb.emit_tai(tai_realconst.create_s64real(value_real),s64floattype);
+          s80real:
+            tcb.emit_tai(tai_realconst.create_s80real(value_real,0),s80floattype);
+          sc80real:
+            tcb.emit_tai(tai_const.Create_64bit(round(value_real)),sc80floattype);
+          s64comp:
+            tcb.emit_tai(tai_const.Create_64bit(round(value_real)),s64inttype);
+          s64currency:
+            tcb.emit_tai(tai_const.create_64bit(trunc(value_currency * 10000)),s64currencytype);
+          s128real:
+            internalerror(2019070804);
+        end;
+        result:=resultdef.size;
+      end;
+
 {$ifdef DEBUG_NODE_XML}
     procedure TRealConstNode.XMLPrintNodeData(var T: Text);
       begin
@@ -600,12 +635,18 @@ implementation
       end;
 
 
-    procedure Tordconstnode.printnodedata(var t:text);
+        procedure tordconstnode.printnodedata(var t: text);
       begin
         inherited printnodedata(t);
         writeln(t,printnodeindention,'value = ',tostr(value));
       end;
 
+    function tordconstnode.emit_data(tcb:ttai_typedconstbuilder):sizeint;
+      begin
+        tcb.emit_ord_const(value,resultdef);
+        result:=resultdef.size;
+      end;
+
 {$ifdef DEBUG_NODE_XML}
     procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
       begin
@@ -702,6 +743,15 @@ implementation
         writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
       end;
 
+    function tpointerconstnode.emit_data(tcb: ttai_typedconstbuilder): sizeint;
+      begin
+        if tpointerdef(resultdef).compatible_with_pointerdef_size(tpointerdef(voidpointertype)) then
+          tcb.emit_tai(tai_const.Create_int_dataptr(value),voidpointertype)
+        else
+          tcb.emit_tai(tai_const.Create_int_codeptr(value),voidcodepointertype);
+        result:=resultdef.size;
+      end;
+
 {$ifdef DEBUG_NODE_XML}
     procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
       begin
@@ -1067,6 +1117,39 @@ implementation
           result:=compareansistrings(value_str,p.value_str,len,p.len);
       end;
 
+    function tstringconstnode.emit_data(tcb:ttai_typedconstbuilder):sizeint;
+      var
+        ss : shortstring;
+        labofs : tasmlabofs;
+        winlikewidestring : boolean;
+      begin
+        case tstringdef(resultdef).stringtype of
+          st_shortstring:
+            begin
+              setlength(ss,len);
+              move(value_str^,ss[1],len);
+              tcb.emit_shortstring_const(ss);
+              result:=len+1;
+            end;
+          st_longstring:
+            internalerror(2019070801);
+          st_ansistring:
+            begin
+              labofs:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_typedconsts],value_str,len,tstringdef(resultdef).encoding);
+              tcb.emit_string_offset(labofs,len,tstringdef(resultdef).stringtype,false,charpointertype);
+              result:=voidpointertype.size;
+            end;
+          st_widestring,
+          st_unicodestring:
+            begin
+              winlikewidestring:=(cst_type=cst_widestring) and (tf_winlikewidestring in target_info.flags);
+              labofs:=tcb.emit_unicodestring_const(current_asmdata.asmlists[al_typedconsts],value_str,tstringdef(resultdef).encoding,winlikewidestring);
+              tcb.emit_string_offset(labofs,len,tstringdef(resultdef).stringtype,false,widecharpointertype);
+              result:=voidpointertype.size;
+            end;
+        end;
+      end;
+
     class function tstringconstnode.emptydynstrnil: boolean;
       begin
         result:=true;
@@ -1259,6 +1342,61 @@ implementation
           result:=result+ PopCnt(Psetbytes(value_set)^[i]);
       end;
 
+    function tsetconstnode.emit_data(tcb:ttai_typedconstbuilder):sizeint;
+      type
+        setbytes=array[0..31] of byte;
+        Psetbytes=^setbytes;
+      var
+        setval : aint;
+        i : sizeint;
+      begin
+        if is_smallset(resultdef) then
+          begin
+            if (source_info.endian=target_info.endian) then
+              begin
+                { not plongint, because that will "sign extend" the set on 64 bit platforms }
+                { if changed to "paword", please also modify "32-resultdef.size*8" and      }
+                { cross-endian code below                                                   }
+                { Extra aint type cast to avoid range errors                                }
+                 setval:=aint(pCardinal(value_set)^)
+              end
+            else
+              begin
+                setval:=aint(swapendian(Pcardinal(value_set)^));
+                setval:=aint(
+                                   reverse_byte (setval         and $ff)         or
+                                  (reverse_byte((setval shr  8) and $ff) shl  8) or
+                                  (reverse_byte((setval shr 16) and $ff) shl 16) or
+                                  (reverse_byte((setval shr 24) and $ff) shl 24)
+                                );
+              end;
+            if (target_info.endian=endian_big) then
+              setval:=setval shr (32-resultdef.size*8);
+            case resultdef.size of
+              1:
+                tcb.emit_ord_const(byte(setval),u8inttype);
+              2:
+                tcb.emit_ord_const(word(setval),u16inttype);
+              4:
+                tcb.emit_ord_const(longword(setval),u32inttype);
+              8:
+                tcb.emit_ord_const(qword(setval),u64inttype);
+              else
+                internalerror(2019070802);
+            end;
+          end
+        else
+          begin
+            if (source_info.endian=target_info.endian) then
+              for i:=0 to resultdef.size-1 do
+                tcb.emit_tai(tai_const.create_8bit(Psetbytes(value_set)^[i]),u8inttype)
+            else
+              for i:=0 to resultdef.size-1 do
+                tcb.emit_tai(tai_const.create_8bit(reverse_byte(Psetbytes(value_set)^[i])),u8inttype);
+          end;
+        result:=resultdef.size;
+      end;
+
 
 {*****************************************************************************
                                TNILNODE
@@ -1276,6 +1414,15 @@ implementation
         resultdef:=voidpointertype;
       end;
 
+    function tnilnode.emit_data(tcb: ttai_typedconstbuilder): sizeint;
+      begin
+        if tpointerdef(resultdef).compatible_with_pointerdef_size(tpointerdef(voidpointertype)) then
+          tcb.emit_tai(tai_const.Create_nil_dataptr,voidpointertype)
+        else
+          tcb.emit_tai(tai_const.Create_nil_codeptr,voidcodepointertype);
+        result:=resultdef.size;
+      end;
+
     function tnilnode.pass_1 : tnode;
       begin
         result:=nil;
@@ -1339,4 +1486,10 @@ implementation
           (guid2string(value) = guid2string(tguidconstnode(p).value));
       end;
 
+    function tguidconstnode.emit_data(tcb: ttai_typedconstbuilder): sizeint;
+      begin
+        tcb.emit_guid_const(value);
+        result:=resultdef.size;
+      end;
+
 end.