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

+ better procedure directive handling and only one table

Browse Source
This commit is contained in:
peter 1998-05-21 19:33:31 +00:00
parent eb39182b3b
commit 994d0eb578
6 changed files with 73 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
compiler/cgi386.pas
View File

@ -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)

21
compiler/pexpr.pas
View File

@ -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)

8
compiler/pstatmnt.pas
View File

@ -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)

9
compiler/switches.pas
View File

@ -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
}
}

16
compiler/verb_def.pas
View File

@ -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

42
compiler/verbose.pas
View File

@ -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