Merged revisions 8898-8899,8906,8908 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r8898 | florian | 2007-10-21 19:33:18 +0200 (Sun, 21 Oct 2007) | 2 lines

* made all fpc_*_to_shortstr helpers a procedure, resolves #8580

........
r8899 | florian | 2007-10-21 19:41:26 +0200 (Sun, 21 Oct 2007) | 2 lines

* forgotten commit (part of last commit)

........
r8906 | jonas | 2007-10-22 00:15:19 +0200 (Mon, 22 Oct 2007) | 2 lines

  * fixed ppc and ppc64 compilation after r8898

........
r8908 | jonas | 2007-10-22 00:58:17 +0200 (Mon, 22 Oct 2007) | 2 lines

  * fixed widechar to shortstring conversion after r8898 (webtbs/tw7758)

........

git-svn-id: branches/fixes_2_2@9451 -

.gitattributes

@@ -8564,6 +8564,7 @@ tests/webtbs/tw8465.pp svneol=native#text/plain
 tests/webtbs/tw8513.pp svneol=native#text/plain
 tests/webtbs/tw8523.pp svneol=native#text/plain
 tests/webtbs/tw8573.pp svneol=native#text/plain
+tests/webtbs/tw8580.pp svneol=native#text/plain
 tests/webtbs/tw8615.pp svneol=native#text/plain
 tests/webtbs/tw8633.pp svneol=native#text/plain
 tests/webtbs/tw8660.pp svneol=native#text/plain

compiler/ncal.pas

@@ -1212,7 +1212,7 @@ implementation
         { both the normal and specified resultdef either have to be returned via a }
         { parameter or not, but no mixing (JM)                                      }
         if paramanager.ret_in_param(typedef,pd.proccalloption) xor
-           paramanager.ret_in_param(pd.returndef,pd.proccalloption) then
+          paramanager.ret_in_param(pd.returndef,pd.proccalloption) then
           internalerror(200108291);
       end;
 

compiler/ncnv.pas

@@ -215,7 +215,7 @@ interface
 implementation
 
    uses
-      cclasses,globtype,systems,
+      globtype,systems,
       cutils,verbose,globals,widestr,
       symconst,symdef,symsym,symbase,symtable,
       ncon,ncal,nset,nadd,ninl,nmem,nmat,nbas,nutils,
@@ -820,17 +820,35 @@ implementation
     function ttypeconvnode.typecheck_chararray_to_string : tnode;
       var
         chartype : string[8];
+        newblock : tblocknode;
+        newstat  : tstatementnode;
+        restemp  : ttempcreatenode;
       begin
         if is_widechar(tarraydef(left.resultdef).elementdef) then
           chartype:='widechar'
         else
           chartype:='char';
-        result := ccallnode.createinternres(
-           'fpc_'+chartype+'array_to_'+tstringdef(resultdef).stringtypname,
-           ccallparanode.create(cordconstnode.create(
-             ord(tarraydef(left.resultdef).lowrange=0),booltype,false),
-           ccallparanode.create(left,nil)),resultdef);
-        left := nil;
+        if tstringdef(resultdef).stringtype=st_shortstring then
+          begin
+            newblock:=internalstatements(newstat);
+            restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
+            addstatement(newstat,restemp);
+            addstatement(newstat,ccallnode.createintern('fpc_'+chartype+'array_to_shortstr',
+              ccallparanode.create(cordconstnode.create(
+                ord(tarraydef(left.resultdef).lowrange=0),booltype,false),
+              ccallparanode.create(left,ccallparanode.create(
+              ctemprefnode.create(restemp),nil)))));
+            addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
+            addstatement(newstat,ctemprefnode.create(restemp));
+            result:=newblock;
+          end
+        else
+          result:=ccallnode.createinternres(
+            'fpc_'+chartype+'array_to_'+tstringdef(resultdef).stringtypname,
+            ccallparanode.create(cordconstnode.create(
+               ord(tarraydef(left.resultdef).lowrange=0),booltype,false),
+             ccallparanode.create(left,nil)),resultdef);
+        left:=nil;
       end;
 
 
@@ -898,11 +916,11 @@ implementation
 
 
     function ttypeconvnode.typecheck_string_to_string : tnode;
-
       var
         procname: string[31];
-        stringpara : tcallparanode;
-
+        newblock : tblocknode;
+        newstat  : tstatementnode;
+        restemp  : ttempcreatenode;
       begin
          result:=nil;
          if (left.nodetype=stringconstn) and
@@ -921,18 +939,20 @@ implementation
              procname := 'fpc_'+tstringdef(left.resultdef).stringtypname+
                          '_to_'+tstringdef(resultdef).stringtypname;
 
