paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 01:59:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* new message files layout with msg numbers (but still no code to

Browse Source 
show the number on the screen)
This commit is contained in:
peter 2000-06-30 20:23:33 +00:00
parent b6d995d7d5
commit 957d4cdc89
16 changed files with 7746 additions and 6629 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/compiler.pas
View File

@ -242,7 +242,7 @@ function Compile(const cmd:string):longint;
{$maxfpuregisters 0} {$maxfpuregisters 0}
{$endif fpc} {$endif fpc}
procedure writepathlist(w:tmsgconst;l:TSearchPathList); procedure writepathlist(w:longint;l:TSearchPathList);
var var
hp : pstringqueueitem; hp : pstringqueueitem;
begin begin
@ -355,7 +355,11 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.50 2000-05-29 10:04:40 pierre Revision 1.51 2000-06-30 20:23:33 peter
* new message files layout with msg numbers (but still no code to
show the number on the screen)
Revision 1.50 2000/05/29 10:04:40 pierre
* New bunch of Gabor changes * New bunch of Gabor changes
Revision 1.49 2000/05/03 16:31:22 pierre Revision 1.49 2000/05/03 16:31:22 pierre

1433
compiler/errord.msg
View File

File diff suppressed because it is too large Load Diff

1409
compiler/errore.msg
View File

File diff suppressed because it is too large Load Diff

1586
compiler/errores.msg
View File

File diff suppressed because it is too large Load Diff

1447
compiler/errorf.msg
View File

File diff suppressed because it is too large Load Diff

2814
compiler/errorn.msg
View File

File diff suppressed because it is too large Load Diff

2174
compiler/errorr.msg
View File

File diff suppressed because it is too large Load Diff

38
compiler/hcodegen.pas
View File

