paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 06:29:38 +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}
{$endif fpc}
procedure writepathlist(w:tmsgconst;l:TSearchPathList);
procedure writepathlist(w:longint;l:TSearchPathList);
var
hp : pstringqueueitem;
begin
@ -355,7 +355,11 @@ end;
end.
{
$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
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

1411
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;
{ message calls with codegenerror support }
procedure cgmessage(t : tmsgconst);
procedure cgmessage1(t : tmsgconst;const s : string);
procedure cgmessage2(t : tmsgconst;const s1,s2 : string);
procedure cgmessage3(t : tmsgconst;const s1,s2,s3 : string);
procedure CGMessagePos(const pos:tfileposinfo;t:tmsgconst);
procedure CGMessagePos1(const pos:tfileposinfo;t:tmsgconst;const s1:string);
procedure CGMessagePos2(const pos:tfileposinfo;t:tmsgconst;const s1,s2:string);
procedure CGMessagePos3(const pos:tfileposinfo;t:tmsgconst;const s1,s2,s3:string);
procedure cgmessage(t : longint);
procedure cgmessage1(t : longint;const s : string);
procedure cgmessage2(t : longint;const s1,s2 : string);
procedure cgmessage3(t : longint;const s1,s2,s3 : string);
procedure CGMessagePos(const pos:tfileposinfo;t:longint);
procedure CGMessagePos1(const pos:tfileposinfo;t:longint;const s1:string);
procedure CGMessagePos2(const pos:tfileposinfo;t:longint;const s1,s2:string);
procedure CGMessagePos3(const pos:tfileposinfo;t:longint;const s1,s2,s3:string);
{ initialize respectively terminates the code generator }
{ for a new module or procedure }
@ -176,7 +176,7 @@ implementation
override the message calls to set codegenerror
*****************************************************************************}
procedure cgmessage(t : tmsgconst);
procedure cgmessage(t : longint);
var
olderrorcount : longint;
begin
@ -188,7 +188,7 @@ implementation
end;
end;
procedure cgmessage1(t : tmsgconst;const s : string);
procedure cgmessage1(t : longint;const s : string);
var
olderrorcount : longint;
begin
@ -200,7 +200,7 @@ implementation
end;
end;
procedure cgmessage2(t : tmsgconst;const s1,s2 : string);
procedure cgmessage2(t : longint;const s1,s2 : string);
var
olderrorcount : longint;
begin
@ -212,7 +212,7 @@ implementation
end;
end;
procedure cgmessage3(t : tmsgconst;const s1,s2,s3 : string);
procedure cgmessage3(t : longint;const s1,s2,s3 : string);
var
olderrorcount : longint;
begin
@ -225,7 +225,7 @@ implementation
end;
procedure cgmessagepos(const pos:tfileposinfo;t : tmsgconst);
procedure cgmessagepos(const pos:tfileposinfo;t : longint);
var
olderrorcount : longint;
begin
@ -237,7 +237,7 @@ implementation
end;
end;
procedure cgmessagepos1(const pos:tfileposinfo;t : tmsgconst;const s1 : string);
procedure cgmessagepos1(const pos:tfileposinfo;t : longint;const s1 : string);
var
olderrorcount : longint;
begin
@ -249,7 +249,7 @@ implementation
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
olderrorcount : longint;
begin
@ -261,7 +261,7 @@ implementation
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
olderrorcount : longint;
begin
@ -450,7 +450,11 @@ end.
{
$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
Revision 1.58 2000/04/02 18:30:12 florian

339
compiler/messages.pas
View File

@ -23,51 +23,97 @@
unit Messages;
interface
const
maxmsgidxparts = 20;
type
ppchar=^pchar;
TArrayOfPChar = array[0..1000] of pchar;
PArrayOfPChar = ^TArrayOfPChar;
PMessage=^TMessage;
TMessage=object
msgfilename : string;
msgallocsize,
msgsize,
msgcrc,
msgparts,
msgs : longint;
msgtxt : pchar;
msgidx : ppchar;
constructor Init(p:pointer;n:longint);
constructor InitExtern(const fn:string;n:longint);
destructor Done;
msgidx : array[1..maxmsgidxparts] of PArrayOfPChar;
msgidxmax : array[1..maxmsgidxparts] of longint;
constructor Init(n:longint;const idxmax:array of longint);
destructor Done;
function LoadIntern(p:pointer;n:longint):boolean;
function LoadExtern(const fn:string):boolean;
procedure CreateIdx;
function Get(nr:longint):string;
function Get3(nr:longint;const s1,s2,s3:string):string;
function Get2(nr:longint;const s1,s2:string):string;
function Get1(nr:longint;const s1:string):string;
function GetPChar(nr:longint):pchar;
function Get(nr:longint):string;
function Get3(nr:longint;const s1,s2,s3:string):string;
function Get2(nr:longint;const s1,s2:string):string;
function Get1(nr:longint;const s1:string):string;
end;
{ this will read a line until #10 or #0 and also increase p }
function GetMsgLine(var p:pchar):string;
implementation
uses
globals,crc,
verbose,
{$ifdef DELPHI}
sysutils;
{$else DELPHI}
strings;
{$endif DELPHI}
constructor TMessage.Init(p:pointer;n:longint);
constructor TMessage.Init(n:longint;const idxmax:array of longint);
var
i : longint;
begin
msgtxt:=pchar(p);
msgallocsize:=0;
msgtxt:=nil;
msgsize:=0;
msgcrc:=MsgCrcValue;
msgs:=n;
CreateIdx;
msgparts:=n;
if n<>high(idxmax)+1 then
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;
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}
procedure readln(var t:text;var s:string);
@ -96,61 +142,99 @@ const
bufsize=8192;
var
f : text;
{$ifdef DEBUGCRC}
f2 : text;
{$endif DEBUGCRC}
msgsread,
line,i,crc : longint;
error,multiline : boolean;
code : word;
numpart,numidx,
line,i,j,num : longint;
ptxt : pchar;
number,
s,s1 : string;
buf : pointer;
procedure err(const msgstr:string);
begin
writeln('error in line ',line,': ',msgstr);
error:=true;
end;
begin
crc:=longint($ffffffff);
LoadExtern:=false;
getmem(buf,bufsize);
{Read the message file}
assign(f,fn);
{$ifdef DEBUGCRC}
assign(f2,'crcmsg.tst');
rewrite(f2);
Writeln(f2,crc);
{$endif DEBUGCRC}
{$I-}
reset(f);
{$I+}
if ioresult<>0 then
begin
WriteLn('*** message file '+fn+' not found ***');
fail;
exit;
end;
settextbuf(f,buf^,bufsize);
{ First parse the file and count bytes needed }
error:=false;
line:=0;
msgs:=n;
multiline:=false;
msgsize:=0;
msgsread:=0;
while not eof(f) do
begin
readln(f,s);
inc(line);
if (s<>'') and not(s[1] in ['#',';','%']) then
if multiline then
begin
i:=pos('=',s);
if i>0 then
begin
inc(msgsize,length(s)-i+1);
inc(msgsread);
end
if s=']' then
multiline:=false
else
writeln('error in line: ',line,' skipping');
inc(msgsize,length(s)+1); { +1 for linebreak }
end
else
begin
if (s<>'') and not(s[1] in ['#',';','%']) then
begin
i:=pos('=',s);
if i>0 then
begin
j:=i+1;
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
else
inc(msgsize,length(s)-i+1);
end
else
err('no = found');
end;
end;
end;
{ check amount of messages }
if msgsread<>msgs then
if multiline then
err('still in multiline mode');
if error then
begin
WriteLn('*** message file '+fn+' is corrupt: read ',msgsread,' of ',msgs,' msgs ***');
close(f);
freemem(buf,bufsize);
fail;
close(f);
exit;
end;
{ now read the buffer in mem }
msgallocsize:=msgsize;
@ -160,96 +244,135 @@ begin
while not eof(f) do
begin
readln(f,s);
if (s<>'') and not(s[1] in ['#',';','%']) then
if multiline then
begin
i:=pos('=',s);
if i>0 then
if s=']' then
begin
{txt}
s1:=Copy(s,i+1,255);
{ support <lf> for empty lines }
if s1='<lf>' then
begin
s1:='';
{ update the msgsize also! }
dec(msgsize,4);
end;
{txt}
move(s1[1],ptxt^,length(s1));
inc(ptxt,length(s1));
multiline:=false;
{ overwrite last eol }
dec(ptxt);
ptxt^:=#0;
inc(ptxt);
s1:=upper(copy(s,1,i-1));
crc:=UpdateCRC32(crc,s1[1],length(s1));
{$ifdef DEBUGCRC}
Writeln(f2,s1);
Writeln(f2,crc);
{$endif DEBUGCRC}
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
begin
i:=pos('=',s);
if i>0 then
begin
j:=i+1;
while (s[j] in ['0'..'9']) do
inc(j);
{ multiline start then no txt }
if s[j+1]='[' then
begin
s1:=Copy(s,i+1,j-i);
move(s1[1],ptxt^,length(s1));
inc(ptxt,length(s1));
multiline:=true;
end
else
begin
{ txt including number }
s1:=Copy(s,i+1,255);
move(s1[1],ptxt^,length(s1));
inc(ptxt,length(s1));
ptxt^:=#0;
inc(ptxt);
end;
end;
end;
end;
end;
close(f);
{$ifdef DEBUGCRC}
close(f2);
{$endif DEBUGCRC}
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 }
CreateIdx;
end;
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;
LoadExtern:=true;
end;
procedure TMessage.CreateIdx;
var
hp : pchar;
hpl : ppchar;
n : longint;
hp1,
hp,hpend : pchar;
code : word;
num : longint;
number : string[5];
i : longint;
numpart,numidx : longint;
begin
getmem(msgidx,msgs shl 2);
hpl:=msgidx;
{ clear }
for i:=1to msgparts do
fillchar(msgidx[i]^,msgidxmax[i]*4,0);
{ process msgtxt buffer }
number:='00000';
hp:=msgtxt;
n:=0;
while (n<msgs) do
hpend:=@msgtxt[msgsize];
while (hp<hpend) do
begin
hpl^:=hp;
hpl:=pointer(longint(hpl)+4);
inc(n);
hp1:=hp;
for i:=1to 5 do
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]);
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;
var
s : string[16];
hp : pchar;
begin
if msgidx=nil then
hp:=nil
else
hp:=pchar(pointer(longint(msgidx)+nr shl 2)^);
hp:=msgidx[nr div 1000]^[nr mod 1000];
if hp=nil then
begin
Str(nr,s);
@ -306,7 +429,11 @@ end;
end.
{
$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
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;
var
i : tmsgconst;
p : pchar;
begin
MaybeLoadMessageFile;
for i:=option_logo_start to option_logo_end do
Message1(i,target_cpu_string);
p:=MessagePchar(option_logo);
while assigned(p) do
Comment(V_Normal,GetMsgLine(p));
end;
procedure Toption.WriteInfo;
var
i : tmsgconst;
p : pchar;
begin
MaybeLoadMessageFile;
for i:=option_info_start to option_info_end do
Message(i);
p:=MessagePchar(option_info);
while assigned(p) do
Comment(V_Normal,GetMsgLine(p));
StopOptions;
end;
@ -205,7 +207,6 @@ procedure Toption.WriteHelpPages;
end;
var
idx,
lastident,
j,outline,
ident,
@ -214,6 +215,7 @@ var
opt : string[32];
input,
s : string;
p : pchar;
begin
MaybeLoadMessageFile;
Message1(option_usage,paramstr(0));
@ -222,10 +224,11 @@ begin
lines:=3
else
lines:=1;
for idx:=ord(ol_begin) to ord(ol_end) do
p:=MessagePChar(option_help_pages);
while assigned(p) do
begin
{ get a line and reset }
s:=msg^.Get(idx);
s:=GetMsgLine(p);
ident:=0;
show:=false;
{ parse options }
@ -1485,7 +1488,11 @@ end;
end.
{
$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
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);
var
w : tmsgconst;
w : longint;
begin
case t of
_DIR_STOP,
@ -1419,7 +1419,11 @@ const
{
$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
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 checkpreprocstack;
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 linebreak;
procedure readchar;
@ -634,7 +634,7 @@ implementation
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
preprocstack:=new(ppreprocstack,init(atyp,((preprocstack=nil) or preprocstack^.accept) and a,preprocstack));
preprocstack^.name:=s;
@ -1835,7 +1835,11 @@ exit_label:
end.
{
$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
* extended illegal char message with the char itself (Delphi like)

299
compiler/utils/msg2inc.pp
View File

@ -16,16 +16,17 @@
**********************************************************************}
program msg2inc;
uses
crc,
strings;
const
version='0.99.14';
version='0.99.15';
{$ifdef linux}
eollen=1;
{$else}
eollen=2;
{$endif}
msgparts = 20;
type
TMode=(M_Char,M_Tex,M_Intel,M_String,M_Renumber);
var
@ -40,87 +41,27 @@ var
enumsize,
msgsize : longint;
function XlatString(Var S : String):boolean;
{
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;
msgidxmax : array[1..msgparts] of longint;
procedure LoadMsgFile(const fn:string);
var
f : text;
line,i : longint;
error,
multiline : boolean;
code : word;
numpart,numidx,
line,i,j,num : longint;
ptxt,
penum : pchar;
number,
s,s1 : string;
procedure err(const msgstr:string);
begin
writeln('error in line ',line,': ',msgstr);
error:=true;
end;
begin
Writeln('Loading messagefile ',fn);
{Read the message file}
@ -130,65 +71,142 @@ begin
{$I+}
if ioresult<>0 then
begin
WriteLn('*** message file '+fn+' not found ***');
exit;
WriteLn('fatal error: '+fn+' not found');
halt(1);
end;
{ First parse the file and count bytes needed }
fillchar(msgidxmax,sizeof(msgidxmax),0);
error:=false;
line:=0;
multiline:=false;
msgsize:=0;
while not eof(f) do
begin
readln(f,s);
inc(line);
if not XlatString(S) then
S:='';
if (s<>'') and not(s[1] in ['#',';','%']) then
if multiline then
begin
i:=pos('=',s);
if i>0 then
begin
inc(msgsize,length(s)-i+1);
inc(enumsize,i);
end
if s=']' then
multiline:=false
else
writeln('error in line: ',line,' skipping');
inc(msgsize,length(s)+1); { +1 for linebreak }
end
else
begin
if (s<>'') and not(s[1] in ['#',';','%']) then
begin
i:=pos('=',s);
if i>0 then
begin
j:=i+1;
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
else
inc(msgsize,length(s)-i+1);
inc(enumsize,j);
end
else
err('no = found');
end;
end;
end;
{ now read the buffer in mem }
if multiline then
err('still in multiline mode');
if error then
begin
close(f);
writeln('aborting');
halt(1);
end;
{ alloc memory }
getmem(msgtxt,msgsize);
ptxt:=msgtxt;
getmem(enumtxt,enumsize);
penum:=enumtxt;
{ now read the buffer in mem }
reset(f);
while not eof(f) do
begin
readln(f,s);
inc(line);
if not XlatString(S) then
S[0]:=#0;
if (s<>'') and not(s[1] in ['#',';','%']) then
if multiline then
begin
i:=pos('=',s);
if i>0 then
if s=']' then
begin
{txt}
s1:=Copy(s,i+1,255);
{ support <lf> for empty lines }
if s1='<lf>' then
begin
s1:='';
{ update the msgsize also! }
dec(msgsize,4);
end;
move(s1[1],ptxt^,length(s1));
inc(ptxt,length(s1));
multiline:=false;
{ overwrite last eol }
dec(ptxt);
ptxt^:=#0;
inc(ptxt);
{enum}
move(s[1],penum^,i-1);
inc(penum,i-1);
penum^:=#0;
inc(penum);
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
begin
i:=pos('=',s);
if i>0 then
begin
j:=i+1;
while (s[j] in ['0'..'9']) do
inc(j);
{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
s1:=Copy(s,i+1,j-i);
move(s1[1],ptxt^,length(s1));
inc(ptxt,length(s1));
multiline:=true;
end
else
begin
{ txt including number }
s1:=Copy(s,i+1,255);
move(s1[1],ptxt^,length(s1));
inc(ptxt,length(s1));
ptxt^:=#0;
inc(ptxt);
end;
end;
end;
end;
end;
@ -203,25 +221,15 @@ end;
procedure WriteEnumFile(const fn,typename:string);
var
t : text;
{$ifdef DEBUGCRC}
t2 : text;
{$endif DEBUGCRC}
i,crcvalue : longint;
i : longint;
p : pchar;
s : string;
start : boolean;
begin
crcvalue:=longint($ffffffff);
writeln('Writing enumfile '+fn);
{Open textfile}
assign(t,fn);
rewrite(t);
{$ifdef DEBUGCRC}
assign(t2,'crc.tst');
rewrite(t2);
Writeln(t2,crcvalue);
{$endif DEBUGCRC}
writeln(t,'type t',typename,'=(');
writeln(t,'const');
{Parse buffer in msgbuf and create indexs}
p:=enumtxt;
start:=true;
@ -230,17 +238,11 @@ begin
if start then
begin
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;
end;
if p^=#0 then
begin
writeln(t,',');
writeln(t,';');
start:=true;
end
else
@ -249,14 +251,27 @@ begin
end;
inc(p);
end;
writeln(t,'end',typename);
writeln(t,');');
writeln(t,'const');
writeln(t,' MsgCRCValue : longint = ',crcvalue,';');
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,' );');
close(t);
{$ifdef DEBUGCRC}
close(t2);
{$endif DEBUGCRC}
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));
inc(len,3);
end;
if p^=#0 then
if p^ in [#0,#10] then
start:=true;
inc(slen);
inc(p);
@ -714,7 +729,7 @@ begin
'C' : Mode:=M_Char;
'R' : Mode:=M_Renumber;
'V' : begin
Writeln('Msg2Inc ',version,' for Free Pascal (C) 1998 Peter Vreman');
Writeln('Msg2Inc ',version,' for Free Pascal (C) 1998-2000 Peter Vreman');
Writeln;
Halt;
end;
@ -772,7 +787,11 @@ begin
end.
{
$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 @
Revision 1.6 2000/05/15 13:14:48 pierre

86
compiler/verbose.pas
View File

@ -75,14 +75,15 @@ procedure SetErrorFlags(const s:string);
procedure GenerateError;
procedure Internalerror(i:longint);
procedure Comment(l:longint;s:string);
procedure Message(w:tmsgconst);
procedure Message1(w:tmsgconst;const s1:string);
procedure Message2(w:tmsgconst;const s1,s2:string);
procedure Message3(w:tmsgconst;const s1,s2,s3:string);
procedure MessagePos(const pos:tfileposinfo;w:tmsgconst);
procedure MessagePos1(const pos:tfileposinfo;w:tmsgconst;const s1:string);
procedure MessagePos2(const pos:tfileposinfo;w:tmsgconst;const s1,s2:string);
procedure MessagePos3(const pos:tfileposinfo;w:tmsgconst;const s1,s2,s3:string);
function MessagePchar(w:longint):pchar;
procedure Message(w:longint);
procedure Message1(w:longint;const s1:string);
procedure Message2(w:longint;const s1,s2:string);
procedure Message3(w:longint;const s1,s2,s3:string);
procedure MessagePos(const pos:tfileposinfo;w:longint);
procedure MessagePos1(const pos:tfileposinfo;w:longint;const s1: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 DoneVerbose;
@ -242,19 +243,15 @@ end;
procedure LoadMsgFile(const fn:string);
begin
if not(msg=nil) then
dispose(msg,Done);
msg:=new(pmessage,InitExtern(fn,ord(endmsgconst)));
if not msg^.LoadExtern(fn) then
begin
{$IFDEF TP}
if msg=nil then
begin
writeln('Fatal: Cannot find error message file.');
halt(3);
end;
writeln('Fatal: Cannot find error message file.');
halt(3);
{$ELSE}
if msg=nil then
msg:=new(pmessage,Init(@msgtxt,ord(endmsgconst)));
msg^.LoadIntern(@msgtxt,msgtxtsize);
{$ENDIF TP}
end;
end;
@ -486,70 +483,76 @@ begin
end;
procedure Message(w:tmsgconst);
function MessagePchar(w:longint):pchar;
begin
Msg2Comment(msg^.Get(ord(w)));
MessagePchar:=msg^.GetPchar(w)
end;
procedure Message1(w:tmsgconst;const s1:string);
procedure Message(w:longint);
begin
Msg2Comment(msg^.Get1(ord(w),s1));
Msg2Comment(msg^.Get(w));
end;
procedure Message2(w:tmsgconst;const s1,s2:string);
procedure Message1(w:longint;const s1:string);
begin
Msg2Comment(msg^.Get2(ord(w),s1,s2));
Msg2Comment(msg^.Get1(w,s1));
end;
procedure Message3(w:tmsgconst;const s1,s2,s3:string);
procedure Message2(w:longint;const s1,s2:string);
begin
Msg2Comment(msg^.Get3(ord(w),s1,s2,s3));
Msg2Comment(msg^.Get2(w,s1,s2));
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
oldpos : tfileposinfo;
begin
oldpos:=aktfilepos;
aktfilepos:=pos;
Msg2Comment(msg^.Get(ord(w)));
Msg2Comment(msg^.Get(w));
aktfilepos:=oldpos;
end;
procedure MessagePos1(const pos:tfileposinfo;w:tmsgconst;const s1:string);
procedure MessagePos1(const pos:tfileposinfo;w:longint;const s1:string);
var
oldpos : tfileposinfo;
begin
oldpos:=aktfilepos;
aktfilepos:=pos;
Msg2Comment(msg^.Get1(ord(w),s1));
Msg2Comment(msg^.Get1(w,s1));
aktfilepos:=oldpos;
end;
procedure MessagePos2(const pos:tfileposinfo;w:tmsgconst;const s1,s2:string);
procedure MessagePos2(const pos:tfileposinfo;w:longint;const s1,s2:string);
var
oldpos : tfileposinfo;
begin
oldpos:=aktfilepos;
aktfilepos:=pos;
Msg2Comment(msg^.Get2(ord(w),s1,s2));
Msg2Comment(msg^.Get2(w,s1,s2));
aktfilepos:=oldpos;
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
oldpos : tfileposinfo;
begin
oldpos:=aktfilepos;
aktfilepos:=pos;
Msg2Comment(msg^.Get3(ord(w),s1,s2,s3));
Msg2Comment(msg^.Get3(w,s1,s2,s3));
aktfilepos:=oldpos;
end;
@ -557,8 +560,14 @@ end;
procedure InitVerbose;
begin
{ Init }
msg:=new(pmessage,Init(20,msgidxmax));
if msg=nil then
begin
writeln('Fatal: MsgIdx Wrong');
halt(3);
end;
{$ifndef EXTERN_MSG}
msg:=new(pmessage,Init(@msgtxt,ord(endmsgconst)));
msg^.LoadIntern(@msgtxt,msgtxtsize);
{$else}
LoadMsgFile(exepath+'errore.msg');
{$endif}
@ -567,6 +576,7 @@ begin
Status.MaxErrorCount:=50;
end;
procedure DoneVerbose;
begin
if assigned(msg) then
@ -580,7 +590,11 @@ end.
{
$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
Revision 1.53 2000/05/15 14:05:40 pierre