+ better procedure directive handling and only one table

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)

compiler/pexpr.pas

@@ -1373,10 +1373,18 @@ unit pexpr;
               begin
                  pd:=cfiledef;
                  consume(_FILE);
-                 consume(LKLAMMER);
+                 if token=LKLAMMER then
-                 p1:=comp_expr(true);
+                  begin
-                 consume(RKLAMMER);
+                    consume(LKLAMMER);
-                 p1:=gentypeconvnode(p1,pd);
+                    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)

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)

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

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

compiler/verbose.pas

@@ -84,22 +84,12 @@ procedure Message3(w:tmsgconst;const s1,s2,s3:string);
 
 { Function redirecting for IDE support }
 type
-  tstopprocedure = procedure;
+  tstopprocedure         = procedure;
-  tcommentprocedure = procedure(Level:Longint;const s:string);
+  tcommentfunction       = function(Level:Longint;const s:string):boolean;
-{old handlers }
+  tinternalerrorfunction = function(i:longint):boolean;
-  terrorfunction = function(w:tmsgconst) : boolean;
-  tinternalerrorfunction = function(i : longint) : boolean;
 var
-{ this procedure is called to stop the compiler                 }
+  do_stop          : tstopprocedure;
-{ e.g. this procedure has to restore the state before compiling }
+  do_comment       : tcommentfunction;
-  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_internalerror : tinternalerrorfunction;
 
 
@@ -231,12 +221,13 @@ end;
 
 procedure Comment(l:longint;const s:string);
 var
-  msg : string;
+  dostop : boolean;
 begin
-  msg:=s;
+  dostop:=((l and V_Fatal)<>0);
-  Replace(msg,'$VER',version_string);
+  if (l and V_Error)<>0 then
-  Replace(msg,'$TARGET',target_string);
+   inc(errorcount);
-  do_comment(l,msg);
+  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);
+  Replace(s,'$VER',version_string);
-  if dostop then
+  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