* regenerated

utils/h2pas/h2pas.pas

@@ -26,11 +26,7 @@ program h2pas;
  ****************************************************************************)
 
    uses
-{$ifdef Delphi}
-     SysUtils,
-{$else Delphi}
-     strings,
-{$endif Delphi}
+     SysUtils,classes,
      options,scan,converu,lexlib,yacclib;
 
    type
@@ -50,13 +46,14 @@ program h2pas;
 
   var
      hp,ph    : presobject;
-     extfile  : text;  (* file for implementation headers extern procs *)
+     implemfile  : text;  (* file for implementation headers extern procs *)
      IsExtern : boolean;
      NeedEllipsisOverload : boolean;
      must_write_packed_field : boolean;
      tempfile : text;
      No_pop   : boolean;
      s,TN,PN  : String;
+     pointerprefix: boolean;
 
 (* $ define yydebug
  compile with -dYYDEBUG to get debugging info *)
@@ -69,6 +66,10 @@ program h2pas;
 
   var space_array : array [0..255] of byte;
       space_index : byte;
+      
+      { Used when PPointers is used - pointer type definitions }
+      PTypeList : TStringList;
+      
 
         procedure shift(space_number : byte);
           var
@@ -206,9 +207,14 @@ program h2pas;
         if RemoveUnderScore and (length(s)>1) and (s[1]='_') then
          i:=2;
         if UsePPointers then
-         PointerName:='P'+Copy(s,i,255)
+        begin
+         PointerName:='P'+Copy(s,i,255);
+         PTypeList.Add(PointerName);
+        end 
         else
          PointerName:=Copy(s,i,255);
+        if PointerPrefix then
+           PTypeList.Add('P'+s);
       end;
 
 
@@ -265,21 +271,21 @@ program h2pas;
                         writeln(outfile,';');
                         popshift;
                         { get function in implementation }
-                        write(extfile,aktspace,'function ',name);
-                        write(extfile,'(var a : ',ph,') : ');
+                        write(implemfile,aktspace,'function ',name);
+                        write(implemfile,'(var a : ',ph,') : ');
                         if not compactmode then
                          shift(2);
-                        write_p_a_def(extfile,hp3^.p1^.p1,hp2^.p1);
-                        writeln(extfile,';');
-                        writeln(extfile,aktspace,'begin');
+                        write_p_a_def(implemfile,hp3^.p1^.p1,hp2^.p1);
+                        writeln(implemfile,';');
+                        writeln(implemfile,aktspace,'begin');
                         shift(3);
-                        write(extfile,aktspace,name,':=(a.flag',flag_index);
-                        writeln(extfile,' and bm_',ph,'_',name,') shr bp_',ph,'_',name,';');
+                        write(implemfile,aktspace,name,':=(a.flag',flag_index);
+                        writeln(implemfile,' and bm_',ph,'_',name,') shr bp_',ph,'_',name,';');
                         popshift;
-                        writeln(extfile,aktspace,'end;');
+                        writeln(implemfile,aktspace,'end;');
                         if not compactmode then
                          popshift;
-                        writeln(extfile,'');
+                        writeln(implemfile,'');
                         { set function in interface }
                         write(outfile,aktspace,'procedure set_',name);
                         write(outfile,'(var a : ',ph,'; __',name,' : ');
@@ -288,22 +294,22 @@ program h2pas;
                         writeln(outfile,');');
                         popshift;
                         { set function in implementation }
-                        write(extfile,aktspace,'procedure set_',name);
-                        write(extfile,'(var a : ',ph,'; __',name,' : ');
+                        write(implemfile,aktspace,'procedure set_',name);
+                        write(implemfile,'(var a : ',ph,'; __',name,' : ');
                         if not compactmode then
                          shift(2);
-                        write_p_a_def(extfile,hp3^.p1^.p1,hp2^.p1);
-                        writeln(extfile,');');
-                        writeln(extfile,aktspace,'begin');
+                        write_p_a_def(implemfile,hp3^.p1^.p1,hp2^.p1);
+                        writeln(implemfile,');');
+                        writeln(implemfile,aktspace,'begin');
                         shift(3);
