From 994d0eb5785e0e2073288eeaf45fb20242c66bf4 Mon Sep 17 00:00:00 2001
From: peter <peter@freepascal.org>
Date: Thu, 21 May 1998 19:33:31 +0000
Subject: [PATCH] + better procedure directive handling and only one table
---
compiler/cgi386.pas | 23 +++++++++++++++++------
compiler/pexpr.pas | 21 ++++++++++++++++-----
compiler/pstatmnt.pas | 8 +++++++-
compiler/switches.pas | 9 ++++++---
compiler/verb_def.pas | 16 +++++++++-------
compiler/verbose.pas | 42 ++++++++++++++++++------------------------
6 files changed, 73 insertions(+), 46 deletions(-)
diff --git a/compiler/cgi386.pas b/compiler/cgi386.pas
index c2c39f2ffb..f79f19a339 100644
--- a/compiler/cgi386.pas
+++ b/compiler/cgi386.pas
@@ -238,7 +238,8 @@ implementation
{ make a reference }
hp:=new_reference(procinfo.framepointer,
procinfo.framepointer_offset);
-
+
+
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));
simple_loadn:=false;
@@ -2846,6 +2847,9 @@ implementation
end
else
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_W,R_AX)));
+ { this is also false !!!
+ if not(R_EAX in unused) then
+ exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_EAX,R_EDI)));}
if not(R_EAX in unused) then
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_EDI,R_EAX)));
end;
@@ -3318,9 +3322,11 @@ implementation
internalerror(25000);
end;
- { exported methods should be never called direct }
+ { exported methods should be never called direct.
+ Why? Bp7 Allows it (PFV)
+
if (p^.procdefinition^.options and poexports)<>0 then
- Message(cg_e_dont_call_exported_direct);
+ Message(cg_e_dont_call_exported_direct); }
if (not inlined) and ((pushedparasize mod 4)<>0) then
begin
@@ -3620,7 +3626,8 @@ implementation
if inlined then
ungetpersistanttemp(inlinecode^.retoffset,4);
disposetree(params);
-
+
+
{ from now on the result can be freed normally }
if inlined and ret_in_param(p^.resulttype) then
persistanttemptonormal(funcretref.offset);
@@ -5060,7 +5067,8 @@ implementation
secondpass(p^.left);
end;
-
+
+
procedure second_while_repeatn(var p : ptree);
var
@@ -6362,7 +6370,10 @@ do_jmp:
end.
{
$Log$
- Revision 1.24 1998-05-20 09:42:33 pierre
+ Revision 1.25 1998-05-21 19:33:31 peter
+ + better procedure directive handling and only one table
+
+ Revision 1.24 1998/05/20 09:42:33 pierre
+ UseTokenInfo now default
* unit in interface uses and implementation uses gives error now
* only one error for unknown symbol (uses lastsymknown boolean)
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 9985fadfee..de1e5f90ed 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -1373,10 +1373,18 @@ unit pexpr;
begin
pd:=cfiledef;
consume(_FILE);
- consume(LKLAMMER);
- p1:=comp_expr(true);
- consume(RKLAMMER);
- p1:=gentypeconvnode(p1,pd);
+ if token=LKLAMMER then
+ begin
+ consume(LKLAMMER);
+ p1:=comp_expr(true);
+ consume(RKLAMMER);
+ p1:=gentypeconvnode(p1,pd);
+ end
+ else
+ begin
+ p1:=genzeronode(typen);
+ p1^.resulttype:=pd;
+ end;
p1^.explizit:=true;
{ handle postfix operators here e.g. string(a)[10] }
again:=true;
@@ -1715,7 +1723,10 @@ unit pexpr;
end.
{
$Log$
- Revision 1.15 1998-05-20 09:42:35 pierre
+ Revision 1.16 1998-05-21 19:33:32 peter
+ + better procedure directive handling and only one table
+
+ Revision 1.15 1998/05/20 09:42:35 pierre
+ UseTokenInfo now default
* unit in interface uses and implementation uses gives error now
* only one error for unknown symbol (uses lastsymknown boolean)
diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas
index 7c1ca6d34f..8ba3fa3d71 100644
--- a/compiler/pstatmnt.pas
+++ b/compiler/pstatmnt.pas
@@ -1114,12 +1114,18 @@ unit pstatmnt;
dec(procinfo.call_offset,sizeof(pointer));
end;
assembler_block:=_asm_statement;
+ { becuase the END is already read we need to get the
+ last_endtoken_filepos here (PFV) }
+ last_endtoken_filepos:=tokenpos;
end;
end.
{
$Log$
- Revision 1.11 1998-05-20 09:42:35 pierre
+ Revision 1.12 1998-05-21 19:33:33 peter
+ + better procedure directive handling and only one table
+
+ Revision 1.11 1998/05/20 09:42:35 pierre
+ UseTokenInfo now default
* unit in interface uses and implementation uses gives error now
* only one error for unknown symbol (uses lastsymknown boolean)
diff --git a/compiler/switches.pas b/compiler/switches.pas
index 2c50c0591f..c295839706 100644
--- a/compiler/switches.pas
+++ b/compiler/switches.pas
@@ -68,7 +68,7 @@ const
{E} (typesw:programglobal; setsw:cs_fp_emulation; proc:nil),
{F} (typesw:unsupported; setsw:cs_none; proc:nil),
{G} (typesw:unsupported; setsw:cs_none; proc:nil),
- {H} (typesw:illegal; setsw:cs_none; proc:nil),
+ {H} (typesw:unsupported; setsw:cs_none; proc:nil),
{I} (typesw:local; setsw:cs_iocheck; proc:nil),
{J} (typesw:illegal; setsw:cs_none; proc:nil),
{K} (typesw:unsupported; setsw:cs_none; proc:nil),
@@ -158,7 +158,10 @@ end;
end.
{
$Log$
- Revision 1.3 1998-05-01 07:43:56 florian
+ Revision 1.4 1998-05-21 19:33:36 peter
+ + better procedure directive handling and only one table
+
+ Revision 1.3 1998/05/01 07:43:56 florian
+ basics for rtti implemented
+ switch $m (generate rtti for published sections)
@@ -169,4 +172,4 @@ end.
Revision 1.1 1998/04/27 23:13:53 peter
+ the new files for the scanner
-}
\ No newline at end of file
+}
diff --git a/compiler/verb_def.pas b/compiler/verb_def.pas
index eb7f0311dd..37e1cf1355 100644
--- a/compiler/verb_def.pas
+++ b/compiler/verb_def.pas
@@ -27,7 +27,7 @@ uses verbose;
procedure SetRedirectFile(const fn:string);
procedure _stop;
-procedure _comment(Level:Longint;const s:string);
+Function _comment(Level:Longint;const s:string):boolean;
function _internalerror(i : longint) : boolean;
implementation
@@ -88,10 +88,11 @@ begin
end;
-Procedure _comment(Level:Longint;const s:string);
+Function _comment(Level:Longint;const s:string):boolean;
var
hs : string;
begin
+ _comment:=false; { never stop }
if (verbosity and Level)=Level then
begin
{ Status info?, Called every line }
@@ -105,7 +106,6 @@ begin
else
{ Message }
begin
-
hs:='';
if not(use_rhide) then
begin
@@ -151,15 +151,14 @@ begin
else
writeln(hs);
end;
- end;
-
+ end;
end;
end;
function _internalerror(i : longint) : boolean;
begin
- comment(V_Fatal,'Internal error '+tostr(i));
+ _comment(V_Fatal,'Internal error '+tostr(i));
_internalerror:=true;
end;
@@ -177,7 +176,10 @@ begin
end.
{
$Log$
- Revision 1.7 1998-05-12 10:47:01 peter
+ Revision 1.8 1998-05-21 19:33:38 peter
+ + better procedure directive handling and only one table
+
+ Revision 1.7 1998/05/12 10:47:01 peter
* moved printstatus to verb_def
+ V_Normal which is between V_Error and V_Warning and doesn't have a
prefix like error: warning: and is included in V_Default
diff --git a/compiler/verbose.pas b/compiler/verbose.pas
index 9e3a9eb1bc..387dbac96d 100644
--- a/compiler/verbose.pas
+++ b/compiler/verbose.pas
@@ -84,22 +84,12 @@ procedure Message3(w:tmsgconst;const s1,s2,s3:string);
{ Function redirecting for IDE support }
type
- tstopprocedure = procedure;
- tcommentprocedure = procedure(Level:Longint;const s:string);
-{old handlers }
- terrorfunction = function(w:tmsgconst) : boolean;
- tinternalerrorfunction = function(i : longint) : boolean;
+ tstopprocedure = procedure;
+ tcommentfunction = function(Level:Longint;const s:string):boolean;
+ tinternalerrorfunction = function(i:longint):boolean;
var
-{ this procedure is called to stop the compiler }
-{ e.g. this procedure has to restore the state before compiling }
- do_stop : tstopprocedure;
-
-{ called when writing something to the screen, called with the level }
-{ of the comment }
- do_comment : tcommentprocedure;
-
-{ only for compatibility }
- do_note,do_warning,do_error,do_fatalerror : terrorfunction;
+ do_stop : tstopprocedure;
+ do_comment : tcommentfunction;
do_internalerror : tinternalerrorfunction;
@@ -231,12 +221,13 @@ end;
procedure Comment(l:longint;const s:string);
var
- msg : string;
+ dostop : boolean;
begin
- msg:=s;
- Replace(msg,'$VER',version_string);
- Replace(msg,'$TARGET',target_string);
- do_comment(l,msg);
+ dostop:=((l and V_Fatal)<>0);
+ if (l and V_Error)<>0 then
+ inc(errorcount);
+ if do_comment(l,s) or dostop or (errorcount>=maxerrorcount) then
+ stop
end;
@@ -265,7 +256,6 @@ begin
'E' : begin
v:=v or V_Error;
inc(errorcount);
- dostop:=(errorcount>=maxerrorcount);
end;
'O' : v:=v or V_Normal;
'W' : v:=v or V_Warning;
@@ -285,8 +275,9 @@ begin
end;
end;
Delete(s,1,idx);
- Comment(v,s);
- if dostop then
+ Replace(s,'$VER',version_string);
+ Replace(s,'$TARGET',target_string);
+ if do_comment(v,s) or dostop or (errorcount>=maxerrorcount) then
stop;
end;
@@ -323,7 +314,10 @@ end.
{
$Log$
- Revision 1.6 1998-05-12 10:47:01 peter
+ Revision 1.7 1998-05-21 19:33:40 peter
+ + better procedure directive handling and only one table
+
+ Revision 1.6 1998/05/12 10:47:01 peter
* moved printstatus to verb_def
+ V_Normal which is between V_Error and V_Warning and doesn't have a
prefix like error: warning: and is included in V_Default