* converted adding/comparing of strings to compileproc. Note that due

    to the way the shortstring helpers for i386 are written, they are
    still handled by the old code (reason: fpc_shortstr_compare returns
    results in the flags instead of in eax and fpc_shortstr_concat
    has wierd parameter conventions). The compilerproc stuff should work
    fine with the generic implementations though.
  * removed some nested comments warnings

compiler/i386/n386add.pas

@@ -27,15 +27,18 @@ unit n386add;
 interface
 
     uses
-       nadd,cpubase;
+       node,nadd,cpubase;
 
     type
        ti386addnode = class(taddnode)
           procedure pass_2;override;
           function getresflags(unsigned : boolean) : tresflags;
           procedure SetResultLocation(cmpop,unsigned : boolean);
-          procedure addstring;
-          procedure addset;
+         protected
+          function first_addstring : tnode; override;
+         private
+          procedure second_addstring;
+          procedure second_addset;
        end;
 
   implementation
@@ -46,7 +49,7 @@ interface
       symconst,symdef,aasm,types,
       cgbase,temp_gen,pass_2,
       cpuasm,
-      node,ncon,nset,
+      ncon,nset,
       cga,n386util,tgcpu;
 
     function ti386addnode.getresflags(unsigned : boolean) : tresflags;
@@ -124,15 +127,33 @@ interface
                                 Addstring
 *****************************************************************************}
 