-                        write(extfile,aktspace,'a.flag',flag_index,':=');
-                        write(extfile,'a.flag',flag_index,' or ');
-                        writeln(extfile,'((__',name,' shl bp_',ph,'_',name,') and bm_',ph,'_',name,');');
+                        write(implemfile,aktspace,'a.flag',flag_index,':=');
+                        write(implemfile,'a.flag',flag_index,' or ');
+                        writeln(implemfile,'((__',name,' shl bp_',ph,'_',name,') and bm_',ph,'_',name,');');
                         popshift;
-                        writeln(extfile,aktspace,'end;');
+                        writeln(implemfile,aktspace,'end;');
                         if not compactmode then
                          popshift;
-                        writeln(extfile,'');
+                        writeln(implemfile,'');
                      end
                    else if is_sized then
                      begin
@@ -531,7 +537,7 @@ program h2pas;
        (* if in args *dname is replaced by pdname *)
        in_args : boolean = false;
        typedef_level : longint = 0;
-
+       
     (* writes an argument list, where p is t_arglist *)
 
     procedure write_args(var outfile:text; p : presobject);
@@ -579,20 +585,26 @@ program h2pas;
               else
                 begin
                    (* generate a call by reference parameter ?       *)
+
+//                   varpara:=usevarparas and
+//                            assigned(p^.p1^.p2^.p1) and
+//                            (p^.p1^.p2^.p1^.typ in [t_addrdef,t_pointerdef]) and
+//                            assigned(p^.p1^.p2^.p1^.p1) and
+//                            (p^.p1^.p2^.p1^.p1^.typ<>t_procdef);
                    varpara:=usevarparas and
-                            assigned(p^.p1^.p2^.p1) and
-                            (p^.p1^.p2^.p1^.typ in [t_addrdef,t_pointerdef]) and
-                            assigned(p^.p1^.p2^.p1^.p1) and
-                            (p^.p1^.p2^.p1^.p1^.typ<>t_procdef);
+                            assigned(p^.p1^.p1) and
+                            (p^.p1^.p1^.typ in [t_addrdef,t_pointerdef]) and
+                            assigned(p^.p1^.p1^.p1) and
+                            (p^.p1^.p1^.p1^.typ<>t_procdef);
                    (* do not do it for char pointer !!               *)
                    (* para : pchar; and var para : char; are         *)
                    (* completely different in pascal                 *)
                    (* here we exclude all typename containing char   *)
                    (* is this a good method ??                       *)
                    if varpara and
-                      (p^.p1^.p2^.p1^.typ=t_pointerdef) and
-                      (p^.p1^.p2^.p1^.p1^.typ=t_id) and
-                      (pos('CHAR',uppercase(p^.p1^.p2^.p1^.p1^.str))<>0) then
+                      (p^.p1^.p1^.typ=t_pointerdef) and
+                      (p^.p1^.p1^.p1^.typ=t_id) and
+                      (pos('CHAR',uppercase(p^.p1^.p1^.p1^.str))<>0) then
                      varpara:=false;
                    if varpara then
                      begin
@@ -621,8 +633,10 @@ program h2pas;
                          end;
                      end;
                    write(outfile,':');
-                   if varpara then
-                     write_p_a_def(outfile,p^.p1^.p2^.p1^.p1,p^.p1^.p1)
+                   if varpara then 
+                   begin
+                     write_p_a_def(outfile,p^.p1^.p2^.p1,p^.p1^.p1^.p1);
+                   end
                    else
                      write_p_a_def(outfile,p^.p1^.p2^.p1,p^.p1^.p1);
 
@@ -646,6 +660,8 @@ program h2pas;
          in_args:=old_in_args;
          popshift;
       end;
+       
+
 
     procedure write_p_a_def(var outfile:text; p,simple_type : presobject);
       var
@@ -720,10 +736,14 @@ program h2pas;
                                       if not pointerwritten then
                                        begin
                                          if in_args then
-                                          write(outfile,'P')
+                                         begin
+                                          write(outfile,'P');
+                                          pointerprefix:=true;
+                                         end 
                                          else
                                           write(outfile,'^');
                                          write_p_a_def(outfile,p^.p1,simple_type);
