* memdebug/memory patches (merged)

  * only once illegal directive (merged)

compiler/ag386bin.pas

@@ -826,6 +826,7 @@ unit ag386bin;
       var
         hp : pai;
         startsec : tsection;
+        place: tcutplace;
       begin
         objectalloc^.resetsections;
         objectalloc^.setsection(sec_code);
@@ -897,20 +898,26 @@ unit ag386bin;
            startsec:=objectalloc^.currsec;
 
            { we will start a new objectfile so reset everything }
+           { The place can still change in the next while loop, so don't init }
+           { the writer yet (JM)                                              }
            if (hp^.typ=ait_cut) then
-            objectoutput^.initwriting(pai_cut(hp)^.place)
+            place := pai_cut(hp)^.place
            else
-            objectoutput^.initwriting(cut_normal);
+            place := cut_normal;
 
            { avoid empty files }
            while assigned(hp^.next) and
                  (pai(hp^.next)^.typ in [ait_marker,ait_comment,ait_section,ait_cut]) do
             begin
               if pai(hp^.next)^.typ=ait_section then
-               startsec:=pai_section(hp^.next)^.sec;
+               startsec:=pai_section(hp^.next)^.sec
+              else if (pai(hp^.next)^.typ=ait_cut) then
+               place := pai_cut(hp)^.place;
               hp:=pai(hp^.next);
             end;
 
+           objectoutput^.initwriting(place);
+
            hp:=pai(hp^.next);
 
            { there is a problem if startsec is sec_none !! PM }
@@ -995,7 +1002,11 @@ unit ag386bin;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-04 22:00:50  peter
+  Revision 1.5  2000-08-08 19:28:57  peter
+    * memdebug/memory patches (merged)
+    * only once illegal directive (merged)
+
+  Revision 1.4  2000/08/04 22:00:50  peter
     * merges from fixes
 
   Revision 1.3  2000/07/13 12:08:24  michael

compiler/owar.pas

@@ -51,9 +51,10 @@ type
     symreloc,
     symstr,
     lfnstr,
-    ardata,
-    objdata : PDynamicArray;
-    objfixup : longint;
+    ardata{,
+    objdata }: PDynamicArray;
+    objfixup,
+    objdatasize : longint;
     objfn   : string;
     timestamp : string[12];
     procedure createarhdr(fn:string;size:longint;const gid,uid,mode:string);
@@ -183,21 +184,29 @@ begin
   objfn:=fn;
   objfixup:=ardata^.usedsize;
 { reset size }
-  new(objdata,init(1,objbufsize));
+{  new(objdata,init(1,objbufsize)); }
+  objdatasize := 0;
+  ardata^.seek(ardata^.usedsize + sizeof(tarhdr));
 end;
 
 
 procedure tarobjectwriter.close;
 begin
-  objdata^.align(2);
+  if (objdatasize and 1) <> 0 then
+    begin
+      inc(objdatasize);
+      ardata^.seek(ardata^.usedsize+1);
+    end;
 { fix the size in the header }
-  createarhdr(objfn,objdata^.usedsize,'42','42','644');
+{  createarhdr(objfn,objdata^.usedsize,'42','42','644');}
+  createarhdr(objfn,objdatasize,'42','42','644');
 { write the header }
+  ardata^.seek(objfixup);
   ardata^.write(arhdr,sizeof(tarhdr));
 { write the data of this objfile }
-  ardata^.write(objdata^.data^,objdata^.usedsize);
+{  ardata^.write(objdata^.data^,objdata^.usedsize);}
 { free this object }
-  dispose(objdata,done);
+{  dispose(objdata,done);}
 end;
 
 
@@ -211,7 +220,9 @@ end;
 
 procedure tarobjectwriter.write(var b;len:longint);
 begin
-  objdata^.write(b,len);
+{  objdata^.write(b,len);}
+   ardata^.write(b,len);
+   inc(objdatasize,len);
 end;
 
 
@@ -282,7 +293,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:44  michael
+  Revision 1.3  2000-08-08 19:28:57  peter
+    * memdebug/memory patches (merged)
+    * only once illegal directive (merged)
+
+  Revision 1.2  2000/07/13 11:32:44  michael
   + removed logs
 
 }

compiler/psub.pas

@@ -472,7 +472,10 @@ begin
   if isclassmethod and
      assigned(aktprocsym) then
     include(aktprocsym^.definition^.procoptions,po_classmethod);
-  consume(_SEMICOLON);
+  { support procedure proc;stdcall export; in Delphi mode only }
+  if not((m_delphi in aktmodeswitches) and
+     is_proc_directive(token)) then
+   consume(_SEMICOLON);
   dec(lexlevel);
 end;
 