-             { create parameter (and remove left node from typeconvnode }
-             { since it's reused as parameter)                          }
-             stringpara := ccallparanode.create(left,nil);
-             left := nil;
-
-             { when converting to shortstrings, we have to pass high(destination) too }
-             if (tstringdef(resultdef).stringtype = st_shortstring) then
-               stringpara.right := ccallparanode.create(cinlinenode.create(
-                 in_high_x,false,self.getcopy),nil);
-
-             { and create the callnode }
-             result := ccallnode.createinternres(procname,stringpara,resultdef);
+             if tstringdef(resultdef).stringtype=st_shortstring then
+               begin
+                 newblock:=internalstatements(newstat);
+                 restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
+                 addstatement(newstat,restemp);
+                 addstatement(newstat,ccallnode.createintern(procname,ccallparanode.create(left,ccallparanode.create(
+                   ctemprefnode.create(restemp),nil))));
+                 addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
+                 addstatement(newstat,ctemprefnode.create(restemp));
+                 result:=newblock;
+               end
+             else
+               result := ccallnode.createinternres(procname,ccallparanode.create(left,nil),resultdef);
+             left:=nil;
            end;
       end;
 
@@ -944,6 +964,9 @@ implementation
          para : tcallparanode;
          hp : tstringconstnode;
          ws : pcompilerwidestring;
+         newblock : tblocknode;
+         newstat  : tstatementnode;
+         restemp  : ttempcreatenode;
 
       begin
          result:=nil;
@@ -980,19 +1003,33 @@ implementation
            if (tstringdef(resultdef).stringtype <> st_shortstring) or
               (torddef(left.resultdef).ordtype = uwidechar) then
              begin
-               { create the procname }
-               if torddef(left.resultdef).ordtype<>uwidechar then
-                 procname := 'fpc_char_to_'
+               if (tstringdef(resultdef).stringtype <> st_shortstring) then
+                 begin
+                   { create the procname }
+                   if torddef(left.resultdef).ordtype<>uwidechar then
+                     procname := 'fpc_char_to_'
+                   else
+                     procname := 'fpc_wchar_to_';
+                   procname:=procname+tstringdef(resultdef).stringtypname;
+
+                   { and the parameter }
+                   para := ccallparanode.create(left,nil);
+
+                   { and finally the call }
+                   result := ccallnode.createinternres(procname,para,resultdef);
+                 end
                else
-                 procname := 'fpc_wchar_to_';
-               procname:=procname+tstringdef(resultdef).stringtypname;
-
-               { and the parameter }
-               para := ccallparanode.create(left,nil);
+                 begin
+                   newblock:=internalstatements(newstat);
+                   restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
+                   addstatement(newstat,restemp);
+                   addstatement(newstat,ccallnode.createintern('fpc_wchar_to_shortstr',ccallparanode.create(left,ccallparanode.create(
+                     ctemprefnode.create(restemp),nil))));
+                   addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
+                   addstatement(newstat,ctemprefnode.create(restemp));
+                   result:=newblock;
+                 end;
                left := nil;
-
-               { and finally the call }
-               result := ccallnode.createinternres(procname,para,resultdef);
              end
            else
              begin
@@ -1277,11 +1314,27 @@ implementation
 
 
     function ttypeconvnode.typecheck_pchar_to_string : tnode;
+      var
+        newblock : tblocknode;
+        newstat  : tstatementnode;
+        restemp  : ttempcreatenode;
       begin
-        result := ccallnode.createinternres(
-          'fpc_pchar_to_'+tstringdef(resultdef).stringtypname,
-          ccallparanode.create(left,nil),resultdef);
-        left := nil;
+        if tstringdef(resultdef).stringtype=st_shortstring then
+          begin
+            newblock:=internalstatements(newstat);
+            restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
+            addstatement(newstat,restemp);
+            addstatement(newstat,ccallnode.createintern('fpc_pchar_to_shortstr',ccallparanode.create(left,ccallparanode.create(
+              ctemprefnode.create(restemp),nil))));
+            addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
+            addstatement(newstat,ctemprefnode.create(restemp));
+            result:=newblock;
+          end
+        else
+          result := ccallnode.createinternres(
+            'fpc_pchar_to_'+tstringdef(resultdef).stringtypname,
+            ccallparanode.create(left,nil),resultdef);
+        left:=nil;
       end;
 
 
@@ -1307,11 +1360,27 @@ implementation
 
 
     function ttypeconvnode.typecheck_pwchar_to_string : tnode;
+      var
+        newblock : tblocknode;
+        newstat  : tstatementnode;
+        restemp  : ttempcreatenode;
       begin
-        result := ccallnode.createinternres(
-          'fpc_pwidechar_to_'+tstringdef(resultdef).stringtypname,
-          ccallparanode.create(left,nil),resultdef);
-        left := nil;
+        if tstringdef(resultdef).stringtype=st_shortstring then
+          begin
+            newblock:=internalstatements(newstat);
+            restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
+            addstatement(newstat,restemp);
+            addstatement(newstat,ccallnode.createintern('fpc_pwidechar_to_shortstr',ccallparanode.create(left,ccallparanode.create(
+              ctemprefnode.create(restemp),nil))));
+            addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
+            addstatement(newstat,ctemprefnode.create(restemp));
+            result:=newblock;
+          end
+        else
+          result := ccallnode.createinternres(
+            'fpc_pwidechar_to_'+tstringdef(resultdef).stringtypname,
+            ccallparanode.create(left,nil),resultdef);
+        left:=nil;
       end;
 
 

compiler/nld.pas

@@ -742,9 +742,8 @@ implementation
                begin
                  hp:=ccallparanode.create
                        (right,
-                  ccallparanode.create(cinlinenode.create
-                       (in_high_x,false,left.getcopy),nil));
-                 result:=ccallnode.createinternreturn('fpc_'+tstringdef(right.resultdef).stringtypname+'_to_shortstr',hp,left);
+                  ccallparanode.create(left,nil));
+                 result:=ccallnode.createintern('fpc_'+tstringdef(right.resultdef).stringtypname+'_to_shortstr',hp);
                  firstpass(result);
                  left:=nil;
                  right:=nil;

compiler/options.pas

@@ -2141,6 +2141,8 @@ begin
   def_system_macro('FPC_HAS_STR_CURRENCY');
   def_system_macro('FPC_REAL2REAL_FIXED');
   def_system_macro('FPC_STRTOCHARARRAYPROC');
+  def_system_macro('FPC_STRTOSHORTSTRINGPROC');
+
 {$ifdef SUPPORT_UNALIGNED}
   def_system_macro('FPC_SUPPORTS_UNALIGNED');
 {$endif SUPPORT_UNALIGNED}

rtl/i386/i386.inc

@@ -620,6 +620,7 @@ end;
 {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
 {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
 
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
 begin
   asm
@@ -655,6 +656,47 @@ begin
 end;
 
 
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring);assembler;[public,alias:'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
+  var
+   saveesi,saveedi : longint;
+  asm
+        movl    %edi,saveedi
+        movl    %esi,saveesi
+        cld
+        movl    %eax,%edi
+        movl    %ecx,%esi
+        movl    %edx,%ecx
+        xorl    %eax,%eax
+        lodsb
+        cmpl    %ecx,%eax
+        jbe     .LStrCopy1
+        movl    %ecx,%eax
+.LStrCopy1:
+        stosb
+        cmpl    $7,%eax
+        jl      .LStrCopy2
+        movl    %edi,%ecx       { Align on 32bits }
+        negl    %ecx
+        andl    $3,%ecx
+        subl    %ecx,%eax
+        rep
+        movsb
+        movl    %eax,%ecx
+        andl    $3,%eax
+        shrl    $2,%ecx
+        rep
+        movsl
+.LStrCopy2:
+        movl    %eax,%ecx
+        rep
+        movsb
+        movl    saveedi,%edi
+        movl    saveesi,%esi
+  end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
+
 procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN'];
 begin
   asm
@@ -866,8 +908,105 @@ end;
 
 {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
 {$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 function fpc_pchar_to_shortstr(p:pchar):shortstring;assembler;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
 {$include strpas.inc}
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar);assembler;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
+var
+  saveres,saveebx,saveesi,saveedi : longint;
+asm
+        movl    %ebx,saveebx
+        movl    %esi,saveesi
+        movl    %edi,saveedi
+{$ifdef regcall}
+        movl    %ecx,%esi
+        movl    %eax,%edi
+        movl    %edi,saveres
+{$else}
+        movl    p,%esi
+{$endif}
+        movl    $1,%ecx
+        testl   %esi,%esi
+        movl    %esi,%eax
+        jz      .LStrPasDone
+{$ifndef REGCALL}
+        movl    res,%edi
+{$endif}
+        leal    3(%esi),%edx
+        andl    $-4,%edx
+        // skip length byte
+        incl    %edi
+        subl    %esi,%edx
+        jz      .LStrPasAligned
+        // align source to multiple of 4 (not dest, because we can't read past
+        // the end of the source, since that may be past the end of the heap
+        // -> sigsegv!!)
+.LStrPasAlignLoop:
+        movb    (%esi),%al
+        incl    %esi
+        testb   %al,%al
+        jz      .LStrPasDone
+        incl    %edi
+        incb    %cl
+        decb    %dl
+        movb    %al,-1(%edi)
+        jne     .LStrPasAlignLoop
+        .balign  16
+.LStrPasAligned:
+        movl    (%esi),%ebx
+        addl    $4,%edi
+        leal    0x0fefefeff(%ebx),%eax
+        movl    %ebx,%edx
+        addl    $4,%esi
+        notl    %edx
+        andl    %edx,%eax
+        addl    $4,%ecx
+        andl    $0x080808080,%eax
+        movl    %ebx,-4(%edi)
+        jnz     .LStrPasEndFound
+        cmpl    $252,%ecx
+        ja      .LStrPasPreEndLoop
+        jmp     .LStrPasAligned
+.LStrPasEndFound:
+        subl    $4,%ecx
+        // this won't overwrite data since the result = 255 char string
+        // and we never process more than the first 255 chars of p
+        shrl    $8,%eax
+        jc      .LStrPasDone
+        incl    %ecx
+        shrl    $8,%eax
+        jc      .LStrPasDone
+        incl    %ecx
+        shrl    $8,%eax
+        jc      .LStrPasDone
+        incl    %ecx
+        jmp     .LStrPasDone
+.LStrPasPreEndLoop:
+        testb   %cl,%cl
+        jz      .LStrPasDone
+        movl    (%esi),%eax
+.LStrPasEndLoop:
+        testb   %al,%al
+        jz      .LStrPasDone
+        movb    %al,(%edi)
+        shrl    $8,%eax
+        incl    %edi
+        incb    %cl
+        jnz     .LStrPasEndLoop
+.LStrPasDone:
+{$ifdef REGCALL}
+        movl    saveres,%edi
+{$else}
+        movl    __RESULT,%edi
+{$endif}
+        addb    $255,%cl
+        movb    %cl,(%edi)
+        movl    saveesi,%esi
+        movl    saveedi,%edi
+        movl    saveebx,%ebx
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
 {$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
 
 

rtl/inc/astrings.inc

@@ -327,6 +327,8 @@ end;
 {$endif EXTRAANSISHORT}
 
 
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+
 { the following declaration has exactly the same effect as                   }
 { procedure fpc_AnsiStr_To_ShortStr (Var S1 : ShortString;S2 : Pointer);     }
 { which is what the old helper was, so we don't need an extra implementation }
@@ -350,6 +352,29 @@ begin
    end;
 end;
 
+{$else FPC_STRTOSHORTSTRINGPROC}
+
+procedure fpc_AnsiStr_To_ShortStr (out res: shortstring; const S2 : Ansistring);[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR'];  compilerproc;
+{
+  Converts a AnsiString to a ShortString;
+}
+Var
+  Size : SizeInt;
+begin
+  if S2='' then
+   res:=''
+  else
+   begin
+     Size:=Length(S2);
+     If Size>high(res) then
+      Size:=high(res);
+     Move (S2[1],res[1],Size);
+     byte(res[0]):=byte(Size);
+   end;
+end;
+
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
 
 Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
 {

rtl/inc/compproc.inc

@@ -50,7 +50,12 @@ Procedure fpc_freemem(p:pointer);compilerproc;
 {$endif FPC_HAS_FEATURE_HEAP}
 
 procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
 {$ifndef STR_CONCAT_PROCS}
 function fpc_shortstr_concat(const s1,s2:shortstring): shortstring; compilerproc;
 {$else STR_CONCAT_PROCS}
@@ -61,11 +66,20 @@ procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring);
 function fpc_shortstr_compare(const left,right:shortstring) : longint; compilerproc;
 function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; compilerproc;
 
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 function fpc_pchar_to_shortstr(p:pchar):shortstring; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar); compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
 function fpc_pchar_length(p:pchar):longint; compilerproc;
 function fpc_pwidechar_length(p:pwidechar):longint; compilerproc;
 
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 function fpc_chararray_to_shortstr(const arr: array of char; zerobased: boolean = true):shortstring; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of char; zerobased: boolean = true); compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
 {$ifndef FPC_STRTOCHARARRAYPROC}
 function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray; compilerproc;
 {$else ndef FPC_STRTOCHARARRAYPROC}
@@ -181,7 +195,11 @@ Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;const Str : AnsiStrin
 {$ifdef EXTRAANSISHORT}
 Procedure fpc_AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString); compilerproc;
 {$endif EXTRAANSISHORT}
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 function fpc_AnsiStr_To_ShortStr (high_of_res: SizeInt;const S2 : Ansistring): shortstring; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_AnsiStr_To_ShortStr (out res : shortstring;const S2 : Ansistring); compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
 Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
 Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;
 
@@ -210,7 +228,11 @@ Function fpc_ansistr_Unique(Var S : Pointer): Pointer; compilerproc; {$IFNDEF VE
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
 Procedure fpc_WideStr_Decr_Ref (Var S : Pointer); compilerproc;
 Procedure fpc_WideStr_Incr_Ref (Var S : Pointer); compilerproc;
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 function fpc_WideStr_To_ShortStr (high_of_res: SizeInt;const S2 : WideString): shortstring; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_WideStr_To_ShortStr (out res: ShortString;const S2 : WideString); compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
 Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString; compilerproc;
 Function fpc_WideStr_To_AnsiStr (const S2 : WideString): AnsiString; compilerproc;
 Function fpc_AnsiStr_To_WideStr (Const S2 : AnsiString): WideString; compilerproc;
@@ -236,7 +258,11 @@ procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: S
 procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: AnsiString); compilerproc;
 procedure fpc_widestr_to_widechararray(out res: array of widechar; const src: WideString); compilerproc;
 {$endif ndef FPC_STRTOCHARARRAYPROC}
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_WideCharArray_To_ShortStr(out res : shortstring;const arr: array of widechar; zerobased: boolean = true); compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
 Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
 Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
 Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt; compilerproc;
@@ -250,7 +276,11 @@ function fpc_widestr_Unique(Var S : Pointer): Pointer; compilerproc;
 {$endif FPC_WINLIKEWIDESTRING}
 Function fpc_Char_To_WChar(const c : Char): WideChar; compilerproc;
 Function fpc_WChar_To_Char(const c : WideChar): Char; compilerproc;
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
 Function fpc_WChar_To_AnsiStr(const c : WideChar): AnsiString; compilerproc;
 Function fpc_WChar_To_WideStr(const c : WideChar): WideString; compilerproc;
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
@@ -260,7 +290,11 @@ Function fpc_WChar_To_WideStr(const c : WideChar): WideString; compilerproc;
 Function fpc_PWideChar_To_AnsiStr(const p : pwidechar): ansistring; compilerproc;
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 Function fpc_PWideChar_To_WideStr(const p : pwidechar): widestring; compilerproc;
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 Function fpc_PWideChar_To_ShortStr(const p : pwidechar): shortstring; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_PWideChar_To_ShortStr(out res : shortstring;const p : pwidechar); compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 
 {$ifdef FPC_HAS_FEATURE_TEXTIO}

rtl/inc/generic.inc

@@ -787,6 +787,7 @@ end;
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
 
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 function fpc_shortstr_to_shortstr(len:longint;const sstr:shortstring): shortstring;[public,alias:'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
 var
   slen : byte;
@@ -798,6 +799,18 @@ begin
   if slen>len then
     result[0]:=chr(len);
 end;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring);[public,alias:'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
+var
+  slen : byte;
+begin
+  slen:=length(sstr);
+  if slen>high(res) then
+    slen:=high(res);
+  move(sstr[0],res[0],slen+1);
+  res[0]:=chr(slen);
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
 
 procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN']; {$ifdef HAS_COMPILER_PROC} compilerproc; {$endif}
 var
@@ -986,6 +999,7 @@ end;
 
 {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
 
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
 var
   l : longint;
@@ -1003,11 +1017,54 @@ begin
   fpc_pchar_to_shortstr := s;
 end;
 
+{$else FPC_STRTOSHORTSTRINGPROC}
+
+procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar);[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
+var
+  l : longint;
+  s: shortstring;
+begin
+  if p=nil then
+    l:=0
+  else
+    l:=strlen(p);
+  if l>high(res) then
+    l:=high(res);
+  if l>0 then
+    move(p^,s[1],l);
+  s[0]:=chr(l);
+  res:=s;
+end;
+
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
 {$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
 
 
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+
+{ also define alias which can be used inside the system unit }
+function fpc_pchar_to_shortstr(p:pchar):shortstring;[external name 'FPC_PCHAR_TO_SHORTSTR'];
+
+{$else FPC_STRTOSHORTSTRINGPROC}
+
+{ also define alias which can be used inside the system unit }
+procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar);[external name 'FPC_PCHAR_TO_SHORTSTR'];
+
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
+function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+    result:=fpc_pchar_to_shortstr(p);
+{$else FPC_STRTOSHORTSTRINGPROC}
+    fpc_pchar_to_shortstr(result,p);
+{$endif FPC_STRTOSHORTSTRINGPROC}
+  end;
+
 {$ifndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
 
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 function fpc_chararray_to_shortstr(const arr: array of char; zerobased: boolean = true):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; compilerproc;
 var
  l: longint;
@@ -1032,6 +1089,32 @@ begin
   move(arr[0],fpc_chararray_to_shortstr[1],len);
   fpc_chararray_to_shortstr[0]:=chr(len);
 end;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of char; zerobased: boolean = true);[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; compilerproc;
+var
+ l: longint;
+ index: longint;
+ len: byte;
+begin
+  l:=high(arr)+1;
+  if l>=high(res)+1 then
+    l:=high(res)
+  else if l<0 then
+    l:=0;
+  if zerobased then
+    begin
+      index:=IndexByte(arr[0],l,0);
+      if index<0 then
+        len:=l
+      else
+        len:=index;
+    end
+  else
+    len:=l;
+  move(arr[0],res[1],len);
+  res[0]:=chr(len);
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
 
 {$endif ndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
 

rtl/inc/strings.pp

@@ -14,10 +14,12 @@
  **********************************************************************}
 unit strings;
 {$S-}
+{$inline on}
 interface
 
     { Implemented in System Unit }
-    function strpas(p:pchar):shortstring;external name 'FPC_PCHAR_TO_SHORTSTR';
+    function strpas(p:pchar):shortstring;inline;
+
     function strlen(p:pchar):sizeint;external name 'FPC_PCHAR_LENGTH';
 
     { Converts a Pascal string to a null-terminated string }
@@ -109,6 +111,27 @@ implementation
 
 { Functions, different from the one in sysutils }
 
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+
+    { also define alias which can be used inside the system unit }
+    function fpc_pchar_to_shortstr(p:pchar):shortstring;[external name 'FPC_PCHAR_TO_SHORTSTR'];
+
+{$else FPC_STRTOSHORTSTRINGPROC}
+
+    { also define alias which can be used inside the system unit }
+    procedure fpc_pchar_to_shortstr(var res : openstring;p:pchar);[external name 'FPC_PCHAR_TO_SHORTSTR'];
+
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
+    function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
+      begin
+    {$ifndef FPC_STRTOSHORTSTRINGPROC}
+        strpas:=fpc_pchar_to_shortstr(p);
+    {$else FPC_STRTOSHORTSTRINGPROC}
+        fpc_pchar_to_shortstr(strpas,p);
+    {$endif FPC_STRTOSHORTSTRINGPROC}
+      end;
+
     function stralloc(L : SizeInt) : pchar;
 
       begin

rtl/inc/systemh.inc

@@ -533,7 +533,7 @@ Function  Sseg:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
                       PChar and String Handling
 ****************************************************************************}
 
-function strpas(p:pchar):shortstring;external name 'FPC_PCHAR_TO_SHORTSTR';
+function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
 function strlen(p:pchar):longint;external name 'FPC_PCHAR_LENGTH';
 
 { Shortstring functions }

rtl/inc/wstrings.inc

@@ -203,7 +203,7 @@ end;
 var
   __data_start: byte; external name '__data_start__';
   __data_end: byte; external name '__data_end__';
-  
+
 function IsWideStringConstant(S: pointer): boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
 {
   Returns True if widestring is constant (located in .data section);
@@ -270,6 +270,7 @@ Procedure fpc_WideStr_Incr_Ref(Var S : Pointer);[Public,Alias:'FPC_WIDESTR_INCR_
 { alias for internal use }
 Procedure fpc_WideStr_Incr_Ref (Var S : Pointer);[external name 'FPC_WIDESTR_INCR_REF'];
 
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 function fpc_WideStr_To_ShortStr (high_of_res: SizeInt;const S2 : WideString): shortstring;[Public, alias: 'FPC_WIDESTR_TO_SHORTSTR'];  compilerproc;
 {
   Converts a WideString to a ShortString;
@@ -288,6 +289,26 @@ begin
       result:=temp;
     end;
 end;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_WideStr_To_ShortStr (out res: ShortString;const S2 : WideString); [Public, alias: 'FPC_WIDESTR_TO_SHORTSTR'];compilerproc;
+{
+  Converts a WideString to a ShortString;
+}
+Var
+  Size : SizeInt;
+  temp : ansistring;
+begin
+  res:='';
+  Size:=Length(S2);
+  if Size>0 then
+    begin
+      If Size>high(res) then
+        Size:=high(res);
+      widestringmanager.Wide2AnsiMoveProc(PWideChar(S2),temp,Size);
+      res:=temp;
+    end;
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
 
 
 Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString;compilerproc;
@@ -367,6 +388,7 @@ begin
 end;
 
 
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 Function fpc_PWideChar_To_ShortStr(const p : pwidechar): shortstring; compilerproc;
 var
   Size : SizeInt;
@@ -382,7 +404,23 @@ begin
       result:=temp;
     end;
 end;
-
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_PWideChar_To_ShortStr(out res : shortstring;const p : pwidechar); compilerproc;
+var
+  Size : SizeInt;
+  temp: ansistring;
+begin
+  res:='';
+  if p=nil then
+    exit;
+  Size:=IndexWord(p^, high(PtrInt), 0);
+  if Size>0 then
+    begin
+      widestringmanager.Wide2AnsiMoveProc(p,temp,Size);
+      res:=temp;
+    end;
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
 
 
 { checked against the ansistring routine, 2001-05-27 (FK) }
@@ -597,9 +635,9 @@ var
   w: widestring;
 begin
   widestringmanager.Ansi2WideMoveProc(@c, w, 1);
-  fpc_Char_To_WChar:= w[1];    
-end;  
- 
+  fpc_Char_To_WChar:= w[1];
+end;
+
 
 
 Function fpc_Char_To_WideStr(const c : Char): WideString; compilerproc;
@@ -648,6 +686,7 @@ begin
 end;
 
 
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
 {
   Converts a WideChar to a ShortString;
@@ -658,6 +697,18 @@ begin
   widestringmanager.Wide2AnsiMoveProc(@c, s, 1);
   fpc_WChar_To_ShortStr:= s;
 end;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc;
+{
+  Converts a WideChar to a ShortString;
+}
+var
+  s: ansistring;
+begin
+  widestringmanager.Wide2AnsiMoveProc(@c,s,1);
+  res:=s;
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
 
 
 Function fpc_PChar_To_WideStr(const p : pchar): WideString; compilerproc;
@@ -692,6 +743,7 @@ begin
 end;
 
 
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring;[public,alias:'FPC_WIDECHARARRAY_TO_SHORTSTR']; compilerproc;
 var
   l: longint;
@@ -717,6 +769,33 @@ begin
   widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),temp,len);
   fpc_WideCharArray_To_ShortStr := temp;
 end;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_WideCharArray_To_ShortStr(out res : shortstring;const arr: array of widechar; zerobased: boolean = true);[public,alias:'FPC_WIDECHARARRAY_TO_SHORTSTR']; compilerproc;
+var
+  l: longint;
+  index: ptrint;
+  len: byte;
+  temp: ansistring;
+begin
+  l := high(arr)+1;
+  if l>=high(res)+1 then
+    l:=high(res)
+  else if l<0 then
+    l:=0;
+  if zerobased then
+    begin
+      index:=IndexWord(arr[0],l,0);
+      if index<0 then
+        len:=l
+      else
+        len:=index;
+    end
+  else
+    len:=l;
+  widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),temp,len);
+  res:=temp;
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
 
 Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
 var

rtl/powerpc/powerpc.inc

@@ -819,64 +819,6 @@ end;
                                  String
 ****************************************************************************}
 
-{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
-function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
-assembler; nostackframe;
-{ input: r3: pointer to result, r4: len, r5: sstr }
-asm
-        { load length source }
-        lbz     r10,0(r5)
-        {  load the begin of the dest buffer in the data cache }
-        dcbtst  0,r3
-
-        { put min(length(sstr),len) in r4 }
-        subfc   r7,r10,r4     { r0 := r4 - r10                               }
-        subfe   r4,r4,r4      { if r3 >= r4 then r3' := 0 else r3' := -1     }
-        and     r7,r7,r4      { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
-        add     r4,r10,r7     { if r3 >= r4 then r3' := r10 else r3' := r3   }
-
-        cmplwi  r4,0
-        { put length in ctr }
-        mtctr   r4
-        stb     r4,0(r3)
-        beq     .LShortStrCopyDone
-.LShortStrCopyLoop:
-        lbzu    r0,1(r5)
-        stbu    r0,1(r3)
-        bdnz    .LShortStrCopyLoop
-.LShortStrCopyDone:
-end;
-
-
-procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN'];
-assembler; nostackframe;
-{ input: r3: len, r4: sstr, r5: dstr }
-asm
-        { load length source }
-        lbz     r10,0(r4)
-        {  load the begin of the dest buffer in the data cache }
-        dcbtst  0,r5
-
-        { put min(length(sstr),len) in r3 }
-        subc    r0,r3,r10    { r0 := r3 - r10                               }
-        subfe   r3,r3,r3     { if r3 >= r4 then r3' := 0 else r3' := -1     }
-        and     r3,r0,r3     { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
-        add     r3,r3,r10    { if r3 >= r4 then r3' := r10 else r3' := r3   }
-
-        cmplwi  r3,0
-        { put length in ctr }
-        mtctr   r3
-        stb     r3,0(r5)
-        beq     .LShortStrCopyDone2
-.LShortStrCopyLoop2:
-        lbzu    r0,1(r4)
-        stbu    r0,1(r5)
-        bdnz    .LShortStrCopyLoop2
-.LShortStrCopyDone2:
-end;
-{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
-
 {$ifndef STR_CONCAT_PROCS}
 
 (*
@@ -1035,9 +977,14 @@ end;
 
 {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
 {$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
-function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
-assembler; nostackframe;
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc; assembler; nostackframe;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar);assembler;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc; nostackframe;
+{$define FPC_STRPASPROC}
+{$endif FPC_STRTOSHORTSTRINGPROC}
 {$include strpas.inc}
+{$undef FPC_STRPASPROC}
 {$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
 
 

rtl/powerpc/strpas.inc

@@ -13,28 +13,39 @@
 
  **********************************************************************}
 {
+ ifndef FPC_STRPASPROC
    r3: result address
-   r4: src
+   r4: p (source)
+ else
+  r3: result address
+  r4: high(result)
+  r5: p (source)
+ endif
 }
 asm
         { nil? }
-        cmplwi   r4, 0
+        mr      r8, p 
+        cmplwi  p, 0
         {  load the begin of the string in the data cache }
-        dcbt    0,r4
+        dcbt    0, p
         { maxlength }
+{$ifdef FPC_STRPASPROC}
+        mr      r10,r4
+{$else FPC_STRPASPROC}
         li      r10,255
+{$endif FPC_STRPASPROC}
         mtctr   r10
         { at LStrPasDone, we set the length of the result to 255 - r10 - r4 }
         { = 255 - 255 - 0 if the soure = nil -> perfect :)                  }
         beq     .LStrPasDone
-        { save address for at the end  and use r5 in loop }
-        mr      r5,r3
-        { no "subi r5,r5,1" because the first byte = length byte }
-        subi    r4,r4,1
+        { save address for at the end and use r7 in loop }
+        mr      r7,r3
+        { no "subi r7,r7,1" because the first byte = length byte }
+        subi    r8,r8,1
 .LStrPasLoop:
-        lbzu    r10,1(r4)
+        lbzu    r10,1(r8)
         cmplwi  cr0,r10,0
-        stbu    r10,1(r5)
+        stbu    r10,1(r7)
         bdnzf   cr0*4+eq, .LStrPasLoop
 
         { if we stopped because of a terminating #0, decrease the length by 1 }

rtl/powerpc64/powerpc64.inc

@@ -329,63 +329,6 @@ end;
                                  String
 ****************************************************************************}
 
-{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
-function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
-assembler; nostackframe;
-{ input: r3: pointer to result, r4: len, r5: sstr }
-asm
-  { load length source }
-  lbz     r10,0(r5)
-  {  load the begin of the dest buffer in the data cache }
-  dcbtst  0,r3
-
-  { put min(length(sstr),len) in r4 }
-  subfc   r7,r10,r4     { r0 := r4 - r10                               }
-  subfe   r4,r4,r4      { if r3 >= r4 then r3' := 0 else r3' := -1     }
-  and     r7,r7,r4      { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
-  add     r4,r10,r7     { if r3 >= r4 then r3' := r10 else r3' := r3   }
-
-  cmpldi  r4,0
-  { put length in ctr }
-  mtctr   r4
-  stb     r4,0(r3)
-  beq     .LShortStrCopyDone
-.LShortStrCopyLoop:
-  lbzu    r0,1(r5)
-  stbu    r0,1(r3)
-  bdnz    .LShortStrCopyLoop
-.LShortStrCopyDone:
-end;
-
-procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN'];
-assembler; nostackframe;
-{ input: r3: len, r4: sstr, r5: dstr }
-asm
-  { load length source }
-  lbz     r10,0(r4)
-  {  load the begin of the dest buffer in the data cache }
-  dcbtst  0,r5
-
-  { put min(length(sstr),len) in r3 }
-  subc    r0,r3,r10    { r0 := r3 - r10                               }
-  subfe   r3,r3,r3     { if r3 >= r4 then r3' := 0 else r3' := -1     }
-  and     r3,r0,r3     { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
-  add     r3,r3,r10    { if r3 >= r4 then r3' := r10 else r3' := r3   }
-
-  cmpldi  r3,0
-  { put length in ctr }
-  mtctr   r3
-  stb     r3,0(r5)
-  beq     .LShortStrCopyDone2
-.LShortStrCopyLoop2:
-  lbzu    r0,1(r4)
-  stbu    r0,1(r5)
-  bdnz    .LShortStrCopyLoop2
-.LShortStrCopyDone2:
-end;
-{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
-
 {$ifndef STR_CONCAT_PROCS}
 
 (*
@@ -547,9 +490,16 @@ end;
 
 {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
 {$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
 function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
 assembler; nostackframe;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar);[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
+assembler; nostackframe;
+{$define FPC_STRPASPROC}
+{$endif FPC_STRTOSHORTSTRINGPROC}
 {$include strpas.inc}
+{$undef FPC_STRPASPROC}
 {$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
 
 (*

rtl/powerpc64/strpas.inc

@@ -13,28 +13,39 @@
 
  **********************************************************************}
 {
+ ifndef FPC_STRPASPROC
    r3: result address
-   r4: src
+   r4: p (source)
+ else
+  r3: result address
+  r4: high(result)
+  r5: p (source)
+ endif
 }
 asm
         { nil? }
-        cmpldi   r4, 0
+        mr      r8, p 
+        cmpldi  p, 0
         {  load the begin of the string in the data cache }
-        dcbt    0,r4
+        dcbt    0, p
         { maxlength }
+{$ifdef FPC_STRPASPROC}
+        mr      r10,r4
+{$else FPC_STRPASPROC}
         li      r10,255
+{$endif FPC_STRPASPROC}
         mtctr   r10
         { at LStrPasDone, we set the length of the result to 255 - r10 - r4 }
         { = 255 - 255 - 0 if the soure = nil -> perfect :)                  }
         beq     .LStrPasDone
-        { save address for at the end  and use r5 in loop }
-        mr      r5,r3
-        { no "subi r5,r5,1" because the first byte = length byte }
-        subi    r4,r4,1
+        { save address for at the end and use r7 in loop }
+        mr      r7,r3
+        { no "subi r7,r7,1" because the first byte = length byte }
+        subi    r8,r8,1
 .LStrPasLoop:
-        lbzu    r10,1(r4)
-        cmpldi  cr0,r10,0
-        stbu    r10,1(r5)
+        lbzu    r10,1(r8)
+        cmplwi  cr0,r10,0
+        stbu    r10,1(r7)
         bdnzf   cr0*4+eq, .LStrPasLoop
 
         { if we stopped because of a terminating #0, decrease the length by 1 }

tests/webtbs/tw8580.pp

@@ -0,0 +1,16 @@
+program project3;
+
+{$mode objfpc}{$H+}
+
+type
+  TUTF8Char = String[7];
+
+var
+  t: widestring;
+  UTF8Char: TUTF8Char;
+
+begin
+  t := 'test';
+  UTF8Char := TUTF8Char(T);
+  writeln(UTF8Char);
+end.