+                                         pointerprefix:=false;
                                        end;
                                      end;
                                 end;
@@ -780,6 +800,8 @@ program h2pas;
          case p^.typ of
             t_id :
               begin
+                if pointerprefix then
+                   PTypeList.Add('P'+p^.str);
                 if p^.intname then
                  write(outfile,p^.p)
                 else
@@ -815,10 +837,14 @@ program h2pas;
                  if not pointerwritten then
                   begin
                     if in_args then
-                     write(outfile,'P')
+                    begin
+                     write(outfile,'P');
+                     pointerprefix:=true;
+                    end 
                     else
                      write(outfile,'^');
                     write_type_specifier(outfile,p^.p1);
+                    pointerprefix:=false;
                   end;
               end;
             t_enumdef :
@@ -826,6 +852,8 @@ program h2pas;
                  if (typedef_level>1) and (p^.p1=nil) and
                     (p^.p2^.typ=t_id) then
                    begin
+                      if pointerprefix then
+                        PTypeList.Add('P'+p^.p2^.str);
                       write(outfile,p^.p2^.p);
                    end
                  else
@@ -914,11 +942,16 @@ program h2pas;
                  if ((in_args) or (typedef_level>1)) and
                     (p^.p1=nil) and (p^.p2^.typ=t_id) then
                    begin
+                      if pointerprefix then
+                        PTypeList.Add('P'+p^.p2^.str);
                      write(outfile,TypeName(p^.p2^.p));
                    end
                  else
                    begin
-                      writeln(outfile,'record');
+                      if packrecords then
+                        writeln(outfile,'packed record')
+                      else
+                        writeln(outfile,'record');
                       shift(3);
                       hp1:=p^.p1;
 
@@ -1046,7 +1079,10 @@ program h2pas;
                  else
                    begin
                       inc(typedef_level);
-                      writeln(outfile,'record');
+                      if packrecords then
+                        writeln(outfile,'packed record')
+                      else
+                        writeln(outfile,'record');
                       shift(2);
                       writeln(outfile,aktspace,'case longint of');
                       shift(3);
@@ -1286,7 +1322,7 @@ begin
          begin
          write(outfile,aktspace);
          if not IsExtern then
-         write(extfile,aktspace);
+         write(implemfile,aktspace);
          end;
          (* distinguish between procedure and function *)
          if assigned(yyv[yysp-4]) then
@@ -1298,9 +1334,9 @@ begin
          write_args(outfile,yyv[yysp-2]^.p1^.p1^.p2);
          if not IsExtern then
          begin
-         write(extfile,'procedure ',yyv[yysp-2]^.p1^.p2^.p);
+         write(implemfile,'procedure ',yyv[yysp-2]^.p1^.p2^.p);
          if assigned(yyv[yysp-2]^.p1^.p1^.p2) then
-         write_args(extfile,yyv[yysp-2]^.p1^.p1^.p2);
+         write_args(implemfile,yyv[yysp-2]^.p1^.p1^.p2);
          end;
          end
          else
@@ -1313,11 +1349,11 @@ begin
          write_p_a_def(outfile,yyv[yysp-2]^.p1^.p1^.p1,yyv[yysp-4]);
          if not IsExtern then
          begin
-         write(extfile,'function ',yyv[yysp-2]^.p1^.p2^.p);
+         write(implemfile,'function ',yyv[yysp-2]^.p1^.p2^.p);
          if assigned(yyv[yysp-2]^.p1^.p1^.p2) then
-         write_args(extfile,yyv[yysp-2]^.p1^.p1^.p2);
-         write(extfile,':');
-         write_p_a_def(extfile,yyv[yysp-2]^.p1^.p1^.p1,yyv[yysp-4]);
+         write_args(implemfile,yyv[yysp-2]^.p1^.p1^.p2);
+         write(implemfile,':');
+         write_p_a_def(implemfile,yyv[yysp-2]^.p1^.p1^.p1,yyv[yysp-4]);
          end;
          end;
          if assigned(yyv[yysp-1]) then