@@ -2075,7 +2078,11 @@ end.
 
 {
   $Log$
-  Revision 1.6  2000-08-06 19:39:28  peter
+  Revision 1.7  2000-08-08 19:28:57  peter
+    * memdebug/memory patches (merged)
+    * only once illegal directive (merged)
+
+  Revision 1.6  2000/08/06 19:39:28  peter
     * default parameters working !
 
   Revision 1.5  2000/08/06 14:17:15  peter

compiler/scandir.inc

@@ -1364,9 +1364,19 @@ const
                exit;
              end;
           end;
-         Message1(scan_d_handling_switch,'$'+hs);
+         { skip this directive? }
+         if current_scanner^.ignoredirectives.find(hs) then
+          begin
+            if (current_scanner^.comment_level>0) then
+             current_scanner^.readcomment;
+            { we've read the whole comment }
+            aktcommentstyle:=comment_none;
+            exit;
+          end;
          if hs='' then
-          Message1(scan_w_illegal_switch,'$'+hs);
+          begin
+            Message1(scan_w_illegal_switch,'$'+hs);
+          end;
       { Check for compiler switches }
          while (length(hs)=1) and (c in ['-','+']) do
           begin
@@ -1408,7 +1418,10 @@ const
                 p(t);
              end
             else
-             Message1(scan_w_illegal_directive,'$'+hs);
+             begin
+               current_scanner^.ignoredirectives.insert(hs);
+               Message1(scan_w_illegal_directive,'$'+hs);
+             end;
           { conditionals already read the comment }
             if (current_scanner^.comment_level>0) then
              current_scanner^.readcomment;
@@ -1419,7 +1432,11 @@ const
 
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:49  michael
+  Revision 1.3  2000-08-08 19:28:57  peter
+    * memdebug/memory patches (merged)
+    * only once illegal directive (merged)
+
+  Revision 1.2  2000/07/13 11:32:49  michael
   + removed logs
  
 }

compiler/scanner.pas

@@ -84,6 +84,7 @@ unit scanner;
           comment_level,
           yylexcount     : longint;
           lastasmgetchar : char;
+          ignoredirectives : tstringcontainer; { ignore directives, used to give warnings only once }
           preprocstack   : ppreprocstack;
           invalid        : boolean; { flag if sourcefiles have been destroyed ! }
 
@@ -287,6 +288,7 @@ implementation
         lasttoken:=NOTOKEN;
         nexttoken:=NOTOKEN;
         lastasmgetchar:=#0;
+        ignoredirectives.init;
         invalid:=false;
       { load block }
         if not openinputfile then
@@ -315,6 +317,7 @@ implementation
                  closeinputfile;
               end;
           end;
+         ignoredirectives.done;
        end;
 
 
@@ -1834,7 +1837,11 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:49  michael
+  Revision 1.3  2000-08-08 19:28:57  peter
+    * memdebug/memory patches (merged)
+    * only once illegal directive (merged)
+
+  Revision 1.2  2000/07/13 11:32:49  michael
   + removed logs
 
 }

compiler/symdef.inc

@@ -66,6 +66,10 @@
          nextglobal := nil;
       end;
 
+{$ifdef MEMDEBUG}
+   var
+       manglenamesize : longint;
+{$endif}
 
     constructor tdef.load;
       begin
@@ -3089,8 +3093,17 @@ Const local_symtable_index : longint = $8001;
     procedure tprocdef.setmangledname(const s : string);
       begin
          if {$ifdef tp}not(use_big) and{$endif} (assigned(_mangledname)) then
-           strdispose(_mangledname);
+           begin
+{$ifdef MEMDEBUG}
+              dec(manglenamesize,length(_mangledname^));
+{$endif}
+              strdispose(_mangledname);
+           end;
          setstring(_mangledname,s);
+{$ifdef MEMDEBUG}
+         inc(manglenamesize,length(s));
+{$endif}
+{$ifdef EXTDEBUG}
          if assigned(parast) then
            begin
               stringdispose(parast^.name);
@@ -3101,6 +3114,7 @@ Const local_symtable_index : longint = $8001;
               stringdispose(localst^.name);
               localst^.name:=stringdup('locals of '+s);
            end;
+{$endif}
       end;
 
 
@@ -4164,7 +4178,11 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.7  2000-08-06 19:39:28  peter
+  Revision 1.8  2000-08-08 19:28:57  peter
+    * memdebug/memory patches (merged)
+    * only once illegal directive (merged)
+
+  Revision 1.7  2000/08/06 19:39:28  peter
     * default parameters working !
 
   Revision 1.6  2000/08/06 14:17:15  peter

compiler/symtable.pas

@@ -2972,12 +2972,19 @@ implementation
          symbolstream.done;
 {$endif}
 {$endif Delphi}
+{$ifdef MEMDEBUG}
+       writeln('Manglednames: ',manglenamesize,' bytes');
+{$endif}
      end;
 
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:50  michael
+  Revision 1.3  2000-08-08 19:28:57  peter
+    * memdebug/memory patches (merged)
+    * only once illegal directive (merged)
+
+  Revision 1.2  2000/07/13 11:32:50  michael
   + removed logs
 
 }