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

* moved message() to hcodegen, so pass_2 also uses them

Browse Source
This commit is contained in:
peter 1998-09-01 09:02:51 +00:00
parent f0278f7ddd
commit ca8c6dde40
2 changed files with 80 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
compiler/hcodegen.pas
View File

@ -25,7 +25,7 @@ unit hcodegen;
interface
uses
aasm,tree,symtable
verbose,aasm,tree,symtable
{$ifdef i386}
,i386
{$endif}
@ -121,6 +121,13 @@ unit hcodegen;
{ true, if an error while code generation occurs }
codegenerror : boolean;
{ message calls with codegenerror support }
procedure message(const t : tmsgconst);
procedure message1(const t : tmsgconst;const s : string);
procedure message2(const t : tmsgconst;const s1,s2 : string);
procedure message3(const t : tmsgconst;const s1,s2,s3 : string);
{ initialize respectively terminates the code generator }
{ for a new module or procedure }
procedure codegen_doneprocedure;
@ -156,7 +163,60 @@ unit hcodegen;
implementation
uses
systems,cobjects,verbose,globals,files,strings;
systems,comphook,cobjects,globals,files,strings;
{*****************************************************************************
override the message calls to set codegenerror
*****************************************************************************}
procedure message(const t : tmsgconst);
var
olderrorcount : longint;
begin
if not(codegenerror) then
begin
olderrorcount:=status.errorcount;
verbose.Message(t);
codegenerror:=olderrorcount<>status.errorcount;
end;
end;
procedure message1(const t : tmsgconst;const s : string);
var
olderrorcount : longint;
begin
if not(codegenerror) then
begin
olderrorcount:=status.errorcount;
verbose.Message1(t,s);
codegenerror:=olderrorcount<>status.errorcount;
end;
end;
procedure message2(const t : tmsgconst;const s1,s2 : string);
var
olderrorcount : longint;
begin
if not(codegenerror) then
begin
olderrorcount:=status.errorcount;
verbose.Message2(t,s1,s2);
codegenerror:=olderrorcount<>status.errorcount;
end;
end;
procedure message3(const t : tmsgconst;const s1,s2,s3 : string);
var
olderrorcount : longint;
begin
if not(codegenerror) then
begin
olderrorcount:=status.errorcount;
verbose.Message3(t,s1,s2,s3);
codegenerror:=olderrorcount<>status.errorcount;
end;
end;
{*****************************************************************************
initialize/terminate the codegen for procedure and modules
@ -407,7 +467,10 @@ end.
{
$Log$
Revision 1.14 1998-08-21 14:08:43 pierre
Revision 1.15 1998-09-01 09:02:51 peter
* moved message() to hcodegen, so pass_2 also uses them
Revision 1.14 1998/08/21 14:08:43 pierre
+ TEST_FUNCRET now default (old code removed)
works also for m68k (at least compiles)

75
compiler/pass_1.pas
View File

@ -30,7 +30,9 @@ unit pass_1;
uses tree;
function do_firstpass(var p : ptree) : boolean;
procedure firstpass(var p : ptree);
function do_firstpass(var p : ptree) : boolean;
implementation
@ -55,63 +57,6 @@ unit pass_1;
const
count_ref : boolean = true;
procedure message(const t : tmsgconst);
var
olderrorcount : longint;
begin
if not(codegenerror) then
begin
olderrorcount:=status.errorcount;
verbose.Message(t);
codegenerror:=olderrorcount<>status.errorcount;
end;
end;
procedure message1(const t : tmsgconst;const s : string);
var
olderrorcount : longint;
begin
if not(codegenerror) then
begin
olderrorcount:=status.errorcount;
verbose.Message1(t,s);
codegenerror:=olderrorcount<>status.errorcount;
end;
end;
procedure message2(const t : tmsgconst;const s1,s2 : string);
var
olderrorcount : longint;
begin
if not(codegenerror) then
begin
olderrorcount:=status.errorcount;
verbose.Message2(t,s1,s2);
codegenerror:=olderrorcount<>status.errorcount;
end;
end;
procedure message3(const t : tmsgconst;const s1,s2,s3 : string);
var
olderrorcount : longint;
begin
if not(codegenerror) then
begin
olderrorcount:=status.errorcount;
verbose.Message3(t,s1,s2,s3);
codegenerror:=olderrorcount<>status.errorcount;
end;
end;
procedure firstpass(var p : ptree);forward;
{ marks an lvalue as "unregable" }
procedure make_not_regable(p : ptree);
@ -4748,8 +4693,13 @@ unit pass_1;
t_times:=t_times*8;
cleartempgen;
if p^.t1<>nil then
firstpass(p^.t1);
if assigned(p^.t1) then
begin
firstpass(p^.t1);
if codegenerror then
exit;
end;
p^.registers32:=p^.t1^.registers32;
p^.registersfpu:=p^.t1^.registersfpu;
@ -5324,7 +5274,10 @@ unit pass_1;
end.
{
$Log$
Revision 1.67 1998-09-01 07:54:20 pierre
Revision 1.68 1998-09-01 09:02:52 peter
* moved message() to hcodegen, so pass_2 also uses them
Revision 1.67 1998/09/01 07:54:20 pierre
* UseBrowser a little updated (might still be buggy !!)
* bug in psub.pas in function specifier removed
* stdcall allowed in interface and in implementation