@@ -1341,10 +1377,10 @@ begin
          writeln(outfile,';');
          if not IsExtern then
          begin
-         writeln(extfile,';');
-         writeln(extfile,aktspace,'begin');
-         writeln(extfile,aktspace,'  { You must implemented this function }');
-         writeln(extfile,aktspace,'end;');
+         writeln(implemfile,';');
+         writeln(implemfile,aktspace,'begin');
+         writeln(implemfile,aktspace,'  { You must implement this function }');
+         writeln(implemfile,aktspace,'end;');
          end;
          end;
          IsExtern:=false;
@@ -1437,6 +1473,9 @@ begin
          TN:=TypeName(yyv[yysp-1]^.str);
          PN:=PointerName(yyv[yysp-1]^.str);
          if UsePPointers then writeln(outfile,aktspace,PN,' = ^',TN,';');
+         if PackRecords then
+         writeln(outfile, aktspace, TN, ' = packed record')
+         else
          writeln(outfile, aktspace, TN, ' = record');
          writeln(outfile, aktspace, '    {undefined structure}');
          writeln(outfile, aktspace, '  end;');
@@ -1630,39 +1669,39 @@ begin
          if not stripinfo then
          begin
          writeln (outfile,aktspace,'{ was #define dname(params) para_def_expr }');
-         writeln (extfile,aktspace,'{ was #define dname(params) para_def_expr }');
+         writeln (implemfile,aktspace,'{ was #define dname(params) para_def_expr }');
          if assigned(yyv[yysp-3]) then
          begin
          writeln (outfile,aktspace,'{ argument types are unknown }');
-         writeln (extfile,aktspace,'{ argument types are unknown }');
+         writeln (implemfile,aktspace,'{ argument types are unknown }');
          end;
          if not assigned(yyv[yysp-1]^.p3) then
          begin
          writeln(outfile,aktspace,'{ return type might be wrong }   ');
-         writeln(extfile,aktspace,'{ return type might be wrong }   ');
+         writeln(implemfile,aktspace,'{ return type might be wrong }   ');
          end;
          end;
          block_type:=bt_func;
          write(outfile,aktspace,'function ',yyv[yysp-5]^.p);
-         write(extfile,aktspace,'function ',yyv[yysp-5]^.p);
+         write(implemfile,aktspace,'function ',yyv[yysp-5]^.p);
          
          if assigned(yyv[yysp-3]) then
          begin
          write(outfile,'(');
-         write(extfile,'(');
+         write(implemfile,'(');
          ph:=new(presobject,init_one(t_enumdef,yyv[yysp-3]));
          write_def_params(outfile,ph);
-         write_def_params(extfile,ph);
+         write_def_params(implemfile,ph);
          if assigned(ph) then dispose(ph,done);
          ph:=nil;
          (* types are unknown *)
          write(outfile,' : longint)');
-         write(extfile,' : longint)');
+         write(implemfile,' : longint)');
          end;
          if not assigned(yyv[yysp-1]^.p3) then
          begin
          writeln(outfile,' : longint;',aktspace,commentstr);
-         writeln(extfile,' : longint;');
+         writeln(implemfile,' : longint;');
          flush(outfile);
          end
          else
@@ -1671,16 +1710,16 @@ begin
          write_type_specifier(outfile,yyv[yysp-1]^.p3);
          writeln(outfile,';',aktspace,commentstr);
          flush(outfile);
-         write(extfile,' : ');
-         write_type_specifier(extfile,yyv[yysp-1]^.p3);
-         writeln(extfile,';');
+         write(implemfile,' : ');
+         write_type_specifier(implemfile,yyv[yysp-1]^.p3);
+         writeln(implemfile,';');
          end;
          writeln(outfile);
          flush(outfile);
          hp:=new(presobject,init_two(t_funcname,yyv[yysp-5],yyv[yysp-1]));
-         write_funexpr(extfile,hp);
-         writeln(extfile);
-         flush(extfile);
+         write_funexpr(implemfile,hp);
+         writeln(implemfile);
+         flush(implemfile);
          if assigned(hp)then dispose(hp,done);
          
        end;
