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

git-svn-id: trunk@8898 -

.gitattributes

@@ -8412,6 +8412,7 @@ tests/webtbs/tw8513.pp svneol=native#text/plain
 tests/webtbs/tw8523.pp svneol=native#text/plain
 tests/webtbs/tw8525.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

@@ -891,7 +891,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,constexp,
+      globtype,systems,constexp,
       cutils,verbose,globals,widestr,
       symconst,symdef,symsym,symbase,symtable,
       ncon,ncal,nset,nadd,ninl,nmem,nmat,nbas,nutils,
@@ -822,17 +822,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;
 
 
@@ -900,11 +918,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
@@ -924,18 +942,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;
 
@@ -1280,11 +1300,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;
 
 
@@ -1310,11 +1346,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

@@ -691,9 +691,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_REAL2REAL_FIXED');
   def_system_macro('FPC_STRTOCHARARRAYPROC');
   def_system_macro('FPC_NEW_BIGENDIAN_SETS');
+  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}
@@ -184,7 +198,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;
 
@@ -213,7 +231,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;
@@ -239,7 +261,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;
@@ -253,7 +279,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}
@@ -263,7 +293,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

@@ -791,6 +791,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;
@@ -802,6 +803,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
@@ -990,6 +1003,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;
@@ -1007,11 +1021,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;
@@ -1036,6 +1093,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/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

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.