* add support for loading of typed const strings with resourcestrings,

    made the loading also a bit more generic

compiler/ptconst.pas

@@ -36,6 +36,8 @@ unit ptconst;
     uses
 {$ifdef Delphi}
        sysutils,
+{$else}
+       strings,
 {$endif Delphi}
        globtype,systems,tokens,
        cobjects,globals,scanner,
@@ -76,6 +78,7 @@ unit ptconst;
          obj       : pobjectdef;
          symt      : psymtable;
          value     : bestreal;
+         strval    : pchar;
 
       procedure check_range;
         begin
@@ -413,107 +416,94 @@ unit ptconst;
            begin
               p:=comp_expr(true);
               do_firstpass(p);
-              { first take care of prefixes for long and ansi strings }
-              case pstringdef(def)^.string_typ of
-                 st_shortstring:
-                   begin
-                      if p^.treetype=stringconstn then
-                        begin
-                           if p^.length>=def^.size then
-                             begin
-                               message2(parser_w_string_too_long,strpas(p^.value_str),tostr(def^.size-1));
-                               strlength:=def^.size-1;
-                             end
-                           else
-                             strlength:=p^.length;
-                           curconstsegment^.concat(new(pai_const,init_8bit(strlength)));
-                           { this can also handle longer strings }
-                           getmem(ca,strlength+1);
-                           move(p^.value_str^,ca^,strlength);
-                           ca[strlength]:=#0;
-                           curconstsegment^.concat(new(pai_string,init_length_pchar(ca,strlength)));
-                        end
-                      else if is_constcharnode(p) then
+              { load strval and strlength of the constant tree }
+              if p^.treetype=stringconstn then
+                begin
+                  strlength:=p^.length;
+                  strval:=p^.value_str;
+                end
+              else if is_constcharnode(p) then
+                begin
+                  strval:=pchar(@p^.value);
+                  strlength:=1
+                end
+              else if is_constresourcestringnode(p) then
+                begin
+                  strval:=pchar(pconstsym(p^.symtableentry)^.value);
+                  strlength:=pconstsym(p^.symtableentry)^.len;
+                end
+              else
+                begin
+                  Message(cg_e_illegal_expression);
+                  strlength:=-1;
+                end;
+              if strlength>=0 then
+               begin
+                 case pstringdef(def)^.string_typ of
+                   st_shortstring:
+                     begin
+                       if strlength>=def^.size then
                         begin
-                           curconstsegment^.concat(new(pai_string,init(#1+char(byte(p^.value)))));
-                           strlength:=1;
-                        end
-                      else Message(cg_e_illegal_expression);
-
-                      if def^.size>strlength then
+                          message2(parser_w_string_too_long,strpas(strval),tostr(def^.size-1));
+                          strlength:=def^.size-1;
+                        end;
+                       curconstsegment^.concat(new(pai_const,init_8bit(strlength)));
+                       { this can also handle longer strings }
+                       getmem(ca,strlength+1);
+                       move(strval^,ca^,strlength);
+                       ca[strlength]:=#0;
+                       curconstsegment^.concat(new(pai_string,init_length_pchar(ca,strlength)));
+                       { fillup with spaces if size is shorter }
+                       if def^.size>strlength then
                         begin
-                           getmem(ca,def^.size-strlength);
-                           { def^.size contains also the leading length, so we }
-                           { we have to subtract one                       }
-                           fillchar(ca[0],def^.size-strlength-1,' ');
-                           ca[def^.size-strlength-1]:=#0;
-                           { this can also handle longer strings }
-                           curconstsegment^.concat(new(pai_string,init_length_pchar(ca,def^.size-strlength-1)));
+                          getmem(ca,def^.size-strlength);
+                          { def^.size contains also the leading length, so we }
+                          { we have to subtract one                       }
+                          fillchar(ca[0],def^.size-strlength-1,' ');
+                          ca[def^.size-strlength-1]:=#0;
+                          { this can also handle longer strings }
+                          curconstsegment^.concat(new(pai_string,init_length_pchar(ca,def^.size-strlength-1)));
                         end;
-                   end;
+                     end;
 {$ifdef UseLongString}
-                 st_longstring:
-                   begin
-                     if is_constcharnode(p) then
-                      strlength:=1
-                     else
-                      strlength:=p^.length;
-                     { first write the maximum size }
-                     curconstsegment^.concat(new(pai_const,init_32bit(strlength)))));
-                     { fill byte }
-                     curconstsegment^.concat(new(pai_const,init_8bit(0)));
-                     if p^.treetype=stringconstn then
-                       begin
-                         getmem(ca,strlength+1);
-                         move(p^.value_str^,ca^,strlength);
-                         ca[strlength]:=#0;
-                         generate_pascii(consts,ca,strlength);
-                       end
-                     else if is_constcharnode(p) then
-                       begin
-                          consts^.concat(new(pai_const,init_8bit(p^.value)));
-                       end
-                     else Message(cg_e_illegal_expression);
-                     curconstsegment^.concat(new(pai_const,init_8bit(0)));
-                   end;
+                   st_longstring:
+                     begin
+                       { first write the maximum size }
+                       curconstsegment^.concat(new(pai_const,init_32bit(strlength)))));
+                       { fill byte }
+                       curconstsegment^.concat(new(pai_const,init_8bit(0)));
+                       getmem(ca,strlength+1);
+                       move(strval^,ca^,strlength);
+                       ca[strlength]:=#0;
+                       generate_pascii(consts,ca,strlength);
+                       curconstsegment^.concat(new(pai_const,init_8bit(0)));
+                     end;
 {$endif UseLongString}