@@ -1731,19 +1770,19 @@ begin
          if not stripinfo then
          begin
          writeln (outfile,aktspace,'{ was #define dname def_expr }');
-         writeln (extfile,aktspace,'{ was #define dname def_expr }');
+         writeln (implemfile,aktspace,'{ was #define dname def_expr }');
          end;
          block_type:=bt_func;
          write(outfile,aktspace,'function ',yyv[yysp-3]^.p);
-         write(extfile,aktspace,'function ',yyv[yysp-3]^.p);
+         write(implemfile,aktspace,'function ',yyv[yysp-3]^.p);
          shift(2);
          if not assigned(yyv[yysp-1]^.p3) then
          begin
          writeln(outfile,' : longint;');
          writeln(outfile,aktspace,'  { return type might be wrong }');
          flush(outfile);
-         writeln(extfile,' : longint;');
-         writeln(extfile,aktspace,'  { return type might be wrong }');
+         writeln(implemfile,' : longint;');
+         writeln(implemfile,aktspace,'  { return type might be wrong }');
          end
          else
          begin
@@ -1751,18 +1790,18 @@ begin
          write_type_specifier(outfile,yyv[yysp-1]^.p3);
          writeln(outfile,';',aktspace,commentstr);
          flush(outfile);
-         write(extfile,' : ');
-         write_type_specifier(extfile,yyv[yysp-1]^.p3);
-         writeln(extfile,';');
+         write(implemfile,' : ');
+         write_type_specifier(implemfile,yyv[yysp-1]^.p3);
+         writeln(implemfile,';');
          end;
          writeln(outfile);
          flush(outfile);
          hp:=new(presobject,init_two(t_funcname,yyv[yysp-3],yyv[yysp-1]));
-         write_funexpr(extfile,hp);
+         write_funexpr(implemfile,hp);
          popshift;
          dispose(hp,done);
-         writeln(extfile);
-         flush(extfile);
+         writeln(implemfile);
+         flush(implemfile);
          end;
          
        end;
@@ -1798,7 +1837,7 @@ begin
        end;
   37 : begin
          
-         if not is_packed then
+         if (not is_packed) and (not packrecords) then
          writeln(outfile,'{$PACKRECORDS 1}');
          is_packed:=true;
          yyval:=new(presobject,init_two(t_structdef,yyv[yysp-1],yyv[yysp-2]));
@@ -1806,7 +1845,7 @@ begin
        end;
   38 : begin
          
-         if is_packed then
+         if (is_packed) and (not packrecords) then
          writeln(outfile,'{$PACKRECORDS 4}');
          is_packed:=false;
          yyval:=new(presobject,init_two(t_structdef,yyv[yysp-0],yyv[yysp-1]));
@@ -1814,7 +1853,7 @@ begin
        end;
   39 : begin
          
-         if not is_packed then
+         if (not is_packed) and (not packrecords) then
          writeln(outfile,'{$PACKRECORDS 1}');
          is_packed:=true;
          yyval:=new(presobject,init_two(t_uniondef,yyv[yysp-1],yyv[yysp-2]));
@@ -1854,7 +1893,7 @@ begin
        end;
   46 : begin
          
-         if not is_packed then
+         if (not is_packed) and (not packrecords)then
          writeln(outfile,'{$PACKRECORDS 1}');
          is_packed:=true;
          yyval:=new(presobject,init_one(t_uniondef,yyv[yysp-1]));
@@ -1867,7 +1906,7 @@ begin
        end;
   48 : begin
          
-         if not is_packed then
+         if (not is_packed) and (not packrecords) then
          writeln(outfile,'{$PACKRECORDS 1}');
          is_packed:=true;
          yyval:=new(presobject,init_one(t_structdef,yyv[yysp-1]));
@@ -1875,7 +1914,7 @@ begin
        end;
   49 : begin
          
-         if is_packed then
+         if (is_packed) and (not packrecords) then
          writeln(outfile,'{$PACKRECORDS 4}');
          is_packed:=false;
          yyval:=new(presobject,init_one(t_structdef,yyv[yysp-0]));
