mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-08 22:31:27 +02:00
+ message directive for integers added
This commit is contained in:
florian
parent
9c0fa36e97
commit
204c81bd98
@ -1070,7 +1070,7 @@ unit pdecl;
|
||||
hfp : pforwardpointer;
|
||||
oldprocsym : pprocsym;
|
||||
oldparse_only : boolean;
|
||||
strmessagetable,classnamelabel : plabel;
|
||||
intmessagetable,strmessagetable,classnamelabel : plabel;
|
||||
storetypeforwardsallowed : boolean;
|
||||
pt : ptree;
|
||||
|
||||
@ -1481,12 +1481,14 @@ unit pdecl;
|
||||
|
||||
{ generate message and dynamic tables }
|
||||
strmessagetable:=genstrmsgtab(aktclass);
|
||||
intmessagetable:=genintmsgtab(aktclass);
|
||||
|
||||
{ table for string messages }
|
||||
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(strmessagetable)))));
|
||||
|
||||
{ interface table }
|
||||
datasegment^.concat(new(pai_const,init_32bit(0)));
|
||||
|
||||
{ auto table }
|
||||
datasegment^.concat(new(pai_const,init_32bit(0)));
|
||||
|
||||
@ -1506,8 +1508,10 @@ unit pdecl;
|
||||
datasegment^.concat(new(pai_const,init_32bit(0)));
|
||||
{ pointer to method table }
|
||||
datasegment^.concat(new(pai_const,init_32bit(0)));
|
||||
|
||||
{ pointer to dynamic table }
|
||||
datasegment^.concat(new(pai_const,init_32bit(0)));
|
||||
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(intmessagetable)))));
|
||||
|
||||
{ pointer to class name string }
|
||||
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(classnamelabel)))));
|
||||
end;
|
||||
@ -2189,7 +2193,10 @@ unit pdecl;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.98 1999-02-22 20:13:36 florian
|
||||
Revision 1.99 1999-02-22 23:33:29 florian
|
||||
+ message directive for integers added
|
||||
|
||||
Revision 1.98 1999/02/22 20:13:36 florian
|
||||
+ first implementation of message keyword
|
||||
|
||||
Revision 1.97 1999/02/22 02:44:10 peter
|
||||
|
||||
@ -126,8 +126,9 @@ unit types;
|
||||
{ generates a VMT for _class }
|
||||
procedure genvmt(_class : pobjectdef);
|
||||
|
||||
{ generates the message table for a class }
|
||||
{ generates the message tables for a class }
|
||||
function genstrmsgtab(_class : pobjectdef) : plabel;
|
||||
function genintmsgtab(_class : pobjectdef) : plabel;
|
||||
|
||||
{ some type helper routines for MMX support }
|
||||
function is_mmx_able_array(p : pdef) : boolean;
|
||||
@ -783,7 +784,7 @@ unit types;
|
||||
root : pprocdeftree;
|
||||
count : longint;
|
||||
|
||||
procedure insert(p : pprocdeftree;var at : pprocdeftree);
|
||||
procedure insertstr(p : pprocdeftree;var at : pprocdeftree);
|
||||
|
||||
var
|
||||
i : longint;
|
||||
@ -798,9 +799,9 @@ unit types;
|
||||
begin
|
||||
i:=strcomp(p^.p^.messageinf.str,at^.p^.messageinf.str);
|
||||
if i<0 then
|
||||
insert(p,at^.l)
|
||||
insertstr(p,at^.l)
|
||||
else if i>0 then
|
||||
insert(p,at^.r)
|
||||
insertstr(p,at^.r)
|
||||
else
|
||||
Message1(parser_e_duplicate_message_label,strpas(p^.p^.messageinf.str));
|
||||
end;
|
||||
@ -834,7 +835,7 @@ unit types;
|
||||
pt^.p:=hp;
|
||||
pt^.l:=nil;
|
||||
pt^.r:=nil;
|
||||
insert(pt,root);
|
||||
insertstr(pt,root);
|
||||
end;
|
||||
hp:=hp^.nextoverloaded;
|
||||
end;
|
||||
@ -884,7 +885,8 @@ unit types;
|
||||
_class^.publicsyms^.foreach(insertmsgstr);
|
||||
|
||||
{ write all names }
|
||||
writenames(root);
|
||||
if assigned(root) then
|
||||
writenames(root);
|
||||
|
||||
{ now start writing of the message string table }
|
||||
getlabel(r);
|
||||
@ -898,6 +900,95 @@ unit types;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure insertint(p : pprocdeftree;var at : pprocdeftree);
|
||||
|
||||
var
|
||||
i : longint;
|
||||
|
||||
begin
|
||||
if at=nil then
|
||||
begin
|
||||
at:=p;
|
||||
inc(count);
|
||||
end
|
||||
else
|
||||
begin
|
||||
i:=strcomp(p^.p^.messageinf.str,at^.p^.messageinf.str);
|
||||
if p^.p^.messageinf.i<at^.p^.messageinf.i then
|
||||
insertstr(p,at^.l)
|
||||
else if p^.p^.messageinf.i>at^.p^.messageinf.i then
|
||||
insertstr(p,at^.r)
|
||||
else
|
||||
Message1(parser_e_duplicate_message_label,tostr(p^.p^.messageinf.i));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure writeintentry(p : pprocdeftree);
|
||||
|
||||
begin
|
||||
if assigned(p^.l) then
|
||||
writeintentry(p^.l);
|
||||
|
||||
{ write name label }
|
||||
datasegment^.concat(new(pai_const,init_32bit(p^.p^.messageinf.i)));
|
||||
|
||||
datasegment^.concat(new(pai_const,
|
||||
init_symbol(strpnew(p^.p^.mangledname))));
|
||||
maybe_concat_external(p^.p^.owner,p^.p^.mangledname);
|
||||
|
||||
if assigned(p^.r) then
|
||||
writeintentry(p^.r);
|
||||
end;
|
||||
|
||||
procedure insertmsgint(p : psym);{$ifndef FPC}far;{$endif FPC}
|
||||
|
||||
var
|
||||
hp : pprocdef;
|
||||
pt : pprocdeftree;
|
||||
|
||||
begin
|
||||
if p^.typ=procsym then
|
||||
begin
|
||||
hp:=pprocsym(p)^.definition;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
if (hp^.options and pomsgint)<>0 then
|
||||
begin
|
||||
new(pt);
|
||||
pt^.p:=hp;
|
||||
pt^.l:=nil;
|
||||
pt^.r:=nil;
|
||||
insertint(pt,root);
|
||||
end;
|
||||
hp:=hp^.nextoverloaded;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function genintmsgtab(_class : pobjectdef) : plabel;
|
||||
|
||||
|
||||
var
|
||||
r : plabel;
|
||||
|
||||
begin
|
||||
root:=nil;
|
||||
count:=0;
|
||||
{ insert all message handlers into a tree, sorted by name }
|
||||
_class^.publicsyms^.foreach(insertmsgint);
|
||||
|
||||
{ now start writing of the message string table }
|
||||
getlabel(r);
|
||||
datasegment^.concat(new(pai_label,init(r)));
|
||||
genintmsgtab:=r;
|
||||
datasegment^.concat(new(pai_const,init_32bit(count)));
|
||||
if assigned(root) then
|
||||
begin
|
||||
writeintentry(root);
|
||||
disposeprocdeftree(root);
|
||||
end;
|
||||
end;
|
||||
|
||||
type
|
||||
pprocdefcoll = ^tprocdefcoll;
|
||||
|
||||
@ -1193,7 +1284,10 @@ unit types;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.50 1999-02-22 20:13:42 florian
|
||||
Revision 1.51 1999-02-22 23:33:31 florian
|
||||
+ message directive for integers added
|
||||
|
||||
Revision 1.50 1999/02/22 20:13:42 florian
|
||||
+ first implementation of message keyword
|
||||
|
||||
Revision 1.49 1999/02/16 00:45:30 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user