-    procedure ti386addnode.addstring;
+    { note: if you implemented an fpc_shortstr_concat similar to the    }
+    { one in i386.inc, you have to override first_addstring like in     }
+    { ti386addnode.first_string and implement the shortstring concat    }
+    { manually! The generic routine is different from the i386 one (JM) }
+    function ti386addnode.first_addstring : tnode;
+      begin
+        { special cases for shortstrings, handled in pass_2 (JM) }
+        { can't handle fpc_shortstr_compare with compilerproc either because it }
+        { returns its results in the flags instead of in eax                    }
+        if ((nodetype = addn) and
+           is_shortstring(resulttype.def)) or
+           ((nodetype in [ltn,lten,gtn,gten,equaln,unequaln]) and
+            not(((left.nodetype=stringconstn) and (str_length(left)=0)) or
+                ((right.nodetype=stringconstn) and (str_length(right)=0))) and
+            is_shortstring(left.resulttype.def)) then
+          begin
+            result := nil;
+            exit;
+          end;
+        { otherwise, use the generic code }
+        result := inherited first_addstring;
+      end;
+
+
+    procedure ti386addnode.second_addstring;
 
       var
-{$ifdef newoptimizations2}
-        l: tasmlabel;
-        hreg: tregister;
-        href2: preference;
-        oldregisterdef: boolean;
-{$endif newoptimizations2}
         pushedregs : tpushed;
         href       : treference;
         pushed,
@@ -143,138 +164,6 @@ interface
         if nf_swaped in flags then
           swapleftright;
         case tstringdef(left.resulttype.def).string_typ of
-           st_widestring,
-           st_ansistring:
-             begin
-                case nodetype of
-                   addn:
-                     begin
-                        cmpop:=false;
-                        secondpass(left);
-                        { to avoid problem with maybe_push and restore }
-                        set_location(location,left.location);
-                        pushed:=maybe_push(right.registers32,self,false);
-                        secondpass(right);
-                        if pushed then
-                          begin
-                             restore(self,false);
-                             set_location(left.location,location);
-                          end;
-                        { get the temp location, must be done before regs are
-                          released/pushed because after the release the regs are
-                          still used for the push (PFV) }
-                        clear_location(location);
-                        location.loc:=LOC_MEM;
-                        if (tstringdef(left.resulttype.def).string_typ=st_widestring) then
-                         begin
-                           gettempwidestringreference(location.reference);
-                           decrstringref(cwidestringtype.def,location.reference);
-                         end
-                        else
-                         begin
-                           gettempansistringreference(location.reference);
-                           decrstringref(cansistringtype.def,location.reference);
-                         end;
-                        { release used registers }
-                        del_location(right.location);
-                        del_location(left.location);
-                        { push the still used registers }
-                        pushusedregisters(pushedregs,$ff);
-                        { push data }
-                        emitpushreferenceaddr(location.reference);
-                        emit_push_loc(right.location);
-                        emit_push_loc(left.location);
-                        saveregvars($ff);
-                        if tstringdef(left.resulttype.def).string_typ=st_widestring then
-                          emitcall('FPC_WIDESTR_CONCAT')
-                        else
-                          emitcall('FPC_ANSISTR_CONCAT');
-                        popusedregisters(pushedregs);
-                        maybe_loadself;
-                     end;
-                   ltn,lten,gtn,gten,
-                   equaln,unequaln:
-                     begin
-                        cmpop:=true;
-                        if (nodetype in [equaln,unequaln]) and
-                           (left.nodetype=stringconstn) and
-                           (tstringconstnode(left).len=0) then
-                          begin
-                             secondpass(right);
-                             { release used registers }
-                             del_location(right.location);
-                             del_location(left.location);
-                             case right.location.loc of
-                               LOC_REFERENCE,LOC_MEM:
-                                 emit_const_ref(A_CMP,S_L,0,newreference(right.location.reference));
-                               LOC_REGISTER,LOC_CREGISTER:
-                                 emit_const_reg(A_CMP,S_L,0,right.location.register);
-                             end;
-                          end
-                        else if (nodetype in [equaln,unequaln]) and
-                          (right.nodetype=stringconstn) and
-                          (tstringconstnode(right).len=0) then
-                          begin
-                             secondpass(left);
-                             { release used registers }
-                             del_location(right.location);
-                             del_location(left.location);
-                             case right.location.loc of
-                               LOC_REFERENCE,LOC_MEM:
-                                 emit_const_ref(A_CMP,S_L,0,newreference(left.location.reference));
-                               LOC_REGISTER,LOC_CREGISTER:
-                                 emit_const_reg(A_CMP,S_L,0,left.location.register);
-                             end;
-                          end
-                        else
-                          begin
-                             secondpass(left);
-                             pushed:=maybe_push(right.registers32,left,false);
-                             secondpass(right);
-                             if pushed then
-                               restore(left,false);
-                             { release used registers }
-                             del_location(right.location);
-                             del_location(left.location);
-                             { push the still used registers }
-                             pushusedregisters(pushedregs,$ff);
-                             { push data }
-                             case right.location.loc of
-                               LOC_REFERENCE,LOC_MEM:
-                                 emit_push_mem(right.location.reference);
-                               LOC_REGISTER,LOC_CREGISTER:
-                                 emit_reg(A_PUSH,S_L,right.location.register);
-                             end;
-                             case left.location.loc of
-                               LOC_REFERENCE,LOC_MEM:
-                                 emit_push_mem(left.location.reference);
-                               LOC_REGISTER,LOC_CREGISTER:
-                                 emit_reg(A_PUSH,S_L,left.location.register);
-                             end;
-                             saveregvars($ff);
-                             if tstringdef(left.resulttype.def).string_typ=st_widestring then
-                               emitcall('FPC_WIDESTR_COMPARE')
-                             else
-                               emitcall('FPC_ANSISTR_COMPARE');
-                             emit_reg_reg(A_OR,S_L,R_EAX,R_EAX);
-                             popusedregisters(pushedregs);
-                             maybe_loadself;
-                          end;
-                     end;
-                end;
-               if tstringdef(left.resulttype.def).string_typ=st_widestring then
-                 begin
-                    ungetiftempwidestr(left.location.reference);
-                    ungetiftempwidestr(right.location.reference);
-                 end
-               else
-                 begin
-                    ungetiftempansi(left.location.reference);
-                    ungetiftempansi(right.location.reference);
-                 end;
-               { the result of wide/ansicompare is signed :/ }
-               SetResultLocation(cmpop,false);
-             end;
            st_shortstring:
              begin
                 case nodetype of
@@ -309,186 +198,66 @@ interface
                              left.location.loc:=LOC_MEM;
                              left.location.reference:=href;
 
-{$ifdef newoptimizations2}
-                             { length of temp string = 255 (JM) }
-                             { *** redefining a type is not allowed!! (thanks, Pierre) }
-                             { also problem with constant string!                      }
-                             tstringdef(left.resulttype.def).len := 255;
-
-{$endif newoptimizations2}
                           end;
 
                         secondpass(right);
 
-{$ifdef newoptimizations2}
-                        { special case for string := string + char (JM) }
-                        { needs string length stuff from above!         }
-                        hreg := R_NO;
-                        if is_shortstring(left.resulttype.def) and
-                           is_char(right.resulttype.def) then
-                          begin
-                            getlabel(l);
-                            getexplicitregister32(R_EDI);
-                            { load the current string length }
-                            emit_ref_reg(A_MOVZX,S_BL,
-                              newreference(left.location.reference),R_EDI);
-                            { is it already maximal? }
-                            emit_const_reg(A_CMP,S_L,
-                              tstringdef(left.resulttype.def).len,R_EDI);
-                            emitjmp(C_E,l);
-                            { no, so add the new character }
-                            { is it a constant char? }
-                            if (right.nodetype <> ordconstn) then
-                              { no, make sure it is in a register }
-                              if right.location.loc in [LOC_REFERENCE,LOC_MEM] then
-                                begin
-                                  { free the registers of right }
-                                  del_reference(right.location.reference);
-                                  { get register for the char }
-                                  hreg := reg32toreg8(getregister32);
-                                  emit_ref_reg(A_MOV,S_B,
-                                    newreference(right.location.reference),
-                                    hreg);
-                                 { I don't think a temp char exists, but it won't hurt (JM) }
-                                 ungetiftemp(right.location.reference);
-                                end
-                              else hreg := right.location.register;
-                            href2 := newreference(left.location.reference);
-                            { we need a new reference to store the character }
-                            { at the end of the string. Check if the base or }
-                            { index register is still free                   }
-                            if (left.location.reference.base <> R_NO) and
-                               (left.location.reference.index <> R_NO) then
-                              begin
-                                { they're not free, so add the base reg to }
-                                { the string length (since the index can   }
-                                { have a scalefactor) and use EDI as base  }
-                                emit_reg_reg(A_ADD,S_L,
-                                  left.location.reference.base,R_EDI);
-                                href2^.base := R_EDI;
-                              end
-                            else
-                              { at least one is still free, so put EDI there }
-                              if href2^.base = R_NO then
-                                href2^.base := R_EDI
-                              else
-                                begin
-                                  href2^.index := R_EDI;
-                                  href2^.scalefactor := 1;
-                                end;
-                            { we need to be one position after the last char }
-                            inc(href2^.offset);
-                            { increase the string length }
-                            emit_ref(A_INC,S_B,newreference(left.location.reference));
-                            { and store the character at the end of the string }
-                            if (right.nodetype <> ordconstn) then
-                              begin
-                                { no new_reference(href2) because it's only }
-                                { used once (JM)                            }
-                                emit_reg_ref(A_MOV,S_B,hreg,href2);
-                                ungetregister(hreg);
-                              end
-                            else
-                              emit_const_ref(A_MOV,S_B,right.value,href2);
-                            emitlab(l);
-                            ungetregister32(R_EDI);
-                          end
-                        else
-                          begin
-{$endif  newoptimizations2}
                         { on the right we do not need the register anymore too }
                         { Instead of releasing them already, simply do not }
                         { push them (so the release is in the right place, }
                         { because emitpushreferenceaddr doesn't need extra }
                         { registers) (JM)                                  }
-                            regstopush := $ff;
-                            remove_non_regvars_from_loc(right.location,
-                              regstopush);
-                            pushusedregisters(pushedregs,regstopush);
-                           { push the maximum possible length of the result }
-{$ifdef newoptimizations2}
-                           { string (could be < 255 chars now) (JM)         }
-                            emit_const(A_PUSH,S_L,
-                              tstringdef(left.resulttype.def).len);
-{$endif newoptimizations2}
-                            emitpushreferenceaddr(left.location.reference);
-                           { the optimizer can more easily put the          }
-                           { deallocations in the right place if it happens }
-                           { too early than when it happens too late (if    }
-                           { the pushref needs a "lea (..),edi; push edi")  }
-                            del_reference(right.location.reference);
-                            emitpushreferenceaddr(right.location.reference);
-                            saveregvars(regstopush);
-{$ifdef newoptimizations2}
-                            emitcall('FPC_SHORTSTR_CONCAT_LEN');
-{$else newoptimizations2}
-                            emitcall('FPC_SHORTSTR_CONCAT');
-{$endif newoptimizations2}
-                            ungetiftemp(right.location.reference);
-                            maybe_loadself;
-                            popusedregisters(pushedregs);
-{$ifdef newoptimizations2}
-                        end;
-{$endif newoptimizations2}
+                        regstopush := $ff;
+                        remove_non_regvars_from_loc(right.location,
+                          regstopush);
+                        pushusedregisters(pushedregs,regstopush);
+                       { push the maximum possible length of the result }
+                        emitpushreferenceaddr(left.location.reference);
+                       { the optimizer can more easily put the          }
+                       { deallocations in the right place if it happens }
+                       { too early than when it happens too late (if    }
+                       { the pushref needs a "lea (..),edi; push edi")  }
+                        del_reference(right.location.reference);
+                        emitpushreferenceaddr(right.location.reference);
+                        saveregvars(regstopush);
+                        emitcall('FPC_SHORTSTR_CONCAT');
+                        ungetiftemp(right.location.reference);
+                        maybe_loadself;
+                        popusedregisters(pushedregs);
                         set_location(location,left.location);
                      end;
-                   ltn,lten,gtn,gten,
-                   equaln,unequaln :
+                   ltn,lten,gtn,gten,equaln,unequaln :
                      begin
-                        cmpop:=true;
-                        { generate better code for s='' and s<>'' }
-                        if (nodetype in [equaln,unequaln]) and
-                           (((left.nodetype=stringconstn) and (str_length(left)=0)) or
-                            ((right.nodetype=stringconstn) and (str_length(right)=0))) then
-                          begin
-                             secondpass(left);
-                             { are too few registers free? }
-                             pushed:=maybe_push(right.registers32,left,false);
-                             secondpass(right);
-                             if pushed then
-                               restore(left,false);
-                             { only one node can be stringconstn }
-                             { else pass 1 would have evaluted   }
-                             { this node                         }
-                             if left.nodetype=stringconstn then
-                               emit_const_ref(
-                                 A_CMP,S_B,0,newreference(right.location.reference))
-                             else
-                               emit_const_ref(
-                                 A_CMP,S_B,0,newreference(left.location.reference));
-                             del_reference(right.location.reference);
-                             del_reference(left.location.reference);
-                          end
-                        else
-                          begin
-                             pushusedregisters(pushedregs,$ff);
-                             secondpass(left);
-                             emitpushreferenceaddr(left.location.reference);
-                             del_reference(left.location.reference);
-                             secondpass(right);
-                             emitpushreferenceaddr(right.location.reference);
-                             del_reference(right.location.reference);
-                             saveregvars($ff);
-                             emitcall('FPC_SHORTSTR_COMPARE');
-                             maybe_loadself;
-                             popusedregisters(pushedregs);
-                          end;
-                        ungetiftemp(left.location.reference);
-                        ungetiftemp(right.location.reference);
+                       cmpop := true;
+                       pushusedregisters(pushedregs,$ff);
+                       secondpass(left);
+                       emitpushreferenceaddr(left.location.reference);
+                       del_reference(left.location.reference);
+                       secondpass(right);
+                       emitpushreferenceaddr(right.location.reference);
+                       del_reference(right.location.reference);
+                       saveregvars($ff);
+                       emitcall('FPC_SHORTSTR_COMPARE');
+                       maybe_loadself;
+                       popusedregisters(pushedregs);
+                       ungetiftemp(left.location.reference);
+                       ungetiftemp(right.location.reference);
                      end;
-                   else CGMessage(type_e_mismatch);
                 end;
-               SetResultLocation(cmpop,true);
+                SetResultLocation(cmpop,true);
              end;
-          end;
-      end;
+           else
+             { rest should be handled in first pass (JM) }
+             internalerror(200108303);
+       end;
+     end;
 
 
 {*****************************************************************************
                                 Addset
 *****************************************************************************}
 
-    procedure ti386addnode.addset;
+    procedure ti386addnode.second_addset;
       var
         createset,
         cmpop,
@@ -784,14 +553,14 @@ interface
         own procedures }
          case left.resulttype.def.deftype of
          stringdef : begin
-                       addstring;
+                       second_addstring;
                        exit;
                      end;
             setdef : begin
                      { normalsets are handled separate }
                        if not(tsetdef(left.resulttype.def).settype=smallset) then
                         begin
-                          addset;
+                          second_addset;
                           exit;
                         end;
                      end;
@@ -2313,7 +2082,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.19  2001-08-29 17:50:45  jonas
+  Revision 1.20  2001-08-30 15:43:14  jonas
+    * converted adding/comparing of strings to compileproc. Note that due
+      to the way the shortstring helpers for i386 are written, they are
+      still handled by the old code (reason: fpc_shortstr_compare returns
+      results in the flags instead of in eax and fpc_shortstr_concat
+      has wierd parameter conventions). The compilerproc stuff should work
+      fine with the generic implementations though.
+    * removed some nested comments warnings
+
+  Revision 1.19  2001/08/29 17:50:45  jonas
     * removed unused var
 
   Revision 1.18  2001/08/29 12:03:23  jonas

compiler/nadd.pas

@@ -34,6 +34,10 @@ interface
           constructor create(tt : tnodetype;l,r : tnode);override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
+         protected
+          { override the following if you want to implement }
+          { parts explicitely in the code generator (JM)    }
+          function first_addstring: tnode; virtual;
        end;
 
     var
@@ -52,7 +56,7 @@ implementation
       cpuinfo,
       cgbase,
       htypechk,pass_1,
-      nmat,ncnv,nld,ncon,nset,nopt,
+      nmat,ncnv,nld,ncon,nset,nopt,ncal,ninl,
       cpubase;
 
 
@@ -789,6 +793,7 @@ implementation
                  if not(is_shortstring(rd) or is_char(rd)) then
                    inserttypeconv(right,cshortstringtype);
               end;
+              
           end
 
          { pointer comparision and subtraction }
@@ -1019,6 +1024,80 @@ implementation
       end;
 
 
+    function taddnode.first_addstring: tnode;
+      var
+        p: tnode;
+      begin
+        { when we get here, we are sure that both the left and the right }
+        { node are both strings of the same stringtype (JM)              }
+        case nodetype of
+          addn:
+            begin
+              { note: if you implemented an fpc_shortstr_concat similar to the    }
+              { one in i386.inc, you have to override first_addstring like in     }
+              { ti386addnode.first_string and implement the shortstring concat    }
+              { manually! The generic routine is different from the i386 one (JM) }
+
+              { create the call to the concat routine both strings as arguments }
+              result := ccallnode.createintern('fpc_'+
+                lower(tstringdef(resulttype.def).stringtypname)+'_concat',
+                ccallparanode.create(right,ccallparanode.create(left,nil)));
+              { we reused the arguments }
+              left := nil;
+              right := nil;
+              firstpass(result);
+            end;
+          ltn,lten,gtn,gten,equaln,unequaln :
+            begin
+              { generate better code for s='' and s<>'' }
+              if (nodetype in [equaln,unequaln]) and
+                 (((left.nodetype=stringconstn) and (str_length(left)=0)) or
+                  ((right.nodetype=stringconstn) and (str_length(right)=0))) then
+                begin
+                  { switch so that the constant is always on the right }
+                  if left.nodetype = stringconstn then
+                    begin
+                      p := left;
+                      left := right;
+                      right := p;
+                    end;
+                  if is_shortstring(left.resulttype.def) then
+                    { compare the length with 0 }
+                    result := caddnode.create(nodetype,
+                      cinlinenode.create(in_length_x,false,left),
+                      cordconstnode.create(0,s32bittype))
+                  else
+                    begin
+                      { compare the pointer with nil (for ansistrings etc), }
+                      { faster than getting the length (JM)                 }
+                      result:= caddnode.create(nodetype,
+                        ctypeconvnode.create(left,voidpointertype),
+                        cpointerconstnode.create(0,voidpointertype));
+                      taddnode(result).left.toggleflag(nf_explizit);
+                    end;
+                  { left is reused }
+                  left := nil;
+                  { right isn't }
+                  right.free;
+                  right := nil;
+                  firstpass(result);
+                  exit;
+                end;
+              { no string constant -> call compare routine }
+              result := ccallnode.createintern('fpc_'+
+                lower(tstringdef(left.resulttype.def).stringtypname)+'_compare',
+                ccallparanode.create(right,ccallparanode.create(left,nil)));
+              { and compare its result with 0 according to the original operator }
+              result := caddnode.create(nodetype,result,
+                cordconstnode.create(0,s32bittype));
+              left := nil;
+              right := nil;
+              firstpass(result);
+            end;
+        end;
+      end;
+
+
     function taddnode.pass_1 : tnode;
       var
          hp      : tnode;
@@ -1173,15 +1252,10 @@ implementation
                        pass_1 := hp;
                        exit;
                      end;
-                   { this is only for add, the comparisaion is handled later }
-                   location.loc:=LOC_MEM;
                 end;
-              { here we call STRCONCAT or STRCMP or STRCOPY }
-              procinfo^.flags:=procinfo^.flags or pi_do_call;
-              if location.loc=LOC_MEM then
-                calcregisters(self,0,0,0)
-              else
-                calcregisters(self,1,0,0);
+             { otherwise, let addstring convert everything }
+              result := first_addstring;
+              exit;
            end
 
          { is one a real float ? }
@@ -1283,7 +1357,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.33  2001-08-26 13:36:38  florian
+  Revision 1.34  2001-08-30 15:43:14  jonas
+    * converted adding/comparing of strings to compileproc. Note that due
+      to the way the shortstring helpers for i386 are written, they are
+      still handled by the old code (reason: fpc_shortstr_compare returns
+      results in the flags instead of in eax and fpc_shortstr_concat
+      has wierd parameter conventions). The compilerproc stuff should work
+      fine with the generic implementations though.
+    * removed some nested comments warnings
+
+  Revision 1.33  2001/08/26 13:36:38  florian
     * some cg reorganisation
     * some PPC updates
 

rtl/i386/i386.inc

@@ -741,10 +741,6 @@ begin
   end ['ESI','EDI','EAX','ECX'];
 end;
 
-{$ifdef had_openstrings}
-{$p+}
-{$endif had_openstrings}
-
 procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY'];
 begin
   asm
@@ -784,8 +780,22 @@ begin
 end;
 
 {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
-procedure fpc_shortstr_concat(const s1,s2:shortstring);
-  [public,alias:'FPC_SHORTSTR_CONCAT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+{$ifdef hascompilerproc}
+{ define a dummy fpc_shortstr_concat for i386. Only the next one }
+{ is really used by the compiler, but the compilerproc forward   }
+{ definition must still be fulfilled (JM)                        }
+function fpc_shortstr_concat(const s1,s2: shortstring): shortstring; compilerproc;
+begin
+  { avoid warning }
+  fpc_shortstr_concat := '';
+  runerror(216);
+end;
+{$endif hascompilerproc}
+
+
+procedure fpc_shortstr_concat_intern(const s1, s2:shortstring);
+  [public,alias:'FPC_SHORTSTR_CONCAT'];
 begin
   asm
         movl    s2,%edi
@@ -1144,14 +1154,23 @@ procedure inclocked(var l : longint);assembler;
 
 {
   $Log$
-  Revision 1.16  2001-08-29 19:49:04  jonas
+  Revision 1.17  2001-08-30 15:43:14  jonas
+    * converted adding/comparing of strings to compileproc. Note that due
+      to the way the shortstring helpers for i386 are written, they are
+      still handled by the old code (reason: fpc_shortstr_compare returns
+      results in the flags instead of in eax and fpc_shortstr_concat
+      has wierd parameter conventions). The compilerproc stuff should work
+      fine with the generic implementations though.
+    * removed some nested comments warnings
+
+  Revision 1.16  2001/08/29 19:49:04  jonas
     * some fixes in compilerprocs for chararray to string conversions
     * conversion from string to chararray is now also done via compilerprocs
 
   Revision 1.15  2001/08/28 13:24:47  jonas
     + compilerproc implementation of most string-related type conversions
     - removed all code from the compiler which has been replaced by
-      compilerproc implementations (using {$ifdef hascompilerproc} is not
+      compilerproc implementations (using (ifdef hascompilerproc) is not
       necessary in the compiler)
 
   Revision 1.14  2001/08/01 15:00:09  jonas

rtl/inc/astrings.inc

@@ -168,7 +168,13 @@ end;
 Procedure fpc_AnsiStr_Assign (Var S1 : Pointer;S2 : Pointer);[external name 'FPC_ANSISTR_ASSIGN'];
 {$endif hascompilerproc}
 
-Procedure fpc_AnsiStr_Concat (S1,S2 : Pointer;var S3 : Pointer);[Public, alias: 'FPC_ANSISTR_CONCAT'];  {$ifdef hascompilerproc} compilerproc; {$endif}
+{$ifdef hascompilerproc}
+function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): ansistring; compilerproc;
+var
+  S3: ansistring absolute result;
+{$else hascompilerproc}
+Procedure fpc_AnsiStr_Concat (const S1,S2 : ansistring;var S3 : ansistring);[Public, alias: 'FPC_ANSISTR_CONCAT'];
+{$endif hascompilerproc}
 {
   Concatenates 2 AnsiStrings : S1+S2.
   Result Goes to S3;
@@ -177,20 +183,18 @@ Var
   Size,Location : Longint;
 begin
 { only assign if s1 or s2 is empty }
-  if (S1=Nil) then
-    fpc_AnsiStr_Assign(S3,S2)
+  if (S1='') then
+    s3 := s2
   else
-    if (S2=Nil) then
-      fpc_AnsiStr_Assign(S3,S1)
+    if (S2='') then
+      s3 := s1
   else
     begin
-       { create new result }
-       fpc_AnsiStr_Decr_Ref(S3);
-       Size:=PAnsiRec(S2-FirstOff)^.Len;
-       Location:=Length(AnsiString(S1));
-       SetLength (AnsiString(S3),Size+Location);
-       Move (S1^,S3^,Location);
-       Move (S2^,(S3+location)^,Size+1);
+       Size:=length(S2);
+       Location:=Length(S1);
+       SetLength (S3,Size+Location);
+       Move (S1[1],S3[1],Location);
+       Move (S2[1],S3[location+1],Size+1);
     end;
 end;
 
@@ -366,7 +370,7 @@ end;
 {$endif hascompilerproc}
 
 
-Function fpc_AnsiStr_Compare(S1,S2 : Pointer): Longint;[Public,Alias : 'FPC_ANSISTR_COMPARE'];  {$ifdef hascompilerproc} compilerproc; {$endif}
+Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): Longint;[Public,Alias : 'FPC_ANSISTR_COMPARE'];  {$ifdef hascompilerproc} compilerproc; {$endif}
 {
   Compares 2 AnsiStrings;
   The result is
@@ -377,18 +381,18 @@ Function fpc_AnsiStr_Compare(S1,S2 : Pointer): Longint;[Public,Alias : 'FPC_ANSI
 Var
   MaxI,Temp : Longint;
 begin
-  if S1=S2 then
+  if pointer(S1)=pointer(S2) then
    begin
      fpc_AnsiStr_Compare:=0;
      exit;
    end;
-  Maxi:=Length(AnsiString(S1));
-  temp:=Length(AnsiString(S2));
+  Maxi:=Length(S1);
+  temp:=Length(S2);
   If MaxI>Temp then
    MaxI:=Temp;
-  Temp:=CompareByte(S1^,S2^,MaxI);
+  Temp:=CompareByte(S1[1],S2[1],MaxI);
   if temp=0 then
-   temp:=Length(AnsiString(S1))-Length(AnsiString(S2));
+   temp:=Length(S1)-Length(S2);
   fpc_AnsiStr_Compare:=Temp;
 end;
 
@@ -794,14 +798,23 @@ end;
 
 {
   $Log$
-  Revision 1.20  2001-08-29 19:49:04  jonas
+  Revision 1.21  2001-08-30 15:43:15  jonas
+    * converted adding/comparing of strings to compileproc. Note that due
+      to the way the shortstring helpers for i386 are written, they are
+      still handled by the old code (reason: fpc_shortstr_compare returns
+      results in the flags instead of in eax and fpc_shortstr_concat
+      has wierd parameter conventions). The compilerproc stuff should work
+      fine with the generic implementations though.
+    * removed some nested comments warnings
+
+  Revision 1.20  2001/08/29 19:49:04  jonas
     * some fixes in compilerprocs for chararray to string conversions
     * conversion from string to chararray is now also done via compilerprocs
 
   Revision 1.19  2001/08/28 13:24:47  jonas
     + compilerproc implementation of most string-related type conversions
     - removed all code from the compiler which has been replaced by
-      compilerproc implementations (using {$ifdef hascompilerproc} is not
+      compilerproc implementations (using (ifdef hascompilerproc) is not
       necessary in the compiler)
 
   Revision 1.18  2001/08/13 12:40:16  jonas

rtl/inc/compproc.inc

@@ -29,7 +29,7 @@ type
 
 procedure fpc_Shortstr_SetLength(var s:shortstring;len:StrLenInt); compilerproc;
 function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; compilerproc;
-procedure fpc_shortstr_concat(const s1,s2:shortstring); compilerproc;
+function fpc_shortstr_concat(const s1,s2:shortstring): shortstring; compilerproc;
 function fpc_shortstr_compare(const dstr,sstr:shortstring) : longint; compilerproc;
 function fpc_pchar_to_shortstr(p:pchar):shortstring; compilerproc;
 
@@ -56,7 +56,7 @@ Function fpc_Val_Real_ShortStr(const s : shortstring; var code : ValSInt): ValRe
 Procedure fpc_AnsiStr_Decr_Ref (Var S : Pointer); compilerproc;
 Procedure fpc_AnsiStr_Incr_Ref (Var S : Pointer); compilerproc;
 Procedure fpc_AnsiStr_Assign (Var S1 : Pointer;S2 : Pointer); compilerproc;
-Procedure fpc_AnsiStr_Concat (S1,S2 : Pointer;var S3 : Pointer); compilerproc;
+function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): AnsiString; compilerproc;
 {$ifdef EXTRAANSISHORT}
 Procedure fpc_AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString); compilerproc;
 {$endif EXTRAANSISHORT}
@@ -66,7 +66,7 @@ Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;
 Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
 Function fpc_CharArray_To_AnsiStr(const arr: array of char): ansistring; compilerproc;
 function fpc_ansistr_to_chararray(arraysize: longint; const src: ansistring): fpc_big_chararray; compilerproc;
-Function fpc_AnsiStr_Compare(S1,S2 : Pointer): Longint; compilerproc;
+Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): Longint; compilerproc;
 Procedure fpc_AnsiStr_CheckZero(p : pointer); compilerproc;
 Procedure fpc_AnsiStr_CheckRange(len,index : longint); compilerproc;
 Procedure fpc_AnsiStr_SetLength (Var S : AnsiString; l : Longint); compilerproc;
@@ -82,12 +82,12 @@ Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString; compilerp
 Function fpc_WideStr_To_AnsiStr (const S2 : WideString): AnsiString; compilerproc;
 Function fpc_AnsiStr_To_WideStr (Const S2 : AnsiString): WideString; compilerproc;
 Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer); compilerproc;
-Procedure fpc_WideStr_Concat (S1,S2 : Pointer;var S3 : Pointer); compilerproc;
+Function fpc_WideStr_Concat (const S1,S2 : WideString) : WideString; compilerproc;
 Function fpc_Char_To_WideStr(const c : Char): WideString; compilerproc;
 Function fpc_PChar_To_WideStr(const p : pchar): WideString; compilerproc;
 Function fpc_CharArray_To_WideStr(const arr: array of char): WideString; compilerproc;
 function fpc_widestr_to_chararray(arraysize: longint; const src: WideString): fpc_big_chararray; compilerproc;
-Function fpc_WideStr_Compare(S1,S2 : Pointer): Longint; compilerproc;
+Function fpc_WideStr_Compare(const S1,S2 : WideString): Longint; compilerproc;
 Procedure fpc_WideStr_CheckZero(p : pointer); compilerproc;
 Procedure fpc_WideStr_CheckRange(len,index : longint); compilerproc;
 Procedure fpc_WideStr_SetLength (Var S : WideString; l : Longint); compilerproc;
@@ -237,14 +237,23 @@ Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;var Buf); compiler
 
 {
   $Log$
-  Revision 1.6  2001-08-29 19:49:04  jonas
+  Revision 1.7  2001-08-30 15:43:15  jonas
+    * converted adding/comparing of strings to compileproc. Note that due
+      to the way the shortstring helpers for i386 are written, they are
+      still handled by the old code (reason: fpc_shortstr_compare returns
+      results in the flags instead of in eax and fpc_shortstr_concat
+      has wierd parameter conventions). The compilerproc stuff should work
+      fine with the generic implementations though.
+    * removed some nested comments warnings
+
+  Revision 1.6  2001/08/29 19:49:04  jonas
     * some fixes in compilerprocs for chararray to string conversions
     * conversion from string to chararray is now also done via compilerprocs
 
   Revision 1.5  2001/08/28 13:24:47  jonas
     + compilerproc implementation of most string-related type conversions
     - removed all code from the compiler which has been replaced by
-      compilerproc implementations (using {$ifdef hascompilerproc} is not
+      compilerproc implementations (using (ifdef hascompilerproc) is not
       necessary in the compiler)
 
   Revision 1.4  2001/08/23 14:28:36  jonas

rtl/inc/generic.inc

@@ -537,20 +537,24 @@ end;
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
 
-procedure fpc_shortstr_concat(const s1,s2:shortstring);[public,alias:'FPC_SHORTSTR_CONCAT'];  {$ifdef hascompilerproc} compilerproc; {$endif}
+{ note: this routine is *DIFFERENT* from the routine in i386.inc and as such you }
+{ cannot use it with the i386 compiler, unless you remove the                    }
+{ ti386addnode.first_string method (JM)                                          }
+function fpc_shortstr_concat(const s1,s2:shortstring): shortstring;[public,alias:'FPC_SHORTSTR_CONCAT'];
 var
   s1l, s2l : byte;
-type
-  pstring = ^string;
 begin
+{ these are shortstrings, they can't be nil! (JM)
   if (s1=nil) or (s2=nil) then
     exit;
-  s1l:=length(pstring(s1)^);
-  s2l:=length(pstring(s2)^);
+}
+  s1l:=length(s1);
+  s2l:=length(s2);
   if s1l+s2l>255 then
-    s1l:=255-s2l;
-  move(pstring(s1)^[1],pstring(s2)^[s2l+1],s1l);
-  pstring(s2)^[0]:=chr(s1l+s2l);
+    s2l:=255-s1l;
+  fpc_shortstr_concat := s1;
+  move(s2[1],fpc_shortstr_concat[s1l+1],s2l);
+  fpc_shortstr_concat[0]:=chr(s1l+s2l);
 end;
 
 {$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
@@ -561,18 +565,16 @@ function fpc_shortstr_compare(const rightstr,leftstr:shortstring) : longint;[pub
 var
    s1,s2,max,i : byte;
    d : longint;
-type
-  pstring = ^string;
 begin
-  s1:=length(pstring(rightstr)^);
-  s2:=length(pstring(leftstr)^);
+  s1:=length(rightstr);
+  s2:=length(leftstr);
   if s1<s2 then
     max:=s1
   else
     max:=s2;
   for i:=1 to max do
     begin
-     d:=byte(pstring(leftstr)^[i])-byte(pstring(rightstr)^[i]);
+     d:=byte(leftstr[i])-byte(rightstr[i]);
      if d>0 then
        exit(1)
      else if d<0 then
@@ -889,14 +891,23 @@ end;
 
 {
   $Log$
-  Revision 1.19  2001-08-29 19:49:04  jonas
+  Revision 1.20  2001-08-30 15:43:15  jonas
+    * converted adding/comparing of strings to compileproc. Note that due
+      to the way the shortstring helpers for i386 are written, they are
+      still handled by the old code (reason: fpc_shortstr_compare returns
+      results in the flags instead of in eax and fpc_shortstr_concat
+      has wierd parameter conventions). The compilerproc stuff should work
+      fine with the generic implementations though.
+    * removed some nested comments warnings
+
+  Revision 1.19  2001/08/29 19:49:04  jonas
     * some fixes in compilerprocs for chararray to string conversions
     * conversion from string to chararray is now also done via compilerprocs
 
   Revision 1.18  2001/08/28 13:24:47  jonas
     + compilerproc implementation of most string-related type conversions
     - removed all code from the compiler which has been replaced by
-      compilerproc implementations (using {$ifdef hascompilerproc} is not
+      compilerproc implementations (using (ifdef hascompilerproc) is not
       necessary in the compiler)
 
   Revision 1.17  2001/08/01 15:00:10  jonas

rtl/inc/wstrings.inc

@@ -323,7 +323,13 @@ Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[external name 'FPC
 {$endif hascompilerproc}
 
 { checked against the ansistring routine, 2001-05-27 (FK) }
-Procedure fpc_WideStr_Concat (S1,S2 : Pointer;var S3 : Pointer);[Public, alias: 'FPC_WIDESTR_CONCAT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$ifdef hascompilerproc}
+function fpc_WideStr_Concat (const S1,S2 : WideString): WideString; compilerproc;
+var
+  S3: WideString absolute result;
+{$else hascompilerproc}
+Procedure fpc_WideStr_Concat (S1,S2 : WideString;var S3 : WideString);[Public, alias: 'FPC_WIDESTR_CONCAT'];
+{$endif hascompilerproc}
 {
   Concatenates 2 WideStrings : S1+S2.
   Result Goes to S3;
@@ -332,20 +338,19 @@ Var
   Size,Location : Longint;
 begin
 { only assign if s1 or s2 is empty }
-  if (S1=Nil) then
-    fpc_WideStr_Assign(S3,S2)
+  if (S1='') then
+    S3 := S2
   else
-    if (S2=Nil) then
-      fpc_WideStr_Assign(S3,S1)
+    if (S2='') then
+      S3 := S1
   else
     begin
        { create new result }
-       fpc_WideStr_Decr_Ref(S3);
-       Size:=PWideRec(S2-WideFirstOff)^.Len;
-       Location:=Length(WideString(S1));
-       SetLength (WideString(S3),Size+Location);
-       Move (S1^,S3^,Location*sizeof(WideChar));
-       Move (S2^,(S3+location*sizeof(WideChar))^,(Size+1)*sizeof(WideChar));
+       Size:=Length(S2);
+       Location:=Length(S1);
+       SetLength (S3,Size+Location);
+       Move (S1[1],S3[1],Location*sizeof(WideChar));
+       Move (S2[1],S3[location+1],(Size+1)*sizeof(WideChar));
     end;
 end;
 
@@ -446,7 +451,7 @@ begin
 end;
 {$endif hascompilerproc}
 
-Function fpc_WideStr_Compare(S1,S2 : Pointer): Longint;[Public,Alias : 'FPC_WIDESTR_COMPARE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Function fpc_WideStr_Compare(const S1,S2 : WideString): Longint;[Public,Alias : 'FPC_WIDESTR_COMPARE']; {$ifdef hascompilerproc} compilerproc; {$endif}
 {
   Compares 2 WideStrings;
   The result is
@@ -457,18 +462,18 @@ Function fpc_WideStr_Compare(S1,S2 : Pointer): Longint;[Public,Alias : 'FPC_WIDE
 Var
   MaxI,Temp : Longint;
 begin
-  if S1=S2 then
+  if pointer(S1)=pointer(S2) then
    begin
      fpc_WideStr_Compare:=0;
      exit;
    end;
-  Maxi:=Length(WideString(S1));
-  temp:=Length(WideString(S2));
+  Maxi:=Length(S1);
+  temp:=Length(S2);
   If MaxI>Temp then
    MaxI:=Temp;
-  Temp:=CompareWord(S1^,S2^,MaxI);
+  Temp:=CompareWord(S1[1],S2[1],MaxI);
   if temp=0 then
-   temp:=Length(WideString(S1))-Length(WideString(S2));
+   temp:=Length(S1)-Length(S2);
   fpc_WideStr_Compare:=Temp;
 end;
 
@@ -840,14 +845,23 @@ end;
 
 {
   $Log$
-  Revision 1.14  2001-08-29 19:49:04  jonas
+  Revision 1.15  2001-08-30 15:43:15  jonas
+    * converted adding/comparing of strings to compileproc. Note that due
+      to the way the shortstring helpers for i386 are written, they are
+      still handled by the old code (reason: fpc_shortstr_compare returns
+      results in the flags instead of in eax and fpc_shortstr_concat
+      has wierd parameter conventions). The compilerproc stuff should work
+      fine with the generic implementations though.
+    * removed some nested comments warnings
+
+  Revision 1.14  2001/08/29 19:49:04  jonas
     * some fixes in compilerprocs for chararray to string conversions
     * conversion from string to chararray is now also done via compilerprocs
 
   Revision 1.13  2001/08/28 13:24:47  jonas
     + compilerproc implementation of most string-related type conversions
     - removed all code from the compiler which has been replaced by
-      compilerproc implementations (using {$ifdef hascompilerproc} is not
+      compilerproc implementations (using (ifdef hascompilerproc) is not
       necessary in the compiler)
 
   Revision 1.12  2001/08/13 12:40:16  jonas