paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 10:49:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* moved core logic from fpc_shortstr_enum into a separate function, so

Browse Source 
it can be reused in fpc_write_text_enum (currently it duplicates that
    code). I seem to have lost my corresponding changes to text.inc though,
    so removing the duplicate code will be for another time.

git-svn-id: trunk@13076 -
This commit is contained in:
Jonas Maebe 2009-05-02 08:48:48 +00:00
parent d89eedf38d
commit dcb1046b98
1 changed files with 17 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
rtl/inc/sstrings.inc
View File

@ -407,7 +407,7 @@ begin
end; end;
{$endif} {$endif}
procedure fpc_shortstr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring);[public,alias:'FPC_SHORTSTR_ENUM'];compilerproc; function fpc_shortstr_enum_intern(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring): longint;
type type
Ptypeinfo=^Ttypeinfo; Ptypeinfo=^Ttypeinfo;
@ -435,23 +435,21 @@ var
sorted_array:^Tsorted_array; sorted_array:^Tsorted_array;
i,spaces:byte; i,spaces:byte;
label
error;
begin begin
fpc_shortstr_enum_intern:=107;
if Pcardinal(ord2strindex)^=0 then if Pcardinal(ord2strindex)^=0 then
begin begin
{The compiler did generate a lookup table.} {The compiler did generate a lookup table.}
with Penuminfo(Pbyte(typinfo)+2+length(Ptypeinfo(typinfo)^.name))^ do with Penuminfo(Pbyte(typinfo)+2+length(Ptypeinfo(typinfo)^.name))^ do
begin begin
if (ordinal<minvalue) or (ordinal>maxvalue) then if (ordinal<minvalue) or (ordinal>maxvalue) then
goto error; {Invalid ordinal value for this enum.} exit; {Invalid ordinal value for this enum.}
dec(ordinal,minvalue); dec(ordinal,minvalue);
end; end;
{Get the address of the string.} {Get the address of the string.}
p:=Pshortstring((PPpointer(ord2strindex)+1+ordinal)^); p:=Pshortstring((PPpointer(ord2strindex)+1+ordinal)^);
if p=nil then if p=nil then
goto error; {Invalid ordinal value for this enum.} exit; {Invalid ordinal value for this enum.}
s:=p^; s:=p^;
end end
else else
@ -470,7 +468,7 @@ begin
else else
break; break;
if l>h then if l>h then
goto error; {Ordinal value not found? Kaboom.} exit; {Ordinal value not found? Kaboom.}
until false; until false;
s:=sorted_array[m].s^; s:=sorted_array[m].s^;
end; end;
@ -482,15 +480,23 @@ begin
s[length(s)+i]:=' '; s[length(s)+i]:=' ';
inc(byte(s[0]),spaces); inc(byte(s[0]),spaces);
end; end;
exit; fpc_shortstr_enum_intern:=0;
error: end;
{Call runtime error in a central place, this saves space.}
runerror(107);
procedure fpc_shortstr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring);[public,alias:'FPC_SHORTSTR_ENUM'];compilerproc;
var
res: longint;
begin
res:=fpc_shortstr_enum_intern(ordinal,len,typinfo,ord2strindex,s);
if (res<>0) then
runerror(107);
end; end;
{ also define alias for internal use in the system unit } { also define alias for internal use in the system unit }
procedure fpc_shortstr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring);external name 'FPC_SHORTSTR_ENUM'; procedure fpc_shortstr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring);external name 'FPC_SHORTSTR_ENUM';
procedure fpc_shortstr_currency(c : currency; len,f : SizeInt; out s : shortstring);[public,alias:'FPC_SHORTSTR_CURRENCY']; compilerproc; procedure fpc_shortstr_currency(c : currency; len,f : SizeInt; out s : shortstring);[public,alias:'FPC_SHORTSTR_CURRENCY']; compilerproc;
const const
MinLen = 8; { Minimal string length in scientific format } MinLen = 8; { Minimal string length in scientific format }