@ -141,14 +141,14 @@ implementation
make_const_global : boolean; make_const_global : boolean;
{ message calls with codegenerror support } { message calls with codegenerror support }
procedure cgmessage(t : tmsgconst); procedure cgmessage(t : longint);
procedure cgmessage1(t : tmsgconst;const s : string); procedure cgmessage1(t : longint;const s : string);
procedure cgmessage2(t : tmsgconst;const s1,s2 : string); procedure cgmessage2(t : longint;const s1,s2 : string);
procedure cgmessage3(t : tmsgconst;const s1,s2,s3 : string); procedure cgmessage3(t : longint;const s1,s2,s3 : string);
procedure CGMessagePos(const pos:tfileposinfo;t:tmsgconst); procedure CGMessagePos(const pos:tfileposinfo;t:longint);
procedure CGMessagePos1(const pos:tfileposinfo;t:tmsgconst;const s1:string); procedure CGMessagePos1(const pos:tfileposinfo;t:longint;const s1:string);
procedure CGMessagePos2(const pos:tfileposinfo;t:tmsgconst;const s1,s2:string); procedure CGMessagePos2(const pos:tfileposinfo;t:longint;const s1,s2:string);
procedure CGMessagePos3(const pos:tfileposinfo;t:tmsgconst;const s1,s2,s3:string); procedure CGMessagePos3(const pos:tfileposinfo;t:longint;const s1,s2,s3:string);
{ initialize respectively terminates the code generator } { initialize respectively terminates the code generator }
{ for a new module or procedure } { for a new module or procedure }
@ -176,7 +176,7 @@ implementation
override the message calls to set codegenerror override the message calls to set codegenerror
*****************************************************************************} *****************************************************************************}
procedure cgmessage(t : tmsgconst); procedure cgmessage(t : longint);
var var
olderrorcount : longint; olderrorcount : longint;
begin begin
@ -188,7 +188,7 @@ implementation
end; end;
end; end;
procedure cgmessage1(t : tmsgconst;const s : string); procedure cgmessage1(t : longint;const s : string);
var var
olderrorcount : longint; olderrorcount : longint;
begin begin
@ -200,7 +200,7 @@ implementation
end; end;
end; end;
procedure cgmessage2(t : tmsgconst;const s1,s2 : string); procedure cgmessage2(t : longint;const s1,s2 : string);
var var
olderrorcount : longint; olderrorcount : longint;
begin begin
@ -212,7 +212,7 @@ implementation
end; end;
end; end;
procedure cgmessage3(t : tmsgconst;const s1,s2,s3 : string); procedure cgmessage3(t : longint;const s1,s2,s3 : string);
var var
olderrorcount : longint; olderrorcount : longint;
begin begin
@ -225,7 +225,7 @@ implementation
end; end;
procedure cgmessagepos(const pos:tfileposinfo;t : tmsgconst); procedure cgmessagepos(const pos:tfileposinfo;t : longint);
var var
olderrorcount : longint; olderrorcount : longint;
begin begin
@ -237,7 +237,7 @@ implementation
end; end;
end; end;
procedure cgmessagepos1(const pos:tfileposinfo;t : tmsgconst;const s1 : string); procedure cgmessagepos1(const pos:tfileposinfo;t : longint;const s1 : string);
var var
olderrorcount : longint; olderrorcount : longint;
begin begin
@ -249,7 +249,7 @@ implementation
end; end;
end; end;
procedure cgmessagepos2(const pos:tfileposinfo;t : tmsgconst;const s1,s2 : string); procedure cgmessagepos2(const pos:tfileposinfo;t : longint;const s1,s2 : string);
var var
olderrorcount : longint; olderrorcount : longint;
begin begin
@ -261,7 +261,7 @@ implementation
end; end;
end; end;
procedure cgmessagepos3(const pos:tfileposinfo;t : tmsgconst;const s1,s2,s3 : string); procedure cgmessagepos3(const pos:tfileposinfo;t : longint;const s1,s2,s3 : string);
var var
olderrorcount : longint; olderrorcount : longint;
begin begin
@ -450,7 +450,11 @@ end.
{ {
$Log$ $Log$
Revision 1.59 2000-06-01 19:09:57 peter Revision 1.60 2000-06-30 20:23:36 peter
* new message files layout with msg numbers (but still no code to
show the number on the screen)
Revision 1.59 2000/06/01 19:09:57 peter
* made resourcestrings OOP so it's easier to handle it per module * made resourcestrings OOP so it's easier to handle it per module
Revision 1.58 2000/04/02 18:30:12 florian Revision 1.58 2000/04/02 18:30:12 florian

307
compiler/messages.pas
View File

@ -23,51 +23,97 @@
unit Messages; unit Messages;
interface interface
const
maxmsgidxparts = 20;
type type
ppchar=^pchar; ppchar=^pchar;
TArrayOfPChar = array[0..1000] of pchar;
PArrayOfPChar = ^TArrayOfPChar;
PMessage=^TMessage; PMessage=^TMessage;
TMessage=object TMessage=object
msgfilename : string; msgfilename : string;
msgallocsize, msgallocsize,
msgsize, msgsize,
msgcrc, msgparts,
msgs : longint; msgs : longint;
msgtxt : pchar; msgtxt : pchar;
msgidx : ppchar; msgidx : array[1..maxmsgidxparts] of PArrayOfPChar;
constructor Init(p:pointer;n:longint); msgidxmax : array[1..maxmsgidxparts] of longint;
constructor InitExtern(const fn:string;n:longint); constructor Init(n:longint;const idxmax:array of longint);
destructor Done; destructor Done;
function LoadIntern(p:pointer;n:longint):boolean;
function LoadExtern(const fn:string):boolean;
procedure CreateIdx; procedure CreateIdx;
function GetPChar(nr:longint):pchar;
function Get(nr:longint):string; function Get(nr:longint):string;
function Get3(nr:longint;const s1,s2,s3:string):string; function Get3(nr:longint;const s1,s2,s3:string):string;
function Get2(nr:longint;const s1,s2:string):string; function Get2(nr:longint;const s1,s2:string):string;
function Get1(nr:longint;const s1:string):string; function Get1(nr:longint;const s1:string):string;
end; end;
{ this will read a line until #10 or #0 and also increase p }
function GetMsgLine(var p:pchar):string;
implementation implementation
uses uses
globals,crc, globals,crc,
verbose,
{$ifdef DELPHI} {$ifdef DELPHI}
sysutils; sysutils;
{$else DELPHI} {$else DELPHI}
strings; strings;
{$endif DELPHI} {$endif DELPHI}
constructor TMessage.Init(p:pointer;n:longint); constructor TMessage.Init(n:longint;const idxmax:array of longint);
var
i : longint;
begin begin
msgtxt:=pchar(p); msgtxt:=nil;
msgallocsize:=0;
msgsize:=0; msgsize:=0;
msgcrc:=MsgCrcValue; msgparts:=n;
msgs:=n; if n<>high(idxmax)+1 then
CreateIdx; fail;
for i:=1to n do
begin
msgidxmax[i]:=idxmax[i-1];
getmem(msgidx[i],msgidxmax[i]*4);
fillchar(msgidx[i]^,msgidxmax[i]*4,0);
end;
end; end;
constructor TMessage.InitExtern(const fn:string;n:longint); destructor TMessage.Done;
var
i : longint;
begin
for i:=1to msgparts do
freemem(msgidx[i],msgidxmax[i]*4);
if msgallocsize>0 then
begin
freemem(msgtxt,msgsize);
msgallocsize:=0;
end;
msgtxt:=nil;
msgsize:=0;
msgparts:=0;
end;
function TMessage.LoadIntern(p:pointer;n:longint):boolean;
begin
msgtxt:=pchar(p);
msgsize:=n;
msgallocsize:=0;
CreateIdx;
LoadIntern:=true;
end;
function TMessage.LoadExtern(const fn:string):boolean;
{$ifndef FPC} {$ifndef FPC}
procedure readln(var t:text;var s:string); procedure readln(var t:text;var s:string);
@ -96,61 +142,99 @@ const
bufsize=8192; bufsize=8192;
var var
f : text; f : text;
{$ifdef DEBUGCRC} error,multiline : boolean;
f2 : text; code : word;
{$endif DEBUGCRC} numpart,numidx,
msgsread, line,i,j,num : longint;
line,i,crc : longint;
ptxt : pchar; ptxt : pchar;
number,
s,s1 : string; s,s1 : string;
buf : pointer; buf : pointer;
procedure err(const msgstr:string);
begin begin
crc:=longint($ffffffff); writeln('error in line ',line,': ',msgstr);
error:=true;
end;
begin
LoadExtern:=false;
getmem(buf,bufsize); getmem(buf,bufsize);
{Read the message file} {Read the message file}
assign(f,fn); assign(f,fn);
{$ifdef DEBUGCRC}
assign(f2,'crcmsg.tst');
rewrite(f2);
Writeln(f2,crc);
{$endif DEBUGCRC}
{$I-} {$I-}
reset(f); reset(f);
{$I+} {$I+}
if ioresult<>0 then if ioresult<>0 then
begin begin
WriteLn('*** message file '+fn+' not found ***'); WriteLn('*** message file '+fn+' not found ***');
fail; exit;
end; end;
settextbuf(f,buf^,bufsize); settextbuf(f,buf^,bufsize);
{ First parse the file and count bytes needed } { First parse the file and count bytes needed }
error:=false;
line:=0; line:=0;
msgs:=n; multiline:=false;
msgsize:=0; msgsize:=0;
msgsread:=0;
while not eof(f) do while not eof(f) do
begin begin
readln(f,s); readln(f,s);
inc(line); inc(line);
if multiline then
begin
if s=']' then
multiline:=false
else
inc(msgsize,length(s)+1); { +1 for linebreak }
end
else
begin
if (s<>'') and not(s[1] in ['#',';','%']) then if (s<>'') and not(s[1] in ['#',';','%']) then
begin begin
i:=pos('=',s); i:=pos('=',s);
if i>0 then if i>0 then
begin begin
inc(msgsize,length(s)-i+1); j:=i+1;
inc(msgsread); if not(s[j] in ['0'..'9']) then
err('no number found')
else
begin
while (s[j] in ['0'..'9']) do
inc(j);
end;
if j-i-1<>5 then
err('number length is not 5');
number:=Copy(s,i+1,j-i-1);
{ update the max index }
val(number,num,code);
numpart:=num div 1000;
numidx:=num mod 1000;
{ check range }
if numpart > msgparts then
err('number is to large')
else
if numidx >= msgidxmax[numpart] then
err('index is to large');
if s[j+1]='[' then
begin
inc(msgsize,j-i);
multiline:=true
end end
else else
writeln('error in line: ',line,' skipping'); inc(msgsize,length(s)-i+1);
end
else
err('no = found');
end; end;
end; end;
{ check amount of messages } end;
if msgsread<>msgs then if multiline then
err('still in multiline mode');
if error then
begin begin
WriteLn('*** message file '+fn+' is corrupt: read ',msgsread,' of ',msgs,' msgs ***');
close(f);
freemem(buf,bufsize); freemem(buf,bufsize);
fail; close(f);
exit;
end; end;
{ now read the buffer in mem } { now read the buffer in mem }
msgallocsize:=msgsize; msgallocsize:=msgsize;
@ -160,96 +244,135 @@ begin
while not eof(f) do while not eof(f) do
begin begin
readln(f,s); readln(f,s);
if multiline then
begin
if s=']' then
begin
multiline:=false;
{ overwrite last eol }
dec(ptxt);
ptxt^:=#0;
inc(ptxt);
end
else
begin
move(s[1],ptxt^,length(s));
inc(ptxt,length(s));
ptxt^:=#10;
inc(ptxt);
end;
end
else
begin
if (s<>'') and not(s[1] in ['#',';','%']) then if (s<>'') and not(s[1] in ['#',';','%']) then
begin begin
i:=pos('=',s); i:=pos('=',s);
if i>0 then if i>0 then
begin begin
{txt} j:=i+1;
s1:=Copy(s,i+1,255); while (s[j] in ['0'..'9']) do
{ support <lf> for empty lines } inc(j);
if s1='<lf>' then { multiline start then no txt }
if s[j+1]='[' then
begin begin
s1:=''; s1:=Copy(s,i+1,j-i);
{ update the msgsize also! } move(s1[1],ptxt^,length(s1));
dec(msgsize,4); inc(ptxt,length(s1));
end; multiline:=true;
{txt} end
else
begin
{ txt including number }
s1:=Copy(s,i+1,255);
move(s1[1],ptxt^,length(s1)); move(s1[1],ptxt^,length(s1));
inc(ptxt,length(s1)); inc(ptxt,length(s1));
ptxt^:=#0; ptxt^:=#0;
inc(ptxt); inc(ptxt);
s1:=upper(copy(s,1,i-1)); end;
crc:=UpdateCRC32(crc,s1[1],length(s1)); end;
{$ifdef DEBUGCRC}
Writeln(f2,s1);
Writeln(f2,crc);
{$endif DEBUGCRC}
end; end;
end; end;
end; end;
close(f); close(f);
{$ifdef DEBUGCRC}
close(f2);
{$endif DEBUGCRC}
freemem(buf,bufsize); freemem(buf,bufsize);
{ check amount of messages }
if (MsgCrcValue<>0) and (crc<>MsgCrcValue) then
begin
WriteLn('*** message file '+fn+' is incompatible : wrong CRC value ***');
fail;
end;
{ now we can create the index } { now we can create the index }
CreateIdx; CreateIdx;
end; LoadExtern:=true;
destructor TMessage.Done;
begin
if assigned(msgidx) then
begin
freemem(msgidx,msgs shl 2);
msgidx:=nil;
end;
if msgallocsize>0 then
begin
freemem(msgtxt,msgallocsize);
msgtxt:=nil;
msgallocsize:=0;
end;
end; end;
procedure TMessage.CreateIdx; procedure TMessage.CreateIdx;
var var
hp : pchar; hp1,
hpl : ppchar; hp,hpend : pchar;
n : longint; code : word;
num : longint;
number : string[5];
i : longint;
numpart,numidx : longint;
begin begin
getmem(msgidx,msgs shl 2); { clear }
hpl:=msgidx; for i:=1to msgparts do
fillchar(msgidx[i]^,msgidxmax[i]*4,0);
{ process msgtxt buffer }
number:='00000';
hp:=msgtxt; hp:=msgtxt;
n:=0; hpend:=@msgtxt[msgsize];
while (n<msgs) do while (hp<hpend) do
begin begin
hpl^:=hp; hp1:=hp;
hpl:=pointer(longint(hpl)+4); for i:=1to 5 do
inc(n); begin
number[i]:=hp1^;
inc(hp1);
end;
val(number,num,code);
numpart:=num div 1000;
numidx:=num mod 1000;
{ skip _ }
inc(hp1);
{ put the address in the idx, the numbers are already checked }
msgidx[numpart]^[numidx]:=hp1;
{ next string }
hp:=pchar(@hp[strlen(hp)+1]); hp:=pchar(@hp[strlen(hp)+1]);
end; end;
end; end;
function GetMsgLine(var p:pchar):string;
var
i : longint;
begin
i:=0;
while not(p^ in [#0,#10]) and (i<255) do
begin
inc(i);
GetMsgLine[i]:=p^;
inc(p);
end;
{ skip #10 }
if p^=#10 then
inc(p);
{ if #0 then set p to nil }
if p^=#0 then
p:=nil;
{ return string }
GetMsgLine[0]:=chr(i);
end;
function TMessage.GetPChar(nr:longint):pchar;
begin
GetPChar:=msgidx[nr div 1000]^[nr mod 1000];
end;
function TMessage.Get(nr:longint):string; function TMessage.Get(nr:longint):string;
var var
s : string[16]; s : string[16];
hp : pchar; hp : pchar;
begin begin
if msgidx=nil then hp:=msgidx[nr div 1000]^[nr mod 1000];
hp:=nil
else
hp:=pchar(pointer(longint(msgidx)+nr shl 2)^);
if hp=nil then if hp=nil then
begin begin
Str(nr,s); Str(nr,s);
@ -306,7 +429,11 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.15 2000-06-18 18:14:21 peter Revision 1.16 2000-06-30 20:23:36 peter
* new message files layout with msg numbers (but still no code to
show the number on the screen)
Revision 1.15 2000/06/18 18:14:21 peter
* only replace the $1,$2,$3 once, so it doesn't loop when the * only replace the $1,$2,$3 once, so it doesn't loop when the
value to replace with contains $1,$2 or $3 value to replace with contains $1,$2 or $3

1246
compiler/msgidx.inc
View File

File diff suppressed because it is too large Load Diff

1449
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

27
compiler/options.pas
View File

@ -176,21 +176,23 @@ end;
procedure Toption.WriteLogo; procedure Toption.WriteLogo;
var var
i : tmsgconst; p : pchar;
begin begin
MaybeLoadMessageFile; MaybeLoadMessageFile;
for i:=option_logo_start to option_logo_end do p:=MessagePchar(option_logo);
Message1(i,target_cpu_string); while assigned(p) do
Comment(V_Normal,GetMsgLine(p));
end; end;
procedure Toption.WriteInfo; procedure Toption.WriteInfo;
var var
i : tmsgconst; p : pchar;
begin begin
MaybeLoadMessageFile; MaybeLoadMessageFile;
for i:=option_info_start to option_info_end do p:=MessagePchar(option_info);
Message(i); while assigned(p) do
Comment(V_Normal,GetMsgLine(p));
StopOptions; StopOptions;
end; end;
@ -205,7 +207,6 @@ procedure Toption.WriteHelpPages;
end; end;
var var
idx,
lastident, lastident,
j,outline, j,outline,
ident, ident,
@ -214,6 +215,7 @@ var
opt : string[32]; opt : string[32];
input, input,
s : string; s : string;
p : pchar;
begin begin
MaybeLoadMessageFile; MaybeLoadMessageFile;
Message1(option_usage,paramstr(0)); Message1(option_usage,paramstr(0));
@ -222,10 +224,11 @@ begin
lines:=3 lines:=3
else else
lines:=1; lines:=1;
for idx:=ord(ol_begin) to ord(ol_end) do p:=MessagePChar(option_help_pages);
while assigned(p) do
begin begin
{ get a line and reset } { get a line and reset }
s:=msg^.Get(idx); s:=GetMsgLine(p);
ident:=0; ident:=0;
show:=false; show:=false;
{ parse options } { parse options }
@ -1485,7 +1488,11 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.70 2000-06-19 19:57:19 pierre Revision 1.71 2000-06-30 20:23:38 peter
* new message files layout with msg numbers (but still no code to
show the number on the screen)
Revision 1.70 2000/06/19 19:57:19 pierre
* smart link is default on win32 * smart link is default on win32
Revision 1.69 2000/05/23 21:28:22 pierre Revision 1.69 2000/05/23 21:28:22 pierre

8
compiler/scandir.inc
View File

@ -531,7 +531,7 @@ const
procedure dir_message(t:tdirectivetoken); procedure dir_message(t:tdirectivetoken);
var var
w : tmsgconst; w : longint;
begin begin
case t of case t of
_DIR_STOP, _DIR_STOP,
@ -1419,7 +1419,11 @@ const
{ {
$Log$ $Log$
Revision 1.82 2000-06-25 19:08:27 hajny Revision 1.83 2000-06-30 20:23:38 peter
* new message files layout with msg numbers (but still no code to
show the number on the screen)
Revision 1.82 2000/06/25 19:08:27 hajny
+ $R support for OS/2 (EMX) added + $R support for OS/2 (EMX) added
Revision 1.81 2000/05/23 20:18:25 pierre Revision 1.81 2000/05/23 20:18:25 pierre

10
compiler/scanner.pas
View File

@ -108,7 +108,7 @@ unit scanner;
procedure end_of_file; procedure end_of_file;
procedure checkpreprocstack; procedure checkpreprocstack;
procedure poppreprocstack; procedure poppreprocstack;
procedure addpreprocstack(atyp : preproctyp;a:boolean;const s:string;w:tmsgconst); procedure addpreprocstack(atyp : preproctyp;a:boolean;const s:string;w:longint);
procedure elsepreprocstack; procedure elsepreprocstack;
procedure linebreak; procedure linebreak;
procedure readchar; procedure readchar;
@ -634,7 +634,7 @@ implementation
end; end;
procedure tscannerfile.addpreprocstack(atyp : preproctyp;a:boolean;const s:string;w:tmsgconst); procedure tscannerfile.addpreprocstack(atyp : preproctyp;a:boolean;const s:string;w:longint);
begin begin
preprocstack:=new(ppreprocstack,init(atyp,((preprocstack=nil) or preprocstack^.accept) and a,preprocstack)); preprocstack:=new(ppreprocstack,init(atyp,((preprocstack=nil) or preprocstack^.accept) and a,preprocstack));
preprocstack^.name:=s; preprocstack^.name:=s;
@ -1835,7 +1835,11 @@ exit_label:
end. end.
{ {
$Log$ $Log$
Revision 1.113 2000-06-18 18:05:54 peter Revision 1.114 2000-06-30 20:23:38 peter
* new message files layout with msg numbers (but still no code to
show the number on the screen)
Revision 1.113 2000/06/18 18:05:54 peter
* no binary value reading with % if not fpc mode * no binary value reading with % if not fpc mode
* extended illegal char message with the char itself (Delphi like) * extended illegal char message with the char itself (Delphi like)

275
compiler/utils/msg2inc.pp
View File

@ -16,16 +16,17 @@
**********************************************************************} **********************************************************************}
program msg2inc; program msg2inc;
uses uses
crc,
strings; strings;
const const
version='0.99.14'; version='0.99.15';
{$ifdef linux} {$ifdef linux}
eollen=1; eollen=1;
{$else} {$else}
eollen=2; eollen=2;
{$endif} {$endif}
msgparts = 20;
type type
TMode=(M_Char,M_Tex,M_Intel,M_String,M_Renumber); TMode=(M_Char,M_Tex,M_Intel,M_String,M_Renumber);
var var
@ -40,87 +41,27 @@ var
enumsize, enumsize,
msgsize : longint; msgsize : longint;
function XlatString(Var S : String):boolean; msgidxmax : array[1..msgparts] of longint;
{
replaces \xxx in string S with #x, and \\ with \ (escaped)
which can reduce size of string.
Returns false when an error in the line exists
}
Function GetNumber(Position:longint):longint;
var
C,Value,i : longint;
begin
I:=0;
Value:=0;
while i<3 do
begin
C:=ord(S[Position+I]);
if (C>47) and (C<56) then
dec(C,48)
else
begin
GetNumber:=-1;
exit;
end;
if I=0 then
C:=C shl 6;
if I=1 then
C:=C SHL 3;
inc(Value,C);
inc(I);
end;
GetNumber:=Value;
end;
var
S2 : String;
A,B,Value : longint;
begin
A:=1;
B:=1;
while A<=Length(S) do
begin
if (S[A]='\') and (a<length(s)) then
begin
if S[A+1]='\' then
begin
S2[B]:='\';
Inc(A,2);
Inc(B);
end
else
begin
Value:=GetNumber(A+1);
if Value=-1 then
begin
XlatString:=false;
exit;
end;
S2[B]:=Chr(Value);
inc(B);
inc(A,4);
end;
end
else
begin
S2[B]:=S[A];
inc(A);
inc(B);
end;
end;
S2[0]:=Chr(B-1);
S:=S2;
XlatString:=true;
end;
procedure LoadMsgFile(const fn:string); procedure LoadMsgFile(const fn:string);
var var
f : text; f : text;
line,i : longint; error,
multiline : boolean;
code : word;
numpart,numidx,
line,i,j,num : longint;
ptxt, ptxt,
penum : pchar; penum : pchar;
number,
s,s1 : string; s,s1 : string;
procedure err(const msgstr:string);
begin
writeln('error in line ',line,': ',msgstr);
error:=true;
end;
begin begin
Writeln('Loading messagefile ',fn); Writeln('Loading messagefile ',fn);
{Read the message file} {Read the message file}
@ -130,65 +71,142 @@ begin
{$I+} {$I+}
if ioresult<>0 then if ioresult<>0 then
begin begin
WriteLn('*** message file '+fn+' not found ***'); WriteLn('fatal error: '+fn+' not found');
exit; halt(1);
end; end;
{ First parse the file and count bytes needed } { First parse the file and count bytes needed }
fillchar(msgidxmax,sizeof(msgidxmax),0);
error:=false;
line:=0; line:=0;
multiline:=false;
msgsize:=0; msgsize:=0;
while not eof(f) do while not eof(f) do
begin begin
readln(f,s); readln(f,s);
inc(line); inc(line);
if not XlatString(S) then if multiline then
S:=''; begin
if s=']' then
multiline:=false
else
inc(msgsize,length(s)+1); { +1 for linebreak }
end
else
begin
if (s<>'') and not(s[1] in ['#',';','%']) then if (s<>'') and not(s[1] in ['#',';','%']) then
begin begin
i:=pos('=',s); i:=pos('=',s);
if i>0 then if i>0 then
begin begin
inc(msgsize,length(s)-i+1); j:=i+1;
inc(enumsize,i); if not(s[j] in ['0'..'9']) then
err('no number found')
else
begin
while (s[j] in ['0'..'9']) do
inc(j);
end;
if j-i-1<>5 then
err('number length is not 5');
number:=Copy(s,i+1,j-i-1);
{ update the max index }
val(number,num,code);
numpart:=num div 1000;
numidx:=num mod 1000;
{ check range }
if numpart > msgparts then
err('number is to large')
else
if numidx > msgidxmax[numpart] then
msgidxmax[numpart]:=numidx;
if s[j+1]='[' then
begin
inc(msgsize,j-i);
multiline:=true
end end
else else
writeln('error in line: ',line,' skipping'); inc(msgsize,length(s)-i+1);
inc(enumsize,j);
end
else
err('no = found');
end; end;
end; end;
{ now read the buffer in mem } end;
if multiline then
err('still in multiline mode');
if error then
begin
close(f);
writeln('aborting');
halt(1);
end;
{ alloc memory }
getmem(msgtxt,msgsize); getmem(msgtxt,msgsize);
ptxt:=msgtxt; ptxt:=msgtxt;
getmem(enumtxt,enumsize); getmem(enumtxt,enumsize);
penum:=enumtxt; penum:=enumtxt;
{ now read the buffer in mem }
reset(f); reset(f);
while not eof(f) do while not eof(f) do
begin begin
readln(f,s); readln(f,s);
inc(line); if multiline then
if not XlatString(S) then begin
S[0]:=#0; if s=']' then
begin
multiline:=false;
{ overwrite last eol }
dec(ptxt);
ptxt^:=#0;
inc(ptxt);
end
else
begin
move(s[1],ptxt^,length(s));
inc(ptxt,length(s));
ptxt^:=#10;
inc(ptxt);
end;
end
else
begin
if (s<>'') and not(s[1] in ['#',';','%']) then if (s<>'') and not(s[1] in ['#',';','%']) then
begin begin
i:=pos('=',s); i:=pos('=',s);
if i>0 then if i>0 then
begin begin
{txt} j:=i+1;
s1:=Copy(s,i+1,255); while (s[j] in ['0'..'9']) do
{ support <lf> for empty lines } inc(j);
if s1='<lf>' then {enum}
move(s[1],penum^,i-1);
inc(penum,i-1);
penum^:='=';
inc(penum);
number:=Copy(s,i+1,j-i-1);
move(number[1],penum^,length(number));
inc(penum,length(number));
penum^:=#0;
inc(penum);
{ multiline start then no txt }
if s[j+1]='[' then
begin begin
s1:=''; s1:=Copy(s,i+1,j-i);
{ update the msgsize also! } move(s1[1],ptxt^,length(s1));
dec(msgsize,4); inc(ptxt,length(s1));
end; multiline:=true;
end
else
begin
{ txt including number }
s1:=Copy(s,i+1,255);
move(s1[1],ptxt^,length(s1)); move(s1[1],ptxt^,length(s1));
inc(ptxt,length(s1)); inc(ptxt,length(s1));
ptxt^:=#0; ptxt^:=#0;
inc(ptxt); inc(ptxt);
{enum} end;
move(s[1],penum^,i-1); end;
inc(penum,i-1);
penum^:=#0;
inc(penum);
end; end;
end; end;
end; end;
@ -203,25 +221,15 @@ end;
procedure WriteEnumFile(const fn,typename:string); procedure WriteEnumFile(const fn,typename:string);
var var
t : text; t : text;
{$ifdef DEBUGCRC} i : longint;
t2 : text;
{$endif DEBUGCRC}
i,crcvalue : longint;
p : pchar; p : pchar;
s : string;
start : boolean; start : boolean;
begin begin
crcvalue:=longint($ffffffff);
writeln('Writing enumfile '+fn); writeln('Writing enumfile '+fn);
{Open textfile} {Open textfile}
assign(t,fn); assign(t,fn);
rewrite(t); rewrite(t);
{$ifdef DEBUGCRC} writeln(t,'const');
assign(t2,'crc.tst');
rewrite(t2);
Writeln(t2,crcvalue);
{$endif DEBUGCRC}
writeln(t,'type t',typename,'=(');
{Parse buffer in msgbuf and create indexs} {Parse buffer in msgbuf and create indexs}
p:=enumtxt; p:=enumtxt;
start:=true; start:=true;
@ -230,17 +238,11 @@ begin
if start then if start then
begin begin
write(t,' '); write(t,' ');
s:=UpCase(strpas(p));
crcvalue:=UpdateCRC32(crcvalue,s[1],length(s));
{$ifdef DEBUGCRC}
Writeln(t2,s);
Writeln(t2,crcvalue);
{$endif DEBUGCRC}
start:=false; start:=false;
end; end;
if p^=#0 then if p^=#0 then
begin begin
writeln(t,','); writeln(t,';');
start:=true; start:=true;
end end
else else
@ -249,14 +251,27 @@ begin
end; end;
inc(p); inc(p);
end; end;
writeln(t,'end',typename); writeln(t,'');
{ msgtxt size }
writeln(t,' MsgTxtSize = ',msgsize,';');
writeln(t,'');
{ max msg idx table }
writeln(t,' MsgIdxMax : array[1..20] of longint=(');
write(t,' ');
for i:=1to 20 do
begin
write(t,msgidxmax[i]+1);
if i<20 then
write(t,',');
if i=10 then
begin
writeln(t,'');
write(t,' ');
end;
end;
writeln(t,'');
writeln(t,' );'); writeln(t,' );');
writeln(t,'const');
writeln(t,' MsgCRCValue : longint = ',crcvalue,';');
close(t); close(t);
{$ifdef DEBUGCRC}
close(t2);
{$endif DEBUGCRC}
end; end;
@ -354,7 +369,7 @@ begin
write(t,'#'+chr(ord(p^) div 100+48)+chr((ord(p^) mod 100) div 10+48)+chr(ord(p^) mod 10+48)); write(t,'#'+chr(ord(p^) div 100+48)+chr((ord(p^) mod 100) div 10+48)+chr(ord(p^) mod 10+48));
inc(len,3); inc(len,3);
end; end;
if p^=#0 then if p^ in [#0,#10] then
start:=true; start:=true;
inc(slen); inc(slen);
inc(p); inc(p);
@ -714,7 +729,7 @@ begin
'C' : Mode:=M_Char; 'C' : Mode:=M_Char;
'R' : Mode:=M_Renumber; 'R' : Mode:=M_Renumber;
'V' : begin 'V' : begin
Writeln('Msg2Inc ',version,' for Free Pascal (C) 1998 Peter Vreman'); Writeln('Msg2Inc ',version,' for Free Pascal (C) 1998-2000 Peter Vreman');
Writeln; Writeln;
Halt; Halt;
end; end;
@ -772,7 +787,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.7 2000-05-26 18:20:38 peter Revision 1.8 2000-06-30 20:23:38 peter
* new message files layout with msg numbers (but still no code to
show the number on the screen)
Revision 1.7 2000/05/26 18:20:38 peter
* fixed wrong var parameter with @ * fixed wrong var parameter with @
Revision 1.6 2000/05/15 13:14:48 pierre Revision 1.6 2000/05/15 13:14:48 pierre

82
compiler/verbose.pas
View File

@ -75,14 +75,15 @@ procedure SetErrorFlags(const s:string);
procedure GenerateError; procedure GenerateError;
procedure Internalerror(i:longint); procedure Internalerror(i:longint);
procedure Comment(l:longint;s:string); procedure Comment(l:longint;s:string);
procedure Message(w:tmsgconst); function MessagePchar(w:longint):pchar;
procedure Message1(w:tmsgconst;const s1:string); procedure Message(w:longint);
procedure Message2(w:tmsgconst;const s1,s2:string); procedure Message1(w:longint;const s1:string);
procedure Message3(w:tmsgconst;const s1,s2,s3:string); procedure Message2(w:longint;const s1,s2:string);
procedure MessagePos(const pos:tfileposinfo;w:tmsgconst); procedure Message3(w:longint;const s1,s2,s3:string);
procedure MessagePos1(const pos:tfileposinfo;w:tmsgconst;const s1:string); procedure MessagePos(const pos:tfileposinfo;w:longint);
procedure MessagePos2(const pos:tfileposinfo;w:tmsgconst;const s1,s2:string); procedure MessagePos1(const pos:tfileposinfo;w:longint;const s1:string);
procedure MessagePos3(const pos:tfileposinfo;w:tmsgconst;const s1,s2,s3:string); procedure MessagePos2(const pos:tfileposinfo;w:longint;const s1,s2:string);
procedure MessagePos3(const pos:tfileposinfo;w:longint;const s1,s2,s3:string);
procedure InitVerbose; procedure InitVerbose;
procedure DoneVerbose; procedure DoneVerbose;
@ -242,20 +243,16 @@ end;
procedure LoadMsgFile(const fn:string); procedure LoadMsgFile(const fn:string);
begin begin
if not(msg=nil) then if not msg^.LoadExtern(fn) then
dispose(msg,Done);
msg:=new(pmessage,InitExtern(fn,ord(endmsgconst)));
{$IFDEF TP}
if msg=nil then
begin begin
{$IFDEF TP}
writeln('Fatal: Cannot find error message file.'); writeln('Fatal: Cannot find error message file.');
halt(3); halt(3);
end;
{$ELSE} {$ELSE}
if msg=nil then msg^.LoadIntern(@msgtxt,msgtxtsize);
msg:=new(pmessage,Init(@msgtxt,ord(endmsgconst)));
{$ENDIF TP} {$ENDIF TP}
end; end;
end;
var var
@ -486,70 +483,76 @@ begin
end; end;
procedure Message(w:tmsgconst); function MessagePchar(w:longint):pchar;
begin begin
Msg2Comment(msg^.Get(ord(w))); MessagePchar:=msg^.GetPchar(w)
end; end;
procedure Message1(w:tmsgconst;const s1:string); procedure Message(w:longint);
begin begin
Msg2Comment(msg^.Get1(ord(w),s1)); Msg2Comment(msg^.Get(w));
end; end;
procedure Message2(w:tmsgconst;const s1,s2:string); procedure Message1(w:longint;const s1:string);
begin begin
Msg2Comment(msg^.Get2(ord(w),s1,s2)); Msg2Comment(msg^.Get1(w,s1));
end; end;
procedure Message3(w:tmsgconst;const s1,s2,s3:string); procedure Message2(w:longint;const s1,s2:string);
begin begin
Msg2Comment(msg^.Get3(ord(w),s1,s2,s3)); Msg2Comment(msg^.Get2(w,s1,s2));
end; end;
procedure MessagePos(const pos:tfileposinfo;w:tmsgconst); procedure Message3(w:longint;const s1,s2,s3:string);
begin
Msg2Comment(msg^.Get3(w,s1,s2,s3));
end;
procedure MessagePos(const pos:tfileposinfo;w:longint);
var var
oldpos : tfileposinfo; oldpos : tfileposinfo;
begin begin
oldpos:=aktfilepos; oldpos:=aktfilepos;
aktfilepos:=pos; aktfilepos:=pos;
Msg2Comment(msg^.Get(ord(w))); Msg2Comment(msg^.Get(w));
aktfilepos:=oldpos; aktfilepos:=oldpos;
end; end;
procedure MessagePos1(const pos:tfileposinfo;w:tmsgconst;const s1:string); procedure MessagePos1(const pos:tfileposinfo;w:longint;const s1:string);
var var
oldpos : tfileposinfo; oldpos : tfileposinfo;
begin begin
oldpos:=aktfilepos; oldpos:=aktfilepos;
aktfilepos:=pos; aktfilepos:=pos;
Msg2Comment(msg^.Get1(ord(w),s1)); Msg2Comment(msg^.Get1(w,s1));
aktfilepos:=oldpos; aktfilepos:=oldpos;
end; end;
procedure MessagePos2(const pos:tfileposinfo;w:tmsgconst;const s1,s2:string); procedure MessagePos2(const pos:tfileposinfo;w:longint;const s1,s2:string);
var var
oldpos : tfileposinfo; oldpos : tfileposinfo;
begin begin
oldpos:=aktfilepos; oldpos:=aktfilepos;
aktfilepos:=pos; aktfilepos:=pos;
Msg2Comment(msg^.Get2(ord(w),s1,s2)); Msg2Comment(msg^.Get2(w,s1,s2));
aktfilepos:=oldpos; aktfilepos:=oldpos;
end; end;
procedure MessagePos3(const pos:tfileposinfo;w:tmsgconst;const s1,s2,s3:string); procedure MessagePos3(const pos:tfileposinfo;w:longint;const s1,s2,s3:string);
var var
oldpos : tfileposinfo; oldpos : tfileposinfo;
begin begin
oldpos:=aktfilepos; oldpos:=aktfilepos;
aktfilepos:=pos; aktfilepos:=pos;
Msg2Comment(msg^.Get3(ord(w),s1,s2,s3)); Msg2Comment(msg^.Get3(w,s1,s2,s3));
aktfilepos:=oldpos; aktfilepos:=oldpos;
end; end;
@ -557,8 +560,14 @@ end;
procedure InitVerbose; procedure InitVerbose;
begin begin
{ Init } { Init }
msg:=new(pmessage,Init(20,msgidxmax));
if msg=nil then
begin
writeln('Fatal: MsgIdx Wrong');
halt(3);
end;
{$ifndef EXTERN_MSG} {$ifndef EXTERN_MSG}
msg:=new(pmessage,Init(@msgtxt,ord(endmsgconst))); msg^.LoadIntern(@msgtxt,msgtxtsize);
{$else} {$else}
LoadMsgFile(exepath+'errore.msg'); LoadMsgFile(exepath+'errore.msg');
{$endif} {$endif}
@ -567,6 +576,7 @@ begin
Status.MaxErrorCount:=50; Status.MaxErrorCount:=50;
end; end;
procedure DoneVerbose; procedure DoneVerbose;
begin begin
if assigned(msg) then if assigned(msg) then
@ -580,7 +590,11 @@ end.
{ {
$Log$ $Log$
Revision 1.54 2000-05-23 20:32:48 peter Revision 1.55 2000-06-30 20:23:38 peter
* new message files layout with msg numbers (but still no code to
show the number on the screen)
Revision 1.54 2000/05/23 20:32:48 peter
* removed dup msgcrcvalue * removed dup msgcrcvalue
Revision 1.53 2000/05/15 14:05:40 pierre Revision 1.53 2000/05/15 14:05:40 pierre