diff --git a/compiler/hcodegen.pas b/compiler/hcodegen.pas index 0a7e6af5cf..afa173f4e3 100644 --- a/compiler/hcodegen.pas +++ b/compiler/hcodegen.pas @@ -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) diff --git a/compiler/pass_1.pas b/compiler/pass_1.pas index 742a5e4e3c..657ecc8e72 100644 --- a/compiler/pass_1.pas +++ b/compiler/pass_1.pas @@ -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