-                 st_ansistring:
-                   begin
-                      { an empty ansi string is nil! }
-                      if (p^.treetype=stringconstn) and (p^.length=0) then
-                        curconstsegment^.concat(new(pai_const,init_32bit(0)))
-                      else
-                        begin
-                           if is_constcharnode(p) then
-                            strlength:=1
-                           else
-                            strlength:=p^.length;
-                           getdatalabel(ll);
-                           curconstsegment^.concat(new(pai_const_symbol,init(ll)));
-                           { first write the maximum size }
-                           consts^.concat(new(pai_const,init_32bit(strlength)));
-                           { second write the real length }
-                           consts^.concat(new(pai_const,init_32bit(strlength)));
-                           { redondent with maxlength but who knows ... (PM) }
-                           { third write use count (set to -1 for safety ) }
-                           consts^.concat(new(pai_const,init_32bit(-1)));
-                           consts^.concat(new(pai_label,init(ll)));
-                           if p^.treetype=stringconstn then
-                             begin
-                               getmem(ca,strlength+1);
-                               move(p^.value_str^,ca^,strlength);
-                               ca[strlength]:=#0;
-                               consts^.concat(new(pai_string,init_length_pchar(ca,strlength)));
-                             end
-                           else if is_constcharnode(p) then
-                             begin
-                                consts^.concat(new(pai_const,init_8bit(p^.value)));
-                             end
-                           else Message(cg_e_illegal_expression);
-                           consts^.concat(new(pai_const,init_8bit(0)));
-                        end;
-                   end;
-              end;
+                   st_ansistring:
+                     begin
+                        { an empty ansi string is nil! }
+                        if (strlength=0) then
+                          curconstsegment^.concat(new(pai_const,init_32bit(0)))
+                        else
+                          begin
+                            getdatalabel(ll);
+                            curconstsegment^.concat(new(pai_const_symbol,init(ll)));
+                            { first write the maximum size }
+                            consts^.concat(new(pai_const,init_32bit(strlength)));
+                            { second write the real length }
+                            consts^.concat(new(pai_const,init_32bit(strlength)));
+                            { redondent with maxlength but who knows ... (PM) }
+                            { third write use count (set to -1 for safety ) }
+                            consts^.concat(new(pai_const,init_32bit(-1)));
+                            consts^.concat(new(pai_label,init(ll)));
+                            getmem(ca,strlength+1);
+                            move(strval^,ca^,strlength);
+                            ca[strlength]:=#0;
+                            consts^.concat(new(pai_string,init_length_pchar(ca,strlength)));
+                          end;
+                     end;
+                 end;
+               end;
               disposetree(p);
            end;
          arraydef:
@@ -800,7 +790,11 @@ unit ptconst;
 end.
 {
   $Log$
-  Revision 1.66  2000-05-12 06:02:01  pierre
+  Revision 1.67  2000-05-17 17:10:06  peter
+    * add support for loading of typed const strings with resourcestrings,
+      made the loading also a bit more generic
+
+  Revision 1.66  2000/05/12 06:02:01  pierre
    * * get it to compile with Delphi by Kovacs Attila Zoltan
 
   Revision 1.65  2000/05/11 09:15:15  pierre

compiler/tree.pas

@@ -354,6 +354,8 @@ unit tree;
     function is_constboolnode(p : ptree) : boolean;
     function is_constrealnode(p : ptree) : boolean;
     function is_constcharnode(p : ptree) : boolean;
+    function is_constresourcestringnode(p : ptree) : boolean;
+
     function str_length(p : ptree) : longint;
     function is_emptyset(p : ptree):boolean;
 
@@ -2035,6 +2037,15 @@ unit tree;
          is_constboolnode:=(p^.treetype=ordconstn) and is_boolean(p^.resulttype);
       end;
 
+
+    function is_constresourcestringnode(p : ptree) : boolean;
+      begin
+        is_constresourcestringnode:=(p^.treetype=loadn) and
+                                    (p^.symtableentry^.typ=constsym) and
+                                    (pconstsym(p^.symtableentry)^.consttyp=constresourcestring);
+      end;
+
+
     function str_length(p : ptree) : longint;
 
       begin
@@ -2110,7 +2121,11 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.119  2000-04-25 14:43:37  jonas
+  Revision 1.120  2000-05-17 17:10:06  peter
+    * add support for loading of typed const strings with resourcestrings,
+      made the loading also a bit more generic
+
+  Revision 1.119  2000/04/25 14:43:37  jonas
     - disabled "string_var := string_var + ... " and "string_var + char_var"
       optimizations (were only active with -dnewoptimizations) because of
       several internal issues