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

+ message directive for integers added

Browse Source
This commit is contained in:
florian 1999-02-22 23:33:29 +00:00
parent 9c0fa36e97
commit 204c81bd98
2 changed files with 111 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
compiler/pdecl.pas
View File

@ -1070,7 +1070,7 @@ unit pdecl;
hfp : pforwardpointer; hfp : pforwardpointer;
oldprocsym : pprocsym; oldprocsym : pprocsym;
oldparse_only : boolean; oldparse_only : boolean;
strmessagetable,classnamelabel : plabel; intmessagetable,strmessagetable,classnamelabel : plabel;
storetypeforwardsallowed : boolean; storetypeforwardsallowed : boolean;
pt : ptree; pt : ptree;
@ -1481,12 +1481,14 @@ unit pdecl;
{ generate message and dynamic tables } { generate message and dynamic tables }
strmessagetable:=genstrmsgtab(aktclass); strmessagetable:=genstrmsgtab(aktclass);
intmessagetable:=genintmsgtab(aktclass);
{ table for string messages } { table for string messages }
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(strmessagetable))))); datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(strmessagetable)))));
{ interface table } { interface table }
datasegment^.concat(new(pai_const,init_32bit(0))); datasegment^.concat(new(pai_const,init_32bit(0)));
{ auto table } { auto table }
datasegment^.concat(new(pai_const,init_32bit(0))); datasegment^.concat(new(pai_const,init_32bit(0)));
@ -1506,8 +1508,10 @@ unit pdecl;
datasegment^.concat(new(pai_const,init_32bit(0))); datasegment^.concat(new(pai_const,init_32bit(0)));
{ pointer to method table } { pointer to method table }
datasegment^.concat(new(pai_const,init_32bit(0))); datasegment^.concat(new(pai_const,init_32bit(0)));
{ pointer to dynamic table } { 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 } { pointer to class name string }
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(classnamelabel))))); datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(classnamelabel)))));
end; end;
@ -2189,7 +2193,10 @@ unit pdecl;
end. end.
{ {
$Log$ $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 + first implementation of message keyword
Revision 1.97 1999/02/22 02:44:10 peter Revision 1.97 1999/02/22 02:44:10 peter

108
compiler/types.pas
View File

@ -126,8 +126,9 @@ unit types;
{ generates a VMT for _class } { generates a VMT for _class }
procedure genvmt(_class : pobjectdef); procedure genvmt(_class : pobjectdef);
{ generates the message table for a class } { generates the message tables for a class }
function genstrmsgtab(_class : pobjectdef) : plabel; function genstrmsgtab(_class : pobjectdef) : plabel;
function genintmsgtab(_class : pobjectdef) : plabel;
{ some type helper routines for MMX support } { some type helper routines for MMX support }
function is_mmx_able_array(p : pdef) : boolean; function is_mmx_able_array(p : pdef) : boolean;
@ -783,7 +784,7 @@ unit types;
root : pprocdeftree; root : pprocdeftree;
count : longint; count : longint;
procedure insert(p : pprocdeftree;var at : pprocdeftree); procedure insertstr(p : pprocdeftree;var at : pprocdeftree);
var var
i : longint; i : longint;
@ -798,9 +799,9 @@ unit types;
begin begin
i:=strcomp(p^.p^.messageinf.str,at^.p^.messageinf.str); i:=strcomp(p^.p^.messageinf.str,at^.p^.messageinf.str);
if i<0 then if i<0 then
insert(p,at^.l) insertstr(p,at^.l)
else if i>0 then else if i>0 then
insert(p,at^.r) insertstr(p,at^.r)
else else
Message1(parser_e_duplicate_message_label,strpas(p^.p^.messageinf.str)); Message1(parser_e_duplicate_message_label,strpas(p^.p^.messageinf.str));
end; end;
@ -834,7 +835,7 @@ unit types;
pt^.p:=hp; pt^.p:=hp;
pt^.l:=nil; pt^.l:=nil;
pt^.r:=nil; pt^.r:=nil;
insert(pt,root); insertstr(pt,root);
end; end;
hp:=hp^.nextoverloaded; hp:=hp^.nextoverloaded;
end; end;
@ -884,7 +885,8 @@ unit types;
_class^.publicsyms^.foreach(insertmsgstr); _class^.publicsyms^.foreach(insertmsgstr);
{ write all names } { write all names }
writenames(root); if assigned(root) then
writenames(root);
{ now start writing of the message string table } { now start writing of the message string table }
getlabel(r); getlabel(r);
@ -898,6 +900,95 @@ unit types;
end; end;
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 type
pprocdefcoll = ^tprocdefcoll; pprocdefcoll = ^tprocdefcoll;
@ -1193,7 +1284,10 @@ unit types;
end. end.
{ {
$Log$ $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 + first implementation of message keyword
Revision 1.49 1999/02/16 00:45:30 peter Revision 1.49 1999/02/16 00:45:30 peter