@@ -2062,6 +2101,7 @@ begin
        end;
   77 : begin
          
+         (* type_specifier STAR declarator *)
          hp:=new(presobject,init_one(t_pointerdef,yyv[yysp-2]));
          yyval:=new(presobject,init_two(t_arg,hp,yyv[yysp-0]));
          
@@ -7800,12 +7840,71 @@ begin
   line_no:=yylineno;
 end;
 
+procedure WriteFileHeader(var headerfile: Text);
+var
+ i: integer;
+ originalstr: string;
+begin
+{ write unit header }
+  if not includefile then
+   begin
+     writeln(headerfile,'unit ',unitname,';');
+     writeln(headerfile,'interface');
+     writeln(headerfile);
+     writeln(headerfile,'{');
+     writeln(headerfile,'  Automatically converted by H2Pas ',version,' from ',inputfilename);
+     writeln(headerfile,'  The following command line parameters were used:');
+     for i:=1 to paramcount do
+       writeln(headerfile,'    ',paramstr(i));
+     writeln(headerfile,'}');
+     writeln(headerfile);
+   end;
+  if UseName then
+   begin
+     writeln(headerfile,aktspace,'const');
+     writeln(headerfile,aktspace,'  External_library=''',libfilename,'''; {Setup as you need}');
+     writeln(headerfile);
+   end;
+  if UsePPointers then
+   begin
+     Writeln(headerfile,aktspace,'{ Pointers to basic pascal types, inserted by h2pas conversion program.}');
+     Writeln(headerfile,aktspace,'Type');
+     Writeln(headerfile,aktspace,'  PLongint  = ^Longint;');
+     Writeln(headerfile,aktspace,'  PSmallInt = ^SmallInt;');
+     Writeln(headerfile,aktspace,'  PByte     = ^Byte;');
+     Writeln(headerfile,aktspace,'  PWord     = ^Word;');
+     Writeln(headerfile,aktspace,'  PDWord    = ^DWord;');
+     Writeln(headerfile,aktspace,'  PDouble   = ^Double;');
+     Writeln(headerfile);
+   end;
+  if PTypeList.count <> 0 then 
+   Writeln(headerfile,aktspace,'Type');
+  for i:=0 to (PTypeList.Count-1) do
+   begin
+     originalstr:=copy(PTypelist[i],2,length(PTypeList[i]));
+     Writeln(headerfile,aktspace,PTypeList[i],'  = ^',originalstr,';');
+   end;
+  if not packrecords then
+   begin
+      writeln(headerfile,'{$IFDEF FPC}');
+      writeln(headerfile,'{$PACKRECORDS C}');
+      writeln(headerfile,'{$ENDIF}');
+   end;   
+  writeln(headerfile);
+end;
+
 
 var
   SS : string;
   i : longint;
+  headerfile: Text;
+  finaloutfile: Text;
 begin
+  pointerprefix:=false;
 { Initialize }
+  PTypeList:=TStringList.Create;
+  PTypeList.Sorted := true;
+  PTypeList.Duplicates := dupIgnore;
   yydebug:=true;
   aktspace:='';
   block_type:=bt_no;
@@ -7824,54 +7923,21 @@ begin
      writeln('file ',inputfilename,' not found!');
      halt(1);
    end;
-  assign(outfile, outputfilename);
+  { This is the intermediate output file } 
+  assign(outfile, 'ext3.tmp');
   {$I-}
   rewrite(outfile);
   {$I+}
   if ioresult<>0 then
    begin
-     writeln('file ',outputfilename,' could not be created!');
+     writeln('file ext3.tmp could not be created!');
      halt(1);
    end;
-{ write unit header }
-  if not includefile then
-   begin
-     writeln(outfile,'unit ',unitname,';');
-     writeln(outfile,'interface');
-     writeln(outfile);
-     writeln(outfile,'{');
-     writeln(outfile,'  Automatically converted by H2Pas ',version,' from ',inputfilename);
-     writeln(outfile,'  The following command line parameters were used:');
-     for i:=1 to paramcount do
-       writeln(outfile,'    ',paramstr(i));
-     writeln(outfile,'}');
-     writeln(outfile);
-   end;
-  if UseName then
-   begin
-     writeln(outfile,aktspace,'const');
-     writeln(outfile,aktspace,'  External_library=''',libfilename,'''; {Setup as you need}');
-     writeln(outfile);
-   end;
-  if UsePPointers then
-   begin
-     Writeln(outfile,aktspace,'{ Pointers to basic pascal types, inserted by h2pas conversion program.}');
-     Writeln(outfile,aktspace,'Type');
-     Writeln(outfile,aktspace,'  PLongint  = ^Longint;');
-     Writeln(outfile,aktspace,'  PSmallInt = ^SmallInt;');
-     Writeln(outfile,aktspace,'  PByte     = ^Byte;');
-     Writeln(outfile,aktspace,'  PWord     = ^Word;');
-     Writeln(outfile,aktspace,'  PDWord    = ^DWord;');
-     Writeln(outfile,aktspace,'  PDouble   = ^Double;');
-     Writeln(outfile);
-   end;
-  writeln(outfile,'{$IFDEF FPC}');
-  writeln(outfile,'{$PACKRECORDS C}');
-  writeln(outfile,'{$ENDIF}');
   writeln(outfile);
 { Open tempfiles }
-  Assign(extfile,'ext.tmp');
-  rewrite(extfile);
+  { This is where the implementation section of the unit shall be stored }
+  Assign(implemfile,'ext.tmp');
+  rewrite(implemfile);
   Assign(tempfile,'ext2.tmp');
   rewrite(tempfile);
 { Parse! }
@@ -7884,10 +7950,10 @@ begin
       writeln(outfile);
     end;
    { here we have a problem if a line is longer than 255 chars !! }
-   reset(extfile);
-   while not eof(extfile) do
+   reset(implemfile);
+   while not eof(implemfile) do
     begin
-      readln(extfile,SS);
+      readln(implemfile,SS);
       writeln(outfile,SS);
     end;
    { write end of file }
@@ -7895,17 +7961,68 @@ begin
    if not(includefile) then
      writeln(outfile,'end.');
    { close and erase tempfiles }
-   close(extfile);
-   erase(extfile);
-   close(outfile);
-   close(tempfile);
-   erase(tempfile);
+  close(implemfile);
+  erase(implemfile);
+  close(tempfile);
+  erase(tempfile);
+  flush(outfile);
+   
+  {**** generate full file ****}
+  assign(headerfile, 'ext4.tmp');
+  {$I-}
+  rewrite(headerfile);
+  {$I+}
+  if ioresult<>0 then
+    begin
+      writeln('file ext4.tmp could not be created!');
+      halt(1);
+  end;
+  WriteFileHeader(HeaderFile);
+   
+  { Final output filename } 
+  assign(finaloutfile, outputfilename);
+  {$I-}
+  rewrite(finaloutfile);
+  {$I+}
+  if ioresult<>0 then
+  begin
+     writeln('file ',outputfilename,' could not be created!');
+     halt(1);
+  end;
+  writeln(finaloutfile);
+  
+  { Read unit header file }
+  reset(headerfile);
+  while not eof(headerfile) do
+    begin
+      readln(headerfile,SS);
+      writeln(finaloutfile,SS);
+    end;
+  { Read interface and implementation file }
+  reset(outfile);
+  while not eof(outfile) do
+    begin
+      readln(outfile,SS);
+      writeln(finaloutfile,SS);
+    end;
+   
+  close(HeaderFile);
+  close(outfile);
+  close(finaloutfile);
+  erase(outfile);
+  erase(headerfile);
+   
+  PTypeList.Free;
 end.
 
 {
   $Log$
-  Revision 1.12  2004-08-18 19:18:18  peter
-    * recommit to get newer timestamp
+  Revision 1.13  2004-09-15 19:16:38  hajny
+    * regenerated
+
+  Revision 1.9  2004/09/08 22:21:41  carl
+    + support for creating packed records
+    * var parameter bugfixes
 
   Revision 1.8  2004/08/13 02:35:29  carl
     + bugfixes with C++ comments, they are now placed above the definition