+ implemented support for codepage aware compiler messages. It can be enabled

per platform (currently only enabled for win32 and win64). Enabling it forces
  code page conversion from the codepage of the .msg file to CP_ACP, before
  writing the message to the console. Not enabling it keeps the previous
  behaviour of not doing any kind of code page conversion for messages. This
  feature should be tested and enabled per platform, because it requires code
  page conversion support in the rtl (so it may require adding the appropriate
  extra units, such as fpwidestring). When this feature is enabled for all
  platforms, we can start keeping only one .msg file per language, because
  having extra .msg files for different encodings for the same language becomes
  redundant, since the compiler can do code page conversion to whatever code
  page the console uses.

git-svn-id: trunk@36450 -
This commit is contained in:
nickysn 2017-06-08 16:11:33 +00:00
parent e667a18838
commit a34f531661
5 changed files with 46 additions and 26 deletions

View File

@ -53,19 +53,19 @@ type
msgidx : array[1..maxmsgidxparts] of PArrayOfPChar; msgidx : array[1..maxmsgidxparts] of PArrayOfPChar;
msgidxmax : array[1..maxmsgidxparts] of longint; msgidxmax : array[1..maxmsgidxparts] of longint;
msgstates : array[1..maxmsgidxparts] of PArrayOfState; msgstates : array[1..maxmsgidxparts] of PArrayOfState;
msgcodepage : TSystemCodePage;
{ set if changes with $WARN need to be cleared at next module change } { set if changes with $WARN need to be cleared at next module change }
has_local_changes : boolean; has_local_changes : boolean;
constructor Init(n:longint;const idxmax:array of longint); constructor Init(n:longint;const idxmax:array of longint);
destructor Done; destructor Done;
function LoadIntern(p:pointer;n:longint):boolean; function LoadIntern(p:pointer;n:longint;cp:TSystemCodePage):boolean;
function LoadExtern(const fn:string):boolean; function LoadExtern(const fn:string):boolean;
procedure ClearIdx; procedure ClearIdx;
procedure ResetStates; procedure ResetStates;
procedure CreateIdx; procedure CreateIdx;
function GetPChar(nr:longint):pchar;
{ function ClearVerbosity(nr:longint):boolean; not used anymore } { function ClearVerbosity(nr:longint):boolean; not used anymore }
function SetVerbosity(nr:longint;newstate:tmsgstate):boolean; function SetVerbosity(nr:longint;newstate:tmsgstate):boolean;
function Get(nr:longint;const args:array of TMsgStr):ansistring; function Get(nr:longint;const args:array of TMsgStr):TMsgStr;
end; end;
{ this will read a line until #10 or #0 and also increase p } { this will read a line until #10 or #0 and also increase p }
@ -79,7 +79,7 @@ uses
cutils; cutils;
function MsgReplace(const s:TMsgStr;const args:array of TMsgStr):ansistring; function MsgReplace(const s:TMsgStr;const args:array of TMsgStr):TMsgStr;
var var
last, last,
i : longint; i : longint;
@ -117,6 +117,7 @@ begin
has_local_changes:=false; has_local_changes:=false;
msgsize:=0; msgsize:=0;
msgparts:=n; msgparts:=n;
msgcodepage:=CP_ACP;
if n<>high(idxmax)+1 then if n<>high(idxmax)+1 then
fail; fail;
for i:=1 to n do for i:=1 to n do
@ -154,8 +155,9 @@ begin
end; end;
function TMessage.LoadIntern(p:pointer;n:longint):boolean; function TMessage.LoadIntern(p:pointer;n:longint;cp:TSystemCodePage):boolean;
begin begin
msgcodepage:=cp;
msgtxt:=pchar(p); msgtxt:=pchar(p);
msgsize:=n; msgsize:=n;
msgallocsize:=0; msgallocsize:=0;
@ -185,6 +187,7 @@ var
begin begin
LoadExtern:=false; LoadExtern:=false;
msgcodepage:=CP_ACP;
getmem(buf,bufsize); getmem(buf,bufsize);
{ Read the message file } { Read the message file }
assign(f,fn); assign(f,fn);
@ -240,6 +243,10 @@ begin
end end
else else
err('no = found'); err('no = found');
end
else if (Length(s)>11) and (Copy(s,1,11)='# CodePage ') then
begin
msgcodepage:=StrToInt(Copy(s,12,Length(s)-11));
end; end;
end; end;
end; end;
@ -398,15 +405,6 @@ begin
end; end;
function TMessage.GetPChar(nr:longint):pchar;
begin
if (nr div 1000 < msgparts) and
(nr mod 1000 < msgidxmax[nr div 1000]) then
GetPChar:=msgidx[nr div 1000]^[nr mod 1000]
else
GetPChar:='';
end;
function TMessage.SetVerbosity(nr:longint;newstate:tmsgstate):boolean; function TMessage.SetVerbosity(nr:longint;newstate:tmsgstate):boolean;
var var
i: longint; i: longint;
@ -438,9 +436,10 @@ begin
end; end;
} }
function TMessage.Get(nr:longint;const args:array of TMsgStr):ansistring; function TMessage.Get(nr:longint;const args:array of TMsgStr):TMsgStr;
var var
hp : pchar; hp : pchar;
s: TMsgStr;
begin begin
if (nr div 1000 < msgparts) and if (nr div 1000 < msgparts) and
(nr mod 1000 < msgidxmax[nr div 1000]) then (nr mod 1000 < msgidxmax[nr div 1000]) then
@ -450,7 +449,14 @@ begin
if hp=nil then if hp=nil then
Get:='msg nr '+tostr(nr) Get:='msg nr '+tostr(nr)
else else
Get:=MsgReplace(system.strpas(hp),args); begin
s:=sysutils.StrPas(hp);
{$ifdef cpawaremessages}
SetCodePage(RawByteString(s),msgcodepage,False);
SetCodePage(RawByteString(s),CP_ACP,True);
{$endif cpawaremessages}
Get:=MsgReplace(s,args);
end;
end; end;
procedure TMessage.ResetStates; procedure TMessage.ResetStates;

View File

@ -284,7 +284,7 @@ begin
totaltime:=trunc(totaltime) + 1; totaltime:=trunc(totaltime) + 1;
timestr:=tostr(trunc(totaltime))+'.'+tostr(round(frac(totaltime)*10)); timestr:=tostr(trunc(totaltime))+'.'+tostr(round(frac(totaltime)*10));
if status.codesize<>aword(-1) then if status.codesize<>aword(-1) then
linkstr:=', '+tostr(status.codesize)+' ' +strpas(MessagePChar(general_text_bytes_code))+', '+tostr(status.datasize)+' '+strpas(MessagePChar(general_text_bytes_data)) linkstr:=', '+tostr(status.codesize)+' ' +MessageStr(general_text_bytes_code)+', '+tostr(status.datasize)+' '+MessageStr(general_text_bytes_data)
else else
linkstr:=''; linkstr:='';
Message3(general_i_abslines_compiled,tostr(status.compiledlines),timestr,linkstr); Message3(general_i_abslines_compiled,tostr(status.compiledlines),timestr,linkstr);

View File

@ -19,6 +19,14 @@
exceptions in the constructors } exceptions in the constructors }
{$IMPLICITEXCEPTIONS OFF} {$IMPLICITEXCEPTIONS OFF}
{ This define enables codepage-aware compiler messages handling. Turning it on
forces code page conversion from the codepage, specified in the .msg file to
CP_ACP, before printing the message to the console. Enable this for host
platforms, that have code page conversion support in their RTL. }
{$if defined(win32) or defined(win64)}
{$define cpawaremessages}
{$endif}
{ Inline small functions, but not when EXTDEBUG is used } { Inline small functions, but not when EXTDEBUG is used }
{$ifndef EXTDEBUG} {$ifndef EXTDEBUG}
{$define USEINLINE} {$define USEINLINE}

View File

@ -188,11 +188,13 @@ end;
procedure Toption.WriteLogo; procedure Toption.WriteLogo;
var var
msg : TMsgStr;
p : pchar; p : pchar;
begin begin
if not LogoWritten then if not LogoWritten then
begin begin
p:=MessagePchar(option_logo); msg:=MessageStr(option_logo);
p:=pchar(msg);
while assigned(p) do while assigned(p) do
Comment(V_Normal,GetMsgLine(p)); Comment(V_Normal,GetMsgLine(p));
LogoWritten:= true; LogoWritten:= true;
@ -202,6 +204,7 @@ end;
procedure Toption.WriteInfo (More: string); procedure Toption.WriteInfo (More: string);
var var
msg_str: TMsgStr;
p : pchar; p : pchar;
hs,hs1,hs3,s : TCmdStr; hs,hs1,hs3,s : TCmdStr;
J: longint; J: longint;
@ -548,7 +551,8 @@ const
begin begin
if More = '' then if More = '' then
begin begin
p:=MessagePchar(option_info); msg_str:=MessageStr(option_info);
p:=pchar(msg_str);
while assigned(p) do while assigned(p) do
begin begin
s:=GetMsgLine(p); s:=GetMsgLine(p);
@ -626,6 +630,7 @@ var
HelpLine, HelpLine,
s : string; s : string;
p : pchar; p : pchar;
msg_str: TMsgStr;
begin begin
WriteLogo; WriteLogo;
Lines:=4; Lines:=4;
@ -634,7 +639,8 @@ begin
else else
Message1(option_usage,FixFileName(system.paramstr(0))); Message1(option_usage,FixFileName(system.paramstr(0)));
lastident:=0; lastident:=0;
p:=MessagePChar(option_help_pages); msg_str:=MessageStr(option_help_pages);
p:=pchar(msg_str);
while assigned(p) do while assigned(p) do
begin begin
{ get a line and reset } { get a line and reset }

View File

@ -91,7 +91,7 @@ interface
procedure GenerateError; procedure GenerateError;
procedure Internalerror(i:longint);{$ifndef VER2_6}noreturn;{$endif VER2_6} procedure Internalerror(i:longint);{$ifndef VER2_6}noreturn;{$endif VER2_6}
procedure Comment(l:longint;s:ansistring); procedure Comment(l:longint;s:ansistring);
function MessagePchar(w:longint):pchar; function MessageStr(w:longint):TMsgStr;
procedure Message(w:longint;onqueue:tmsgqueueevent=nil); procedure Message(w:longint;onqueue:tmsgqueueevent=nil);
procedure Message1(w:longint;const s1:TMsgStr;onqueue:tmsgqueueevent=nil); procedure Message1(w:longint;const s1:TMsgStr;onqueue:tmsgqueueevent=nil);
procedure Message2(w:longint;const s1,s2:TMsgStr;onqueue:tmsgqueueevent=nil); procedure Message2(w:longint;const s1,s2:TMsgStr;onqueue:tmsgqueueevent=nil);
@ -404,7 +404,7 @@ implementation
{ reload the internal messages if not already loaded } { reload the internal messages if not already loaded }
{$ifndef EXTERN_MSG} {$ifndef EXTERN_MSG}
if not msg^.msgintern then if not msg^.msgintern then
msg^.LoadIntern(@msgtxt,msgtxtsize); msg^.LoadIntern(@msgtxt,msgtxtsize,msgtxt_codepage);
{$endif} {$endif}
if not msg^.LoadExtern(fn) then if not msg^.LoadExtern(fn) then
begin begin
@ -412,7 +412,7 @@ implementation
writeln('Fatal: Cannot find error message file.'); writeln('Fatal: Cannot find error message file.');
halt(3); halt(3);
{$else} {$else}
msg^.LoadIntern(@msgtxt,msgtxtsize); msg^.LoadIntern(@msgtxt,msgtxtsize,msgtxt_codepage);
{$endif} {$endif}
end; end;
{ reload the prefixes using the new messages } { reload the prefixes using the new messages }
@ -756,10 +756,10 @@ implementation
end; end;
function MessagePchar(w:longint):pchar; function MessageStr(w:longint):TMsgStr;
begin begin
MaybeLoadMessageFile; MaybeLoadMessageFile;
MessagePchar:=msg^.GetPchar(w) MessageStr:=msg^.Get(w,[]);
end; end;
@ -987,7 +987,7 @@ implementation
halt(3); halt(3);
end; end;
{$ifndef EXTERN_MSG} {$ifndef EXTERN_MSG}
msg^.LoadIntern(@msgtxt,msgtxtsize); msg^.LoadIntern(@msgtxt,msgtxtsize,msgtxt_codepage);
{$else EXTERN_MSG} {$else EXTERN_MSG}
LoadMsgFile(exepath+'errore.msg'); LoadMsgFile(exepath+'errore.msg');
{$endif EXTERN_MSG} {$endif EXTERN_MSG}