Merged revisions 10997,11000,11032-11033,11042,11044,11046,11053,11060,11062,11064,11067,11075,11078,11080,11085,11089,11094,11096,11098,11103-11104,11106,11108-11109,11111,11114,11117,11122,11124,11126,11130-11131,11133,11136,11139-11141,11146-11147,11152-11154,11157,11159,11166-11167,11170,11173,11178,11181-11182,11184-11185,11187-11189,11195-11196,11206-11210,11214-11215,11223,11225,11227,11232,11235,11239-11240,11249-11256,11258,11260,11264-11265,11271,11278,11280-11282,11286-11288,11292-11294,11297,11299-11300,11302,11304-11311,11313,11315-11316,11318-11319,11324-11326,11328-11333,11335-11336,11339-11340,11346-11347,11349,11362,11369,11371-11375,11393-11396,11401,11411-11414,11420,11422,11427-11428,11465,11469-11470,11487-11488,11490,11497 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r10997 | florian | 2008-05-18 12:42:32 +0200 (Sun, 18 May 2008) | 2 lines
  
  * don't override IDE switches at compiler startup
........
  r11210 | florian | 2008-06-07 12:41:42 +0200 (Sat, 07 Jun 2008) | 1 line
  
  * better support of float, resolves #11426
........
  r11497 | florian | 2008-08-01 17:27:58 +0200 (Fri, 01 Aug 2008) | 1 line
  
  * proper support for tobject.getinterface with raw/corba interfaces, resolves #6798 and #6036
........

git-svn-id: branches/fixes_2_2@12076 -

.gitattributes

@@ -7835,6 +7835,7 @@ tests/webtbf/tw4893e.pp svneol=native#text/plain
 tests/webtbf/tw4911.pp svneol=native#text/plain
 tests/webtbf/tw4913.pp -text
 tests/webtbf/tw5896a.pp svneol=native#text/plain
+tests/webtbf/tw6036b.pp svneol=native#text/plain
 tests/webtbf/tw6420.pp svneol=native#text/plain
 tests/webtbf/tw6631.pp svneol=native#text/plain
 tests/webtbf/tw6686.pp svneol=native#text/plain
@@ -8736,6 +8737,8 @@ tests/webtbs/tw5100a.pp svneol=native#text/plain
 tests/webtbs/tw5641.pp svneol=native#text/plain
 tests/webtbs/tw5800.pp svneol=native#text/plain
 tests/webtbs/tw5896.pp svneol=native#text/plain
+tests/webtbs/tw6036.pp svneol=native#text/plain
+tests/webtbs/tw6036a.pp svneol=native#text/plain
 tests/webtbs/tw6129.pp svneol=native#text/plain
 tests/webtbs/tw6184.pp svneol=native#text/plain
 tests/webtbs/tw6203.pp svneol=native#text/plain

compiler/defcmp.pas

@@ -489,6 +489,15 @@ implementation
                            end;
                        end;
                    end;
+                 objectdef :
+                   begin
+                     { corba interface -> id string }
+                     if is_interfacecorba(def_from) then
+                      begin
+                        doconv:=tc_intf_2_string;
+                        eq:=te_convert_l1;
+                      end;
+                   end;
                end;
              end;
 
@@ -1354,8 +1363,8 @@ implementation
            recorddef :
              begin
                { interface -> guid }
-               if is_interface(def_from) and
-                  (def_to=rec_tguid) then
+               if (def_to=rec_tguid) and
+                  (is_interfacecom(def_from) or is_dispinterface(def_from)) then
                 begin
                   doconv:=tc_intf_2_guid;
                   eq:=te_convert_l1;

compiler/ncnv.pas

@@ -73,6 +73,7 @@ interface
           function typecheck_arrayconstructor_to_set : tnode;
           function typecheck_set_to_set : tnode;
           function typecheck_pchar_to_string : tnode;
+          function typecheck_interface_to_string : tnode;
           function typecheck_interface_to_guid : tnode;
           function typecheck_dynarray_to_openarray : tnode;
           function typecheck_pwchar_to_string : tnode;
@@ -1338,6 +1339,18 @@ implementation
       end;
 
 
+    function ttypeconvnode.typecheck_interface_to_string : tnode;
+      begin
+        if assigned(tobjectdef(left.resultdef).iidstr) then
+          begin
+            if not(oo_has_valid_guid in tobjectdef(left.resultdef).objectoptions) then
+              CGMessage1(type_interface_has_no_guid,tobjectdef(left.resultdef).typename);
+            result:=cstringconstnode.createstr(tobjectdef(left.resultdef).iidstr^);
+            tstringconstnode(result).changestringtype(cshortstringtype);
+          end;
+      end;
+
+
     function ttypeconvnode.typecheck_interface_to_guid : tnode;
       begin
         if assigned(tobjectdef(left.resultdef).iidguid) then
@@ -1605,7 +1618,7 @@ implementation
           { arrayconstructor_2_set } @ttypeconvnode.typecheck_arrayconstructor_to_set,
           { set_to_set } @ttypeconvnode.typecheck_set_to_set,
           { cord_2_pointer } @ttypeconvnode.typecheck_cord_to_pointer,
-          { intf_2_string } nil,
+          { intf_2_string } @ttypeconvnode.typecheck_interface_to_string,
           { intf_2_guid } @ttypeconvnode.typecheck_interface_to_guid,
           { class_2_intf } nil,
           { char_2_char } @ttypeconvnode.typecheck_char_to_char,

ide/fp.pas

@@ -73,7 +73,7 @@ uses
   FPTemplt,FPRedir,FPDesk,
   FPCodTmp,FPCodCmp,
 
-  systems;
+  systems,globtype,globals;
 
 
 Const
@@ -317,6 +317,15 @@ begin
 {$ENDIF}
 end;
 
+
+procedure InitCompilerSwitches;
+  begin
+    default_settings.globalswitches:=[cs_check_unit_name];
+    default_settings.moduleswitches:=[cs_extsyntax,cs_implicit_exceptions];
+    default_settings.localswitches:=[cs_typed_const_writable];
+  end;
+
+
 {The square bullet needs an MS-DOS code page. On Unix it is for sure the code
  page is not available before video is initialized. (And only in certain
  circumstances after that, so, use a plain ascii character as bullet on Unix.)}
@@ -362,6 +371,8 @@ BEGIN
   if LocateFile(INIFileName)<>'' then
     writeln(bullet+' Using configuration files from: ',DirOf(LocateFile(INIFileName)));
 
+  InitCompilerSwitches;
+
 {$ifdef VESA}
   InitVESAScreenModes;
 {$endif}

ide/fpswitch.pas

@@ -1407,12 +1407,12 @@ begin
   for i:=low(TSwitchMode) to high(TSwitchMode) do
     begin
        SwitchesMode:=i;
-{$ifdef i386}
+
        { default is Pentium }
        ProcessorOptimizationSwitches^.SetCurrSel(1);
        { AT&T reader }
        AsmReaderSwitches^.SetCurrSel(1);
-{$endif i386}
+
        { FPC mode}
        CompilerModeSwitches^.SetCurrSel(0);
 (* Use platform defaults for memory switches. *)

rtl/inc/objpas.inc

@@ -634,6 +634,43 @@
             IInterface(obj)._AddRef;
         end;
 
+      function getcorbainterfacebyentry(Instance: pointer; IEntry: pinterfaceentry; out obj): boolean;
+        var
+          Getter: function: IInterface of object;
+        begin
+          Pointer(Obj) := nil;
+          if Assigned(IEntry) and Assigned(Instance) then
+          begin
+            case IEntry^.IType of
+              etStandard:
+                begin
+                  //writeln('Doing etStandard cast of ', TObject(Instance).classname(), ' with self = ', ptruint(Instance), ' and offset = ', IEntry^.IOffset);
+                  Pbyte(Obj):=Pbyte(instance)+IEntry^.IOffset;
+                end;
+              etFieldValue:
+                begin
+                  //writeln('Doing etFieldValue cast of ', TObject(Instance).classname(), ' with offset = ', IEntry^.IOffset);
+                  Pointer(obj) := ppointer(Pbyte(Instance)+IEntry^.IOffset)^;
+                end;
+              etVirtualMethodResult:
+                begin
+                  //writeln('Doing etVirtualMethodResult cast of ', TObject(Instance).classname());
+                  TMethod(Getter).data := Instance;
+                  TMethod(Getter).code := ppointer(Pbyte(Instance) + IEntry^.IOffset)^;
+                  Pointer(obj) := Pointer(Getter());
+                end;
+              etStaticMethodResult:
+                begin
+                  //writeln('Doing etStaticMethodResult cast of ', TObject(Instance).classname());
+                  TMethod(Getter).data := Instance;
+                  TMethod(Getter).code := pointer(IEntry^.IOffset);
+                  Pointer(obj) := Pointer(Getter());
+                end;
+            end;
+          end;
+          result := assigned(pointer(obj));
+        end;
+
       function TObject.getinterface(const iid : tguid;out obj) : boolean;
         begin
           Result := getinterfacebyentry(self, getinterfaceentry(iid), obj);
@@ -641,7 +678,12 @@
 
       function TObject.getinterfacebystr(const iidstr : string;out obj) : boolean;
         begin
-          Result := getinterfacebyentry(self, getinterfaceentrybystr(iidstr), obj);
+          Result := getcorbainterfacebyentry(self, getinterfaceentrybystr(iidstr), obj);
+        end;
+
+      function TObject.getinterface(const iidstr : string;out obj) : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
+        begin
+          Result := getinterfacebystr(iidstr,obj);
         end;
 
       class function TObject.getinterfaceentry(const iid : tguid) : pinterfaceentry;

rtl/inc/objpash.inc

@@ -181,6 +181,7 @@
 
           { interface functions }
           function GetInterface(const iid : tguid; out obj) : boolean;
+          function GetInterface(const iidstr : string;out obj) : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
           function GetInterfaceByStr(const iidstr : string; out obj) : boolean;
           class function GetInterfaceEntry(const iid : tguid) : pinterfaceentry;
           class function GetInterfaceEntryByStr(const iidstr : string) : pinterfaceentry;

tests/webtbf/tw6036b.pp

@@ -0,0 +1,11 @@
+{ %fail }
+{$mode objfpc}
+type
+  imyinterface = interface
+  end;
+
+var
+  s : string;
+begin
+  s:=imyinterface;
+end.

tests/webtbs/tw6036.pp

@@ -0,0 +1,82 @@
+program corbainterface;
+{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
+{$ifdef mswindows}{$apptype console}{$endif}
+uses
+ sysutils;
+
+type
+ {$interfaces corba}
+ icorbainterface1 = interface ['{9E8B9751-7779-4484-B6B7-960D18ACE7AB}']
+  procedure iproc1;
+ end;
+ icorbainterface2 = interface ['MSE1']
+  procedure iproc2;
+ end;
+
+ {$interfaces com}
+ icominterface = interface ['{BC9EF8D0-2B67-4E5C-9952-05DF15A71567}']
+  procedure iproc3;
+ end;
+
+ ttestclasscorba = class(tobject,icorbainterface1,icorbainterface2)
+  public
+   procedure iproc1;
+   procedure iproc2;
+ end;
+
+ ttestclasscom = class(tinterfacedobject,icominterface)
+  public
+   procedure iproc3;
+ end;
+
+{ ttestclass }
+
+procedure ttestclasscorba.iproc1;
+begin
+end;
+
+procedure ttestclasscorba.iproc2;
+begin
+end;
+
+{ ttestclasscom }
+
+procedure ttestclasscom.iproc3;
+begin
+end;
+
+
+var
+ testclass1: ttestclasscorba;
+ testclass2: ttestclasscom;
+ po1: pointer;
+
+begin
+ testclass1:= ttestclasscorba.create;
+ testclass2:= ttestclasscom.create;
+
+ if testclass1.getinterface(icorbainterface1,po1) then begin
+  writeln('getinterface icorbainterface1 found');
+ end
+ else begin
+  writeln('getinterface icorbainterface1 not found');
+ end;
+
+ if testclass2.getinterface(icominterface,po1) then begin
+  writeln('getinterface icominterface found');
+ end
+ else begin
+  writeln('getinterface icominterface not found');
+ end;
+
+ if testclass1.getinterfacebystr('MSE1',po1) then begin
+  writeln('getinterfacebystr MSE1 found');
+ end
+ else begin
+  writeln('getinterfacebystr MSE1 not found');
+ end;
+
+ testclass1.free;
+ testclass2._Release;
+end.
+

tests/webtbs/tw6036a.pp

@@ -0,0 +1,12 @@
+{$interfaces corba}
+{$mode objfpc}
+type
+  imyinterface = interface
+  ['MYINTERFACE']
+  end;
+
+var
+  s : string;
+begin
+  s:=imyinterface;
+end.

utils/h2pas/converu.pas

@@ -29,7 +29,7 @@ const SHORT = 280;
 const UNSIGNED = 281;
 const LONG = 282;
 const INT = 283;
-const REAL = 284;
+const FLOAT = 284;
 const _CHAR = 285;
 const VOID = 286;
 const _CONST = 287;

utils/h2pas/h2pas.pas

@@ -46,7 +46,7 @@ program h2pas;
 
      INT64_STR  = 'int64';
      QWORD_STR  = 'qword';
-     REAL_STR   = 'double';
+     FLOAT_STR  = 'single';
      WCHAR_STR  = 'widechar';
 
   {ctypes strings}
@@ -1312,7 +1312,7 @@ const SHORT = 280;
 const UNSIGNED = 281;
 const LONG = 282;
 const INT = 283;
-const REAL = 284;
+const FLOAT = 284;
 const _CHAR = 285;
 const VOID = 286;
 const _CONST = 287;
@@ -2551,7 +2551,10 @@ begin
        end;
   78 : begin
          
-         yyval:=new(presobject,init_intid(REAL_STR));
+         if UseCTypesUnit then
+         yyval:=new(presobject,init_id(cfloat_STR))
+         else
+         yyval:=new(presobject,init_intid(FLOAT_STR));
          
        end;
   79 : begin

utils/h2pas/h2pas.y

@@ -1,3161 +1,3164 @@
-%{
-program h2pas;
-
-(*
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************)
-
-{$message TODO: warning Unit types is only needed due to issue 7910}
-
-   uses
-     SysUtils,types, classes,
-     options,scan,converu,lexlib,yacclib;
-
-   type
-     YYSTYPE = presobject;
-
-   const
-     SHORT_STR = 'shortint';
-     USHORT_STR = 'byte';
-     //C++ SHORT types usually map to the small types
-     SMALL_STR  = 'smallint';
-     USMALL_STR = 'word';
-     INT_STR    = 'longint';
-     UINT_STR   = 'dword';
-     CHAR_STR   = 'char';
-     UCHAR_STR  = USHORT_STR; { should we use byte or char for 'unsigned char' ?? }
-
-     INT64_STR  = 'int64';
-     QWORD_STR  = 'qword';
-     REAL_STR   = 'double';
-     WCHAR_STR  = 'widechar';
-
-  {ctypes strings}
-  const
-    cint8_STR       = 'cint8';
-    cuint8_STR      = 'cuint8';
-    cchar_STR       = 'cchar';
-    cschar_STR      = 'cschar';
-    cuchar_STR      = 'cuchar';
-
-    cint16_STR      = 'cint16';
-    cuint16_STR     = 'cuint16';
-    cshort_STR      = 'cshort';
-    csshort_STR     = 'csshort';
-    cushort_STR     = 'cushort';
-
-    cint32_STR      = 'cint32';
-    cuint32_STR     = 'cuint32';
-    cint_STR        = 'cint';
-    csint_STR       = 'csint';
-    cuint_STR       = 'cuint';
-
-    csigned_STR     = 'csigned';
-    cunsigned_STR   = 'cunsigned';
-
-    cint64_STR      = 'cint64';
-    cuint64_STR     = 'cuint64';
-    clonglong_STR   = 'clonglong';
-    cslonglong_STR  = 'cslonglong';
-    culonglong_STR  = 'culonglong';
-
-    cbool_STR       = 'cbool';
-
-    clong_STR       = 'clong';
-    cslong_STR      = 'cslong';
-    culong_STR      = 'culong';
-
-    cfloat_STR      = 'cfloat';
-    cdouble_STR     = 'cdouble';
-    clongdouble_STR = 'clongdouble';
-
-  const
-    MAX_CTYPESARRAY = 25;
-    CTypesArray : array [0..MAX_CTYPESARRAY] of string =
-      (cint8_STR,     cuint8_STR,
-       cchar_STR,     cschar_STR,     cuchar_STR,
-       cint16_STR,    cuint16_STR,
-       cshort_STR,    csshort_STR,    cushort_STR,
-       csigned_STR,   cunsigned_STR,
-       cint32_STR,    cuint32_STR,    cint_STR,
-       csint_STR,     cuint_STR,
-       cint64_STR,    cuint64_STR,
-       clonglong_STR, cslonglong_STR, culonglong_STR,
-
-       cbool_STR,
-       clong_STR,      cslong_STR,    culong_STR);
-
-
-  var
-     hp,ph    : presobject;
-     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;
-     freedynlibproc,
-     loaddynlibproc : tstringlist;
-
-
-(* $ define yydebug
- compile with -dYYDEBUG to get debugging info *)
-
-  const
-     (* number of a?b:c construction in one define *)
-     if_nb : longint = 0;
-     is_packed : boolean = false;
-     is_procvar : boolean = false;
-
-  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
-             i : byte;
-          begin
-             space_array[space_index]:=space_number;
-             inc(space_index);
-             for i:=1 to space_number do
-               aktspace:=aktspace+' ';
-          end;
-
-        procedure popshift;
-          begin
-             dec(space_index);
-             if space_index<0 then
-               internalerror(20);
-             delete(aktspace,1,space_array[space_index]);
-          end;
-
-    function str(i : longint) : string;
-      var
-         s : string;
-      begin
-         system.str(i,s);
-         str:=s;
-      end;
-
-    function hexstr(i : cardinal) : string;
-
-    const
-      HexTbl : array[0..15] of char='0123456789ABCDEF';
-    var
-      str : string;
-    begin
-      str:='';
-      while i<>0 do
-        begin
-           str:=hextbl[i and $F]+str;
-           i:=i shr 4;
-        end;
-      if str='' then str:='0';
-      hexstr:='$'+str;
-    end;
-
-    function uppercase(s : string) : string;
-      var
-         i : byte;
-      begin
-         for i:=1 to length(s) do
-           s[i]:=UpCase(s[i]);
-         uppercase:=s;
-      end;
-
-    procedure write_type_specifier(var outfile:text; p : presobject);forward;
-    procedure write_p_a_def(var outfile:text; p,simple_type : presobject);forward;
-    procedure write_ifexpr(var outfile:text; p : presobject);forward;
-    procedure write_funexpr(var outfile:text; p : presobject);forward;
-
-    procedure yymsg(const msg : string);
-      begin
-         writeln('line ',line_no,': ',msg);
-      end;
-
-
-    { This converts pascal reserved words to
-      the correct syntax.
-    }
-    function FixId(const s:string):string;
-    const
-     maxtokens = 14;
-     reservedid: array[1..maxtokens] of string[14] =
-       (
-         'CLASS',
-         'DISPOSE',
-         'FUNCTION',
-         'FALSE',
-         'LABEL',
-         'NEW',
-         'PROPERTY',
-         'PROCEDURE',
-         'RECORD',
-         'REPEAT',
-         'STRING',
-         'TYPE',
-         'TRUE',
-         'UNTIL'
-       );
-      var
-        b : boolean;
-        up : string;
-        i: integer;
-      begin
-        if s='' then
-         begin
-           FixId:='';
-           exit;
-         end;
-        b:=false;
-        up:=Uppercase(s);
-        for i:=1 to maxtokens do
-          begin
-            if up=reservedid[i] then
-               begin
-                  b:=true;
-                  break;
-                end;
-          end;
-        if b then
-         FixId:='_'+s
-        else
-         FixId:=s;
-      end;
-
-
-
-    function TypeName(const s:string):string;
-      var
-        i : longint;
-      begin
-        i:=1;
-        if RemoveUnderScore and (length(s)>1) and (s[1]='_') then
-         i:=2;
-        if PrependTypes then
-         TypeName:='T'+Copy(s,i,255)
-        else
-         TypeName:=Copy(s,i,255);
-      end;
-
-    function IsACType(const s : String) : Boolean;
-    var i : Integer;
-    begin
-      IsACType := True;
-      for i := 0 to MAX_CTYPESARRAY do
-      begin
-        if s = CTypesArray[i] then
-        begin
-          Exit;
-        end;
-      end;
-      IsACType := False;
-    end;
-
-    function PointerName(const s:string):string;
-      var
-        i : longint;
-      begin
-        if UseCTypesUnit then
-        begin
-          if IsACType(s) then
-          begin
-            PointerName := 'p'+s;
-            exit;
-          end;
-        end;
-        i:=1;
-        if RemoveUnderScore and (length(s)>1) and (s[1]='_') then
-         i:=2;
-        if UsePPointers then
-        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;
-
-    procedure write_packed_fields_info(var outfile:text; p : presobject; ph : string);
-      var
-         hp1,hp2,hp3 : presobject;
-         is_sized : boolean;
-         line : string;
-         flag_index : longint;
-         name : pchar;
-         ps : byte;
-
-      begin
-         { write out the tempfile created }
-         close(tempfile);
-         reset(tempfile);
-         is_sized:=false;
-         flag_index:=0;
-         writeln(outfile);
-         writeln(outfile,aktspace,'const');
-         shift(3);
-         while not eof(tempfile) do
-           begin
-              readln(tempfile,line);
-              ps:=pos('&',line);
-              if ps>0 then
-                line:=copy(line,1,ps-1)+ph+'_'+copy(line,ps+1,255);
-              writeln(outfile,aktspace,line);
-           end;
-         writeln(outfile);
-         close(tempfile);
-         rewrite(tempfile);
-         popshift;
-         (* walk through all members *)
-         hp1 := p^.p1;
-         while assigned(hp1) do
-           begin
-              (* hp2 is t_memberdec *)
-              hp2:=hp1^.p1;
-              (*  hp3 is t_declist *)
-              hp3:=hp2^.p2;
-              while assigned(hp3) do
-                begin
-                   if assigned(hp3^.p1^.p3) and
-                      (hp3^.p1^.p3^.typ = t_size_specifier) then
-                     begin
-                        is_sized:=true;
-                        name:=hp3^.p1^.p2^.p;
-                        { get function in interface }
-                        write(outfile,aktspace,'function ',name);
-                        write(outfile,'(var a : ',ph,') : ');
-                        shift(2);
-                        write_p_a_def(outfile,hp3^.p1^.p1,hp2^.p1);
-                        writeln(outfile,';');
-                        popshift;
-                        { get function in implementation }
-                        write(implemfile,aktspace,'function ',name);
-                        write(implemfile,'(var a : ',ph,') : ');
-                        if not compactmode then
-                         shift(2);
-                        write_p_a_def(implemfile,hp3^.p1^.p1,hp2^.p1);
-                        writeln(implemfile,';');
-                        writeln(implemfile,aktspace,'begin');
-                        shift(3);
-                        write(implemfile,aktspace,name,':=(a.flag',flag_index);
-                        writeln(implemfile,' and bm_',ph,'_',name,') shr bp_',ph,'_',name,';');
-                        popshift;
-                        writeln(implemfile,aktspace,'end;');
-                        if not compactmode then
-                         popshift;
-                        writeln(implemfile,'');
-                        { set function in interface }
-                        write(outfile,aktspace,'procedure set_',name);
-                        write(outfile,'(var a : ',ph,'; __',name,' : ');
-                        shift(2);
-                        write_p_a_def(outfile,hp3^.p1^.p1,hp2^.p1);
-                        writeln(outfile,');');
-                        popshift;
-                        { set function in implementation }
-                        write(implemfile,aktspace,'procedure set_',name);
-                        write(implemfile,'(var a : ',ph,'; __',name,' : ');
-                        if not compactmode then
-                         shift(2);
-                        write_p_a_def(implemfile,hp3^.p1^.p1,hp2^.p1);
-                        writeln(implemfile,');');
-                        writeln(implemfile,aktspace,'begin');
-                        shift(3);
-                        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(implemfile,aktspace,'end;');
-                        if not compactmode then
-                         popshift;
-                        writeln(implemfile,'');
-                     end
-                   else if is_sized then
-                     begin
-                        is_sized:=false;
-                        inc(flag_index);
-                     end;
-                   hp3:=hp3^.next;
-                end;
-              hp1:=hp1^.next;
-           end;
-         must_write_packed_field:=false;
-         block_type:=bt_no;
-      end;
-
-
-    procedure write_expr(var outfile:text; p : presobject);
-      begin
-      if assigned(p) then
-        begin
-         case p^.typ of
-            t_id,
-            t_ifexpr :
-              write(outfile,FixId(p^.p));
-            t_funexprlist :
-              write_funexpr(outfile,p);
-             t_exprlist :
-               begin
-                 if assigned(p^.p1) then
-                   write_expr(outfile,p^.p1);
-                 if assigned(p^.next) then
-                   begin
-                     write(', ');
-                     write_expr(outfile,p^.next);
-                   end;
-               end;
-            t_preop : begin
-                         write(outfile,p^.p,'(');
-                         write_expr(outfile,p^.p1);
-                         write(outfile,')');
-                         flush(outfile);
-                      end;
-            t_typespec : begin
-                         write_type_specifier(outfile,p^.p1);
-                         write(outfile,'(');
-                         write_expr(outfile,p^.p2);
-                         write(outfile,')');
-                         flush(outfile);
-                      end;
-            t_bop : begin
-                       if p^.p1^.typ<>t_id then
-                         write(outfile,'(');
-                       write_expr(outfile,p^.p1);
-                       if p^.p1^.typ<>t_id then
-                       write(outfile,')');
-                       write(outfile,p^.p);
-                       if p^.p2^.typ<>t_id then
-                         write(outfile,'(');
-                       write_expr(outfile,p^.p2);
-                       if p^.p2^.typ<>t_id then
-                         write(outfile,')');
-                       flush(outfile);
-                    end;
-            t_arrayop :
-                    begin
-                      write_expr(outfile,p^.p1);
-                      write(outfile,p^.p,'[');
-                      write_expr(outfile,p^.p2);
-                      write(outfile,']');
-                      flush(outfile);
-                    end;
-            t_callop :
-                    begin
-                      write_expr(outfile,p^.p1);
-                      write(outfile,p^.p,'(');
-                      write_expr(outfile,p^.p2);
-                      write(outfile,')');
-                      flush(outfile);
-                    end;
-            else
-              begin
-                writeln(ord(p^.typ));
-                internalerror(2);
-              end;
-            end;
-         end;
-      end;
-
-
-    procedure write_ifexpr(var outfile:text; p : presobject);
-      begin
-         flush(outfile);
-         write(outfile,'if ');
-         write_expr(outfile,p^.p1);
-         writeln(outfile,' then');
-         write(outfile,aktspace,'  ');
-         write(outfile,p^.p);
-         write(outfile,':=');
-         write_expr(outfile,p^.p2);
-         writeln(outfile);
-         writeln(outfile,aktspace,'else');
-         write(outfile,aktspace,'  ');
-         write(outfile,p^.p);
-         write(outfile,':=');
-         write_expr(outfile,p^.p3);
-         writeln(outfile,';');
-         write(outfile,aktspace);
-         flush(outfile);
-      end;
-
-
-    procedure write_all_ifexpr(var outfile:text; p : presobject);
-      begin
-      if assigned(p) then
-        begin
-           case p^.typ of
-             t_id :;
-             t_preop :
-               write_all_ifexpr(outfile,p^.p1);
-             t_callop,
-             t_arrayop,
-             t_bop :
-               begin
-                  write_all_ifexpr(outfile,p^.p1);
-                  write_all_ifexpr(outfile,p^.p2);
-               end;
-             t_ifexpr :
-               begin
-                  write_all_ifexpr(outfile,p^.p1);
-                  write_all_ifexpr(outfile,p^.p2);
-                  write_all_ifexpr(outfile,p^.p3);
-                  write_ifexpr(outfile,p);
-               end;
-             t_typespec :
-                  write_all_ifexpr(outfile,p^.p2);
-             t_funexprlist,
-             t_exprlist :
-               begin
-                 if assigned(p^.p1) then
-                   write_all_ifexpr(outfile,p^.p1);
-                 if assigned(p^.next) then
-                   write_all_ifexpr(outfile,p^.next);
-               end
-             else
-               internalerror(6);
-           end;
-        end;
-      end;
-
-    procedure write_funexpr(var outfile:text; p : presobject);
-      var
-         i : longint;
-
-      begin
-      if assigned(p) then
-        begin
-           case p^.typ of
-             t_ifexpr :
-               write(outfile,p^.p);
-             t_exprlist :
-               begin
-                  write_expr(outfile,p^.p1);
-                  if assigned(p^.next) then
-                    begin
-                      write(outfile,',');
-                      write_funexpr(outfile,p^.next);
-                    end
-               end;
-             t_funcname :
-               begin
-                  if not compactmode then
-                   shift(2);
-                  if if_nb>0 then
-                    begin
-                       writeln(outfile,aktspace,'var');
-                       write(outfile,aktspace,'   ');
-                       for i:=1 to if_nb do
-                         begin
-                            write(outfile,'if_local',i);
-                            if i<if_nb then
-                              write(outfile,', ')
-                            else
-                              writeln(outfile,' : longint;');
-                         end;
-                       writeln(outfile,aktspace,'(* result types are not known *)');
-                       if_nb:=0;
-                    end;
-                  writeln(outfile,aktspace,'begin');
-                  shift(3);
-                  write(outfile,aktspace);
-                  write_all_ifexpr(outfile,p^.p2);
-                  write_expr(outfile,p^.p1);
-                  write(outfile,':=');
-                  write_funexpr(outfile,p^.p2);
-                  writeln(outfile,';');
-                  popshift;
-                  writeln(outfile,aktspace,'end;');
-                  if not compactmode then
-                   popshift;
-                  flush(outfile);
-               end;
-             t_funexprlist :
-               begin
-                  if assigned(p^.p3) then
-                    begin
-                       write_type_specifier(outfile,p^.p3);
-                       write(outfile,'(');
-                    end;
-                  if assigned(p^.p1) then
-                    write_funexpr(outfile,p^.p1);
-                  if assigned(p^.p2) then
-                    begin
-                      write(outfile,'(');
-                      write_funexpr(outfile,p^.p2);
-                      write(outfile,')');
-                    end;
-                  if assigned(p^.p3) then
-                    write(outfile,')');
-               end
-             else internalerror(5);
-           end;
-        end;
-      end;
-
-     function ellipsisarg : presobject;
-       begin
-          ellipsisarg:=new(presobject,init_two(t_arg,nil,nil));
-       end;
-
-    const
-       (* 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);
-      var
-         len,para : longint;
-         old_in_args : boolean;
-         varpara : boolean;
-         lastp : presobject;
-         hs : string;
-      begin
-         NeedEllipsisOverload:=false;
-         para:=1;
-         len:=0;
-         lastp:=nil;
-         old_in_args:=in_args;
-         in_args:=true;
-         write(outfile,'(');
-         shift(2);
-
-         (* walk through all arguments *)
-         (* p must be of type t_arglist *)
-         while assigned(p) do
-           begin
-              if p^.typ<>t_arglist then
-                internalerror(10);
-              (* is ellipsis ? *)
-              if not assigned(p^.p1^.p1) and
-                 not assigned(p^.p1^.next) then
-                begin
-                   write(outfile,'args:array of const');
-                   (* if variable number of args we must allways pop *)
-                   no_pop:=false;
-                   (* Needs 2 declarations, also one without args, becuase
-                      in C you can omit the second parameter. Default parameter
-                      doesn't help as that isn't possible with array of const *)
-                   NeedEllipsisOverload:=true;
-                   (* Remove this para *)
-                   if assigned(lastp) then
-                    lastp^.next:=nil;
-                   dispose(p,done);
-                   (* leave the loop as p isnot valid anymore *)
-                   break;
-                end
-              (* we need to correct this in the pp file after *)
-              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^.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^.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
-                        write(outfile,'var ');
-                        inc(len,4);
-                     end;
-
-                   (* write new parameter name *)
-                   if assigned(p^.p1^.p2^.p2) then
-                     begin
-                        hs:=FixId(p^.p1^.p2^.p2^.p);
-                        write(outfile,hs);
-                        inc(len,length(hs));
-                     end
-                   else
-                     begin
-                       If removeUnderscore then
-                         begin
-                           Write (outfile,'para',para);
-                           inc(Len,5);
-                         end
-                       else
-                         begin
-                           write(outfile,'_para',para);
-                           inc(Len,6);
-                         end;
-                     end;
-                   write(outfile,':');
-                   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);
-
-                end;
-              lastp:=p;
-              p:=p^.next;
-              if assigned(p) then
-                begin
-                   write(outfile,'; ');
-                   { if len>40 then : too complicated to compute }
-                   if (para mod 5) = 0 then
-                     begin
-                        writeln(outfile);
-                        write(outfile,aktspace);
-                     end;
-                end;
-              inc(para);
-           end;
-         write(outfile,')');
-         flush(outfile);
-         in_args:=old_in_args;
-         popshift;
-      end;
-
-
-
-    procedure write_p_a_def(var outfile:text; p,simple_type : presobject);
-      var
-         i : longint;
-         error : integer;
-         pointerwritten,
-         constant : boolean;
-
-      begin
-         if not(assigned(p)) then
-           begin
-              write_type_specifier(outfile,simple_type);
-              exit;
-           end;
-         case p^.typ of
-            t_pointerdef : begin
-                              (* procedure variable ? *)
-                              if assigned(p^.p1) and (p^.p1^.typ=t_procdef) then
-                                begin
-                                   is_procvar:=true;
-                                   (* distinguish between procedure and function *)
-                                   if (simple_type^.typ=t_void) and (p^.p1^.p1=nil) then
-                                     begin
-                                        write(outfile,'procedure ');
-
-                                        shift(10);
-                                        (* write arguments *)
-                                        if assigned(p^.p1^.p2) then
-                                          write_args(outfile,p^.p1^.p2);
-                                        flush(outfile);
-                                        popshift;
-                                     end
-                                   else
-                                     begin
-                                        write(outfile,'function ');
-                                        shift(9);
-                                        (* write arguments *)
-                                        if assigned(p^.p1^.p2) then
-                                          write_args(outfile,p^.p1^.p2);
-                                        write(outfile,':');
-                                        flush(outfile);
-                                        write_p_a_def(outfile,p^.p1^.p1,simple_type);
-                                        popshift;
-                                     end
-                                end
-                              else
-                                begin
-                                   (* generate "pointer" ? *)
-                                   if (simple_type^.typ=t_void) and (p^.p1=nil) then
-                                     begin
-                                       write(outfile,'pointer');
-                                       flush(outfile);
-                                     end
-                                   else
-                                     begin
-                                       pointerwritten:=false;
-                                       if (p^.p1=nil) and UsePPointers then
-                                        begin
-                                          if (simple_type^.typ=t_id) then
-                                           begin
-                                             write(outfile,PointerName(simple_type^.p));
-                                             pointerwritten:=true;
-                                           end
-                                          { structure }
-                                          else if (simple_type^.typ in [t_uniondef,t_structdef]) and
-                                                  (simple_type^.p1=nil) and (simple_type^.p2^.typ=t_id) then
-                                           begin
-                                             write(outfile,PointerName(simple_type^.p2^.p));
-                                             pointerwritten:=true;
-                                           end;
-                                        end;
-                                      if not pointerwritten then
-                                       begin
-                                         if in_args then
-                                         begin
-                                          write(outfile,'P');
-                                          pointerprefix:=true;
-                                         end
-                                         else
-                                          write(outfile,'^');
-                                         write_p_a_def(outfile,p^.p1,simple_type);
-                                         pointerprefix:=false;
-                                       end;
-                                     end;
-                                end;
-                           end;
-            t_arraydef : begin
-                             constant:=false;
-                             if assigned(p^.p2) then
-                              begin
-                                if p^.p2^.typ=t_id then
-                                 begin
-                                   val(p^.p2^.str,i,error);
-                                   if error=0 then
-                                    begin
-                                      dec(i);
-                                      constant:=true;
-                                    end;
-                                 end;
-                                if not constant then
-                                 begin
-                                   write(outfile,'array[0..(');
-                                   write_expr(outfile,p^.p2);
-                                   write(outfile,')-1] of ');
-                                 end
-                                else
-                                 begin
-                                   write(outfile,'array[0..',i,'] of ');
-                                 end;
-                              end
-                             else
-                              begin
-                                (* open array *)
-                                write(outfile,'array of ');
-                              end;
-                             flush(outfile);
-                             write_p_a_def(outfile,p^.p1,simple_type);
-                          end;
-            else internalerror(1);
-         end;
-      end;
-
-    procedure write_type_specifier(var outfile:text; p : presobject);
-      var
-         hp1,hp2,hp3,lastexpr : presobject;
-         i,l,w : longint;
-         error : integer;
-         current_power,
-         mask : cardinal;
-         flag_index : longint;
-         current_level : byte;
-         pointerwritten,
-         is_sized : boolean;
-
-      begin
-         case p^.typ of
-            t_id :
-              begin
-                if pointerprefix then
-                  if UseCtypesUnit then
-                  begin
-                    if not IsACType(p^.p) then
-                    begin
-                      PTypeList.Add('P'+p^.str);
-                    end;
-                  end
-                  else
-                   PTypeList.Add('P'+p^.str);
-                if p^.intname then
-                 write(outfile,p^.p)
-                else
-                 write(outfile,TypeName(p^.p));
-              end;
-            { what can we do with void defs  ? }
-            t_void :
-              write(outfile,'pointer');
-            t_pointerdef :
-              begin
-                 pointerwritten:=false;
-                 if (p^.p1^.typ=t_void) then
-                  begin
-                    write(outfile,'pointer');
-                    pointerwritten:=true;
-                  end
-                 else
-                  if UsePPointers then
-                   begin
-                     if (p^.p1^.typ=t_id) then
-                      begin
-                        write(outfile,PointerName(p^.p1^.p));
-                        pointerwritten:=true;
-                      end
-                     { structure }
-                     else if (p^.p1^.typ in [t_uniondef,t_structdef]) and
-                             (p^.p1^.p1=nil) and (p^.p1^.p2^.typ=t_id) then
-                      begin
-                        write(outfile,PointerName(p^.p1^.p2^.p));
-                        pointerwritten:=true;
-                      end;
-                   end;
-                 if not pointerwritten then
-                  begin
-                    if in_args then
-                    begin
-                      if UseCTypesUnit and (IsACType(p^.p1^.p)=False) then
-                        write(outfile,'P')
-                      else
-                        write(outfile,'p');
-                      pointerprefix:=true;
-                    end
-                    else
-                    begin
-                      if UseCTypesUnit and (IsACType(p^.p1^.p)=False) then
-                        write(outfile,'^')
-                      else
-                        write(outfile,'p');
-                    end;
-                    write_type_specifier(outfile,p^.p1);
-                    pointerprefix:=false;
-                  end;
-              end;
-            t_enumdef :
-              begin
-                 if (typedef_level>1) and (p^.p1=nil) and
-                    (p^.p2^.typ=t_id) then
-                   begin
-                      if pointerprefix then
-                        if UseCTypesUnit and (IsACType( p^.p2^.p )=False) then
-                          PTypeList.Add('P'+p^.p2^.str);
-                      write(outfile,p^.p2^.p);
-                   end
-                 else
-                 if not EnumToConst then
-                   begin
-                      write(outfile,'(');
-                      hp1:=p^.p1;
-                      w:=length(aktspace);
-                      while assigned(hp1) do
-                        begin
-                           write(outfile,hp1^.p1^.p);
-                           if assigned(hp1^.p2) then
-                             begin
-                                write(outfile,' := ');
-                                write_expr(outfile,hp1^.p2);
-                                w:=w+6;(* strlen(hp1^.p); *)
-                             end;
-                           w:=w+length(hp1^.p1^.str);
-                           hp1:=hp1^.next;
-                           if assigned(hp1) then
-                             write(outfile,',');
-                           if w>40 then
-                             begin
-                                 writeln(outfile);
-                                 write(outfile,aktspace);
-                                 w:=length(aktspace);
-                             end;
-                           flush(outfile);
-                        end;
-                      write(outfile,')');
-                      flush(outfile);
-                   end
-                 else
-                   begin
-                      Writeln (outfile,' Longint;');
-                      hp1:=p^.p1;
-                      l:=0;
-                      lastexpr:=nil;
-                      Writeln (outfile,copy(aktspace,1,length(aktspace)-2),'Const');
-                      while assigned(hp1) do
-                        begin
-                           write (outfile,aktspace,hp1^.p1^.p,' = ');
-                           if assigned(hp1^.p2) then
-                             begin
-                                write_expr(outfile,hp1^.p2);
-                                writeln(outfile,';');
-                                lastexpr:=hp1^.p2;
-                                if lastexpr^.typ=t_id then
-                                  begin
-                                     val(lastexpr^.str,l,error);
-                                     if error=0 then
-                                       begin
-                                          inc(l);
-                                          lastexpr:=nil;
-                                       end
-                                     else
-                                       l:=1;
-                                  end
-                                else
-                                  l:=1;
-                             end
-                           else
-                             begin
-                                if assigned(lastexpr) then
-                                  begin
-                                     write(outfile,'(');
-                                     write_expr(outfile,lastexpr);
-                                     writeln(outfile,')+',l,';');
-                                  end
-                                else
-                                  writeln (outfile,l,';');
-                                inc(l);
-                             end;
-                           hp1:=hp1^.next;
-                           flush(outfile);
-                        end;
-                      block_type:=bt_const;
-                  end;
-               end;
-            t_structdef :
-              begin
-                 inc(typedef_level);
-                 flag_index:=-1;
-                 is_sized:=false;
-                 current_level:=0;
-                 if ((in_args) or (typedef_level>1)) and
-                    (p^.p1=nil) and (p^.p2^.typ=t_id) then
-                   begin
-                      if pointerprefix then
-                        if UseCTypesUnit and (IsACType(p^.p2^.str)=false) then
-                          PTypeList.Add('P'+p^.p2^.str);
-                     write(outfile,TypeName(p^.p2^.p));
-                   end
-                 else
-                   begin
-                      if packrecords then
-                        writeln(outfile,'packed record')
-                      else
-                        writeln(outfile,'record');
-                      shift(3);
-                      hp1:=p^.p1;
-
-                      (* walk through all members *)
-                      while assigned(hp1) do
-                        begin
-                           (* hp2 is t_memberdec *)
-                           hp2:=hp1^.p1;
-                           (*  hp3 is t_declist *)
-                           hp3:=hp2^.p2;
-                           while assigned(hp3) do
-                             begin
-                                if not assigned(hp3^.p1^.p3) or
-                                   (hp3^.p1^.p3^.typ <> t_size_specifier) then
-                                  begin
-                                     if is_sized then
-                                       begin
-                                          if current_level <= 16 then
-                                            writeln(outfile,'word;')
-                                          else if current_level <= 32 then
-                                            writeln(outfile,'longint;')
-                                          else
-                                            internalerror(11);
-                                          is_sized:=false;
-                                       end;
-
-                                     write(outfile,aktspace,FixId(hp3^.p1^.p2^.p));
-                                     write(outfile,' : ');
-                                     shift(2);
-                                     write_p_a_def(outfile,hp3^.p1^.p1,hp2^.p1);
-                                     popshift;
-                                  end;
-                                { size specifier  or default value ? }
-                                if assigned(hp3^.p1^.p3) then
-                                  begin
-                                     { we could use mask to implement this }
-                                     { because we need to respect the positions }
-                                     if hp3^.p1^.p3^.typ = t_size_specifier then
-                                       begin
-                                          if not is_sized then
-                                            begin
-                                               current_power:=1;
-                                               current_level:=0;
-                                               inc(flag_index);
-                                               write(outfile,aktspace,'flag',flag_index,' : ');
-                                            end;
-                                          must_write_packed_field:=true;
-                                          is_sized:=true;
-                                          { can it be something else than a constant ? }
-                                          { it can be a macro !! }
-                                          if hp3^.p1^.p3^.p1^.typ=t_id then
-                                            begin
-                                              val(hp3^.p1^.p3^.p1^.str,l,error);
-                                              if error=0 then
-                                                begin
-                                                   mask:=0;
-                                                   for i:=1 to l do
-                                                     begin
-                                                        inc(mask,current_power);
-                                                        current_power:=current_power*2;
-                                                     end;
-                                                   write(tempfile,'bm_&',hp3^.p1^.p2^.p);
-                                                   writeln(tempfile,' = ',hexstr(mask),';');
-                                                   write(tempfile,'bp_&',hp3^.p1^.p2^.p);
-                                                   writeln(tempfile,' = ',current_level,';');
-                                                   current_level:=current_level + l;
-                                                   { go to next flag if 31 }
-                                                   if current_level = 32 then
-                                                     begin
-                                                        write(outfile,'longint');
-                                                        is_sized:=false;
-                                                     end;
-                                                end;
-                                            end;
-
-                                       end
-                                     else if hp3^.p1^.p3^.typ = t_default_value then
-                                       begin
-                                          write(outfile,'{=');
-                                          write_expr(outfile,hp3^.p1^.p3^.p1);
-                                          write(outfile,' ignored}');
-                                       end;
-                                  end;
-                                if not is_sized then
-                                  begin
-                                     if is_procvar then
-                                       begin
-                                          if not no_pop then
-                                            begin
-                                               write(outfile,';cdecl');
-                                               no_pop:=true;
-                                            end;
-                                          is_procvar:=false;
-                                       end;
-                                     writeln(outfile,';');
-                                  end;
-                                hp3:=hp3^.next;
-                             end;
-                           hp1:=hp1^.next;
-                        end;
-                      if is_sized then
-                        begin
-                           if current_level <= 16 then
-                             writeln(outfile,'word;')
-                           else if current_level <= 32 then
-                             writeln(outfile,'longint;')
-                           else
-                             internalerror(11);
-                           is_sized:=false;
-                        end;
-                      popshift;
-                      write(outfile,aktspace,'end');
-                      flush(outfile);
-                   end;
-                 dec(typedef_level);
-              end;
-            t_uniondef :
-              begin
-                 inc(typedef_level);
-                 if (typedef_level>1) and (p^.p1=nil) and
-                    (p^.p2^.typ=t_id) then
-                   begin
-                      write(outfile,p^.p2^.p);
-                   end
-                 else
-                   begin
-                      inc(typedef_level);
-                      if packrecords then
-                        writeln(outfile,'packed record')
-                      else
-                        writeln(outfile,'record');
-                      shift(2);
-                      writeln(outfile,aktspace,'case longint of');
-                      shift(3);
-                      l:=0;
-                      hp1:=p^.p1;
-
-                      (* walk through all members *)
-                      while assigned(hp1) do
-                        begin
-                           (* hp2 is t_memberdec *)
-                           hp2:=hp1^.p1;
-                           (* hp3 is t_declist *)
-                           hp3:=hp2^.p2;
-                           while assigned(hp3) do
-                             begin
-                                write(outfile,aktspace,l,' : ( ');
-                                write(outfile,FixId(hp3^.p1^.p2^.p),' : ');
-                                shift(2);
-                                write_p_a_def(outfile,hp3^.p1^.p1,hp2^.p1);
-                                popshift;
-                                writeln(outfile,' );');
-                                hp3:=hp3^.next;
-                                inc(l);
-                             end;
-                           hp1:=hp1^.next;
-                        end;
-                      popshift;
-                      write(outfile,aktspace,'end');
-                      popshift;
-                      flush(outfile);
-                      dec(typedef_level);
-                   end;
-                 dec(typedef_level);
-              end;
-            else
-              internalerror(3);
-         end;
-      end;
-
-    procedure write_def_params(var outfile:text; p : presobject);
-      var
-         hp1 : presobject;
-      begin
-         case p^.typ of
-            t_enumdef : begin
-                           hp1:=p^.p1;
-                           while assigned(hp1) do
-                             begin
-                                write(outfile,FixId(hp1^.p1^.p));
-                                hp1:=hp1^.next;
-                                if assigned(hp1) then
-                                  write(outfile,',')
-                                else
-                                  write(outfile);
-                                flush(outfile);
-                             end;
-                           flush(outfile);
-                        end;
-         else internalerror(4);
-         end;
-      end;
-
-
-    procedure write_statement_block(var outfile:text; p : presobject);
-      begin
-        writeln(outfile,aktspace,'begin');
-        while assigned(p) do
-          begin
-            shift(2);
-            if assigned(p^.p1) then
-              begin
-                case p^.p1^.typ of
-                  t_whilenode:
-                    begin
-                      write(outfile,aktspace,'while ');
-                      write_expr(outfile,p^.p1^.p1);
-                      writeln(outfile,' do');
-                      shift(2);
-                      write_statement_block(outfile,p^.p1^.p2);
-                      popshift;
-                    end;
-                  else
-                    begin
-                      write(outfile,aktspace);
-                      write_expr(outfile,p^.p1);
-                      writeln(outfile,';');
-                    end;
-                end;
-              end;
-            p:=p^.next;
-            popshift;
-          end;
-        writeln(outfile,aktspace,'end;');
-      end;
-
-%}
-
-%token _WHILE _FOR _DO _GOTO _CONTINUE _BREAK
-%token TYPEDEF DEFINE
-%token COLON SEMICOLON COMMA
-%token LKLAMMER RKLAMMER LECKKLAMMER RECKKLAMMER
-%token LGKLAMMER RGKLAMMER
-%token STRUCT UNION ENUM
-%token ID NUMBER CSTRING
-%token SHORT UNSIGNED LONG INT REAL _CHAR
-%token VOID _CONST
-%token _FAR _HUGE _NEAR
-%token NEW_LINE SPACE_DEFINE
-%token EXTERN STDCALL CDECL CALLBACK PASCAL WINAPI APIENTRY WINGDIAPI SYS_TRAP
-%token _PACKED
-%token ELLIPSIS
-%right _ASSIGN
-%right R_AND
-%left EQUAL UNEQUAL GT LT GTE LTE
-%left QUESTIONMARK COLON
-%left _OR
-%left _AND
-%left _PLUS MINUS
-%left _SHR _SHL
-%left STAR _SLASH
-%right _NOT
-%right LKLAMMER
-%right PSTAR
-%right P_AND
-%right LECKKLAMMER
-%left POINT DEREF
-%left COMMA
-%left STICK
-%token SIGNED
-%token INT8 INT16 INT32 INT64
-%%
-
-file : declaration_list
-     ;
-
-maybe_space :
-     SPACE_DEFINE
-     {
-       $$:=nil;
-     } |
-     {
-       $$:=nil;
-     }
-     ;
-
-error_info : {
-                  writeln(outfile,'(* error ');
-                  writeln(outfile,yyline);
-             };
-
-declaration_list : declaration_list  declaration
-     {  if yydebug then writeln('declaration reduced at line ',line_no);
-        if yydebug then writeln(outfile,'(* declaration reduced *)');
-     }
-     | declaration_list define_dec
-     {  if yydebug then writeln('define declaration reduced at line ',line_no);
-        if yydebug then writeln(outfile,'(* define declaration reduced *)');
-     }
-     | declaration
-     {  if yydebug then writeln('declaration reduced at line ',line_no);
-     }
-     | define_dec
-     {  if yydebug then writeln('define declaration reduced at line ',line_no);
-     }
-     ;
-
-dec_specifier :
-     EXTERN { $$:=new(presobject,init_id('extern')); }
-     |{ $$:=new(presobject,init_id('intern')); }
-     ;
-
-dec_modifier :
-     STDCALL { $$:=new(presobject,init_id('no_pop')); }
-     | CDECL { $$:=new(presobject,init_id('cdecl')); }
-     | CALLBACK { $$:=new(presobject,init_id('no_pop')); }
-     | PASCAL { $$:=new(presobject,init_id('no_pop')); }
-     | WINAPI { $$:=new(presobject,init_id('no_pop')); }
-     | APIENTRY { $$:=new(presobject,init_id('no_pop')); }
-     | WINGDIAPI { $$:=new(presobject,init_id('no_pop')); }
-     | { $$:=nil }
-     ;
-
-systrap_specifier:
-     SYS_TRAP LKLAMMER dname RKLAMMER { $$:=$3; }
-     | { $$:=nil; }
-     ;
-
-statement :
-     expr SEMICOLON { $$:=$1; } |
-     _WHILE LKLAMMER expr RKLAMMER statement_list { $$:=new(presobject,init_two(t_whilenode,$3,$5)); }
-     ;
-
-
-statement_list : statement statement_list
-     {
-       $$:=new(presobject,init_one(t_statement_list,$1));
-       $$^.next:=$2;
-     } |
-     statement
-     {
-       $$:=new(presobject,init_one(t_statement_list,$1));
-     } |
-     SEMICOLON
-     {
-       $$:=new(presobject,init_one(t_statement_list,nil));
-     } |
-     {
-       $$:=new(presobject,init_one(t_statement_list,nil));
-     }
-     ;
-
-statement_block :
-     LGKLAMMER statement_list RGKLAMMER { $$:=$2; }
-     ;
-
-declaration :
-     dec_specifier type_specifier dec_modifier declarator_list statement_block
-     {
-       IsExtern:=false;
-       (* by default we must pop the args pushed on stack *)
-       no_pop:=false;
-       if (assigned($4)and assigned($4^.p1)and assigned($4^.p1^.p1))
-         and ($4^.p1^.p1^.typ=t_procdef) then
-          begin
-             repeat
-             If UseLib then
-               IsExtern:=true
-             else
-               IsExtern:=assigned($1)and($1^.str='extern');
-             no_pop:=assigned($3) and ($3^.str='no_pop');
-
-             if (block_type<>bt_func) and not(createdynlib) then
-               begin
-                 writeln(outfile);
-                 block_type:=bt_func;
-               end;
-
-             (* dyn. procedures must be put into a var block *)
-             if createdynlib then
-               begin
-                 if (block_type<>bt_var) then
-                  begin
-                     if not(compactmode) then
-                       writeln(outfile);
-                     writeln(outfile,aktspace,'var');
-                     block_type:=bt_var;
-                  end;
-                 shift(2);
-               end;
-             if not CompactMode then
-              begin
-                write(outfile,aktspace);
-                if not IsExtern then
-                 write(implemfile,aktspace);
-              end;
-             (* distinguish between procedure and function *)
-             if assigned($2) then
-              if ($2^.typ=t_void) and ($4^.p1^.p1^.p1=nil) then
-               begin
-                 if createdynlib then
-                   begin
-                     write(outfile,$4^.p1^.p2^.p,' : procedure');
-                   end
-                 else
-                   begin
-                     shift(10);
-                     write(outfile,'procedure ',$4^.p1^.p2^.p);
-                   end;
-                 if assigned($4^.p1^.p1^.p2) then
-                   write_args(outfile,$4^.p1^.p1^.p2);
-                 if createdynlib then
-                    begin
-                      loaddynlibproc.add('pointer('+$4^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+$4^.p1^.p2^.p+''');');
-                      freedynlibproc.add($4^.p1^.p2^.p+':=nil;');
-                    end
-                  else if not IsExtern then
-                  begin
-                    write(implemfile,'procedure ',$4^.p1^.p2^.p);
-                    if assigned($4^.p1^.p1^.p2) then
-                     write_args(implemfile,$4^.p1^.p1^.p2);
-                  end;
-               end
-             else
-               begin
-                 if createdynlib then
-                   begin
-                     write(outfile,$4^.p1^.p2^.p,' : function');
-                   end
-                 else
-                   begin
-                     shift(9);
-                     write(outfile,'function ',$4^.p1^.p2^.p);
-                   end;
-
-                  if assigned($4^.p1^.p1^.p2) then
-                    write_args(outfile,$4^.p1^.p1^.p2);
-                  write(outfile,':');
-                  write_p_a_def(outfile,$4^.p1^.p1^.p1,$2);
-                  if createdynlib then
-                    begin
-                      loaddynlibproc.add('pointer('+$4^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+$4^.p1^.p2^.p+''');');
-                      freedynlibproc.add($4^.p1^.p2^.p+':=nil;');
-                    end
-                  else if not IsExtern then
-                   begin
-                     write(implemfile,'function ',$4^.p1^.p2^.p);
-                     if assigned($4^.p1^.p1^.p2) then
-                      write_args(implemfile,$4^.p1^.p1^.p2);
-                     write(implemfile,':');
-                     write_p_a_def(implemfile,$4^.p1^.p1^.p1,$2);
-                   end;
-               end;
-             (* No CDECL in interface for Uselib *)
-             if IsExtern and (not no_pop) then
-               write(outfile,';cdecl');
-             popshift;
-             if createdynlib then
-               begin
-                 writeln(outfile,';');
-               end
-             else if UseLib then
-               begin
-                 if IsExtern then
-                  begin
-                    write (outfile,';external');
-                    If UseName then
-                     Write(outfile,' External_library name ''',$4^.p1^.p2^.p,'''');
-                  end;
-                 writeln(outfile,';');
-               end
-             else
-               begin
-                 writeln(outfile,';');
-                 if not IsExtern then
-                  begin
-                    writeln(implemfile,';');
-                    shift(2);
-                    if $5^.typ=t_statement_list then
-                      write_statement_block(implemfile,$5);
-                    popshift;
-                  end;
-               end;
-             IsExtern:=false;
-             if not(compactmode) and not(createdynlib) then
-              writeln(outfile);
-            until not NeedEllipsisOverload;
-          end
-        else (* $4^.p1^.p1^.typ=t_procdef *)
-        if assigned($4)and assigned($4^.p1) then
-          begin
-             shift(2);
-             if block_type<>bt_var then
-               begin
-                  if not(compactmode) then
-                    writeln(outfile);
-                  writeln(outfile,aktspace,'var');
-               end;
-             block_type:=bt_var;
-
-             shift(3);
-
-             IsExtern:=assigned($1)and($1^.str='extern');
-             (* walk through all declarations *)
-             hp:=$4;
-             while assigned(hp) and assigned(hp^.p1) do
-               begin
-                  (* write new var name *)
-                  if assigned(hp^.p1^.p2) and assigned(hp^.p1^.p2^.p) then
-                    write(outfile,aktspace,hp^.p1^.p2^.p);
-                  write(outfile,' : ');
-                  shift(2);
-                  (* write its type *)
-                  write_p_a_def(outfile,hp^.p1^.p1,$2);
-                  if assigned(hp^.p1^.p2)and assigned(hp^.p1^.p2^.p)then
-                    begin
-                       if isExtern then
-                         write(outfile,';cvar;external')
-                       else
-                         write(outfile,';cvar;public');
-                    end;
-                  writeln(outfile,';');
-                  popshift;
-                  hp:=hp^.p2;
-               end;
-             popshift;
-             popshift;
-          end;
-        if assigned($1) then
-          dispose($1,done);
-        if assigned($2) then
-          dispose($2,done);
-        if assigned($3) then
-          dispose($3,done);
-        if assigned($4) then
-          dispose($4,done);
-        if assigned($5) then
-          dispose($5,done);
-     }
-     | dec_specifier type_specifier dec_modifier declarator_list systrap_specifier SEMICOLON
-     {
-       IsExtern:=false;
-       (* by default we must pop the args pushed on stack *)
-       no_pop:=false;
-       if (assigned($4)and assigned($4^.p1)and assigned($4^.p1^.p1))
-         and ($4^.p1^.p1^.typ=t_procdef) then
-          begin
-             repeat
-             If UseLib then
-               IsExtern:=true
-             else
-               IsExtern:=assigned($1)and($1^.str='extern');
-             no_pop:=assigned($3) and ($3^.str='no_pop');
-
-             if (block_type<>bt_func) and not(createdynlib) then
-               begin
-                 writeln(outfile);
-                 block_type:=bt_func;
-               end;
-
-             (* dyn. procedures must be put into a var block *)
-             if createdynlib then
-               begin
-                 if (block_type<>bt_var) then
-                  begin
-                     if not(compactmode) then
-                       writeln(outfile);
-                     writeln(outfile,aktspace,'var');
-                     block_type:=bt_var;
-                  end;
-                 shift(2);
-               end;
-             if not CompactMode then
-              begin
-                write(outfile,aktspace);
-                if not IsExtern then
-                 write(implemfile,aktspace);
-              end;
-             (* distinguish between procedure and function *)
-             if assigned($2) then
-              if ($2^.typ=t_void) and ($4^.p1^.p1^.p1=nil) then
-               begin
-                 if createdynlib then
-                   begin
-                     write(outfile,$4^.p1^.p2^.p,' : procedure');
-                   end
-                 else
-                   begin
-                     shift(10);
-                     write(outfile,'procedure ',$4^.p1^.p2^.p);
-                   end;
-                 if assigned($4^.p1^.p1^.p2) then
-                   write_args(outfile,$4^.p1^.p1^.p2);
-                 if createdynlib then
-                    begin
-                      loaddynlibproc.add('pointer('+$4^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+$4^.p1^.p2^.p+''');');
-                      freedynlibproc.add($4^.p1^.p2^.p+':=nil;');
-                    end
-                  else if not IsExtern then
-                  begin
-                    write(implemfile,'procedure ',$4^.p1^.p2^.p);
-                    if assigned($4^.p1^.p1^.p2) then
-                     write_args(implemfile,$4^.p1^.p1^.p2);
-                  end;
-               end
-             else
-               begin
-                 if createdynlib then
-                   begin
-                     write(outfile,$4^.p1^.p2^.p,' : function');
-                   end
-                 else
-                   begin
-                     shift(9);
-                     write(outfile,'function ',$4^.p1^.p2^.p);
-                   end;
-
-                  if assigned($4^.p1^.p1^.p2) then
-                    write_args(outfile,$4^.p1^.p1^.p2);
-                  write(outfile,':');
-                  write_p_a_def(outfile,$4^.p1^.p1^.p1,$2);
-                  if createdynlib then
-                    begin
-                      loaddynlibproc.add('pointer('+$4^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+$4^.p1^.p2^.p+''');');
-                      freedynlibproc.add($4^.p1^.p2^.p+':=nil;');
-                    end
-                  else if not IsExtern then
-                   begin
-                     write(implemfile,'function ',$4^.p1^.p2^.p);
-                     if assigned($4^.p1^.p1^.p2) then
-                      write_args(implemfile,$4^.p1^.p1^.p2);
-                     write(implemfile,':');
-                     write_p_a_def(implemfile,$4^.p1^.p1^.p1,$2);
-                   end;
-               end;
-             if assigned($5) then
-               write(outfile,';systrap ',$5^.p);
-             (* No CDECL in interface for Uselib *)
-             if IsExtern and (not no_pop) then
-               write(outfile,';cdecl');
-             popshift;
-             if createdynlib then
-               begin
-                 writeln(outfile,';');
-               end
-             else if UseLib then
-               begin
-                 if IsExtern then
-                  begin
-                    write (outfile,';external');
-                    If UseName then
-                     Write(outfile,' External_library name ''',$4^.p1^.p2^.p,'''');
-                  end;
-                 writeln(outfile,';');
-               end
-             else
-               begin
-                 writeln(outfile,';');
-                 if not IsExtern then
-                  begin
-                    writeln(implemfile,';');
-                    writeln(implemfile,aktspace,'begin');
-                    writeln(implemfile,aktspace,'  { You must implement this function }');
-                    writeln(implemfile,aktspace,'end;');
-                  end;
-               end;
-             IsExtern:=false;
-             if not(compactmode) and not(createdynlib) then
-              writeln(outfile);
-            until not NeedEllipsisOverload;
-          end
-        else (* $4^.p1^.p1^.typ=t_procdef *)
-        if assigned($4)and assigned($4^.p1) then
-          begin
-             shift(2);
-             if block_type<>bt_var then
-               begin
-                  if not(compactmode) then
-                    writeln(outfile);
-                  writeln(outfile,aktspace,'var');
-               end;
-             block_type:=bt_var;
-
-             shift(3);
-
-             IsExtern:=assigned($1)and($1^.str='extern');
-             (* walk through all declarations *)
-             hp:=$4;
-             while assigned(hp) and assigned(hp^.p1) do
-               begin
-                  (* write new var name *)
-                  if assigned(hp^.p1^.p2) and assigned(hp^.p1^.p2^.p) then
-                    write(outfile,aktspace,hp^.p1^.p2^.p);
-                  write(outfile,' : ');
-                  shift(2);
-                  (* write its type *)
-                  write_p_a_def(outfile,hp^.p1^.p1,$2);
-                  if assigned(hp^.p1^.p2)and assigned(hp^.p1^.p2^.p)then
-                    begin
-                       if isExtern then
-                         write(outfile,';cvar;external')
-                       else
-                         write(outfile,';cvar;public');
-                    end;
-                  writeln(outfile,';');
-                  popshift;
-                  hp:=hp^.p2;
-               end;
-             popshift;
-             popshift;
-          end;
-        if assigned($1)then  dispose($1,done);
-        if assigned($2)then  dispose($2,done);
-        if assigned($4)then  dispose($4,done);
-     } |
-     special_type_specifier SEMICOLON
-     {
-       if block_type<>bt_type then
-         begin
-            if not(compactmode) then
-              writeln(outfile);
-            writeln(outfile,aktspace,'type');
-            block_type:=bt_type;
-         end;
-       shift(3);
-       if ( yyv[yysp-1]^.p2  <> nil ) then
-         begin
-         (* write new type name *)
-         TN:=TypeName($1^.p2^.p);
-         PN:=PointerName($1^.p2^.p);
-         (* define a Pointer type also for structs *)
-         if UsePPointers and (Uppercase(tn)<>Uppercase(pn)) and
-            assigned($1) and ($1^.typ in [t_uniondef,t_structdef]) then
-          writeln(outfile,aktspace,PN,' = ^',TN,';');
-         write(outfile,aktspace,TN,' = ');
-         shift(2);
-         hp:=$1;
-         write_type_specifier(outfile,hp);
-         popshift;
-         (* enum_to_const can make a switch to const *)
-         if block_type=bt_type then
-          writeln(outfile,';');
-         writeln(outfile);
-         flush(outfile);
-         popshift;
-         if must_write_packed_field then
-           write_packed_fields_info(outfile,hp,TN);
-         if assigned(hp) then
-           dispose(hp,done)
-         end
-       else
-         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;');
-         writeln(outfile);
-         popshift;
-         end;
-     } |
-     TYPEDEF STRUCT dname dname SEMICOLON
-     {
-       (* TYPEDEF STRUCT dname dname SEMICOLON *)
-       if block_type<>bt_type then
-         begin
-            if not(compactmode) then
-              writeln(outfile);
-            writeln(outfile,aktspace,'type');
-            block_type:=bt_type;
-         end;
-       PN:=TypeName($3^.p);
-       TN:=TypeName($4^.p);
-       if Uppercase(tn)<>Uppercase(pn) then
-        begin
-          shift(3);
-          writeln(outfile,aktspace,PN,' = ',TN,';');
-          popshift;
-        end;
-       if assigned($3) then
-        dispose($3,done);
-       if assigned($4) then
-        dispose($4,done);
-     } |
-     TYPEDEF type_specifier LKLAMMER dec_modifier declarator RKLAMMER maybe_space LKLAMMER argument_declaration_list RKLAMMER SEMICOLON
-     {
-       (* TYPEDEF type_specifier LKLAMMER dec_modifier declarator RKLAMMER maybe_space LKLAMMER argument_declaration_list RKLAMMER SEMICOLON *)
-       if block_type<>bt_type then
-         begin
-            if not(compactmode) then
-              writeln(outfile);
-            writeln(outfile,aktspace,'type');
-            block_type:=bt_type;
-         end;
-       no_pop:=assigned($4) and ($4^.str='no_pop');
-       shift(3);
-       (* walk through all declarations *)
-       hp:=$5;
-       if assigned(hp) then
-        begin
-          hp:=$5;
-          while assigned(hp^.p1) do
-           hp:=hp^.p1;
-          hp^.p1:=new(presobject,init_two(t_procdef,nil,$9));
-          hp:=$5;
-          if assigned(hp^.p1) and assigned(hp^.p1^.p1) then
-           begin
-             writeln(outfile);
-             (* write new type name *)
-             write(outfile,aktspace,TypeName(hp^.p2^.p),' = ');
-             shift(2);
-             write_p_a_def(outfile,hp^.p1,$2);
-             popshift;
-             (* if no_pop it is normal fpc calling convention *)
-             if is_procvar and
-                (not no_pop) then
-               write(outfile,';cdecl');
-             writeln(outfile,';');
-             flush(outfile);
-           end;
-        end;
-       popshift;
-       if assigned($2)then
-       dispose($2,done);
-       if assigned($4)then
-       dispose($4,done);
-       if assigned($5)then (* disposes also $9 *)
-       dispose($5,done);
-     } |
-     TYPEDEF type_specifier dec_modifier declarator_list SEMICOLON
-     {
-       (* TYPEDEF type_specifier dec_modifier declarator_list SEMICOLON *)
-       if block_type<>bt_type then
-         begin
-            if not(compactmode) then
-              writeln(outfile);
-            writeln(outfile,aktspace,'type');
-            block_type:=bt_type;
-         end;
-       no_pop:=assigned($3) and ($3^.str='no_pop');
-       shift(3);
-       (* Get the name to write the type definition for, try
-          to use the tag name first *)
-       if assigned($2^.p2) then
-        begin
-          ph:=$2^.p2;
-        end
-       else
-        begin
-          if not assigned($4^.p1^.p2) then
-           internalerror(4444);
-          ph:=$4^.p1^.p2;
-        end;
-       (* write type definition *)
-       is_procvar:=false;
-       writeln(outfile);
-       TN:=TypeName(ph^.p);
-       PN:=PointerName(ph^.p);
-       if UsePPointers and (Uppercase(tn)<>Uppercase(pn)) and
-          assigned($2) and ($2^.typ<>t_procdef) then
-         writeln(outfile,aktspace,PN,' = ^',TN,';');
-       (* write new type name *)
-       write(outfile,aktspace,TN,' = ');
-       shift(2);
-       write_type_specifier(outfile,$2);
-       popshift;
-       (* if no_pop it is normal fpc calling convention *)
-       if is_procvar and
-          (not no_pop) then
-         write(outfile,';cdecl');
-       writeln(outfile,';');
-       flush(outfile);
-       (* write alias names, ph points to the name already used *)
-       hp:=$4;
-       while assigned(hp) do
-        begin
-          if (hp<>ph) and assigned(hp^.p1^.p2) then
-           begin
-             PN:=TypeName(ph^.p);
-             TN:=TypeName(hp^.p1^.p2^.p);
-             if Uppercase(TN)<>Uppercase(PN) then
-              begin
-                write(outfile,aktspace,TN,' = ');
-                write_p_a_def(outfile,hp^.p1^.p1,ph);
-                writeln(outfile,';');
-                PN:=PointerName(hp^.p1^.p2^.p);
-                if UsePPointers and (Uppercase(tn)<>Uppercase(pn)) and
-                  assigned($2) and ($2^.typ<>t_procdef) then
-                 writeln(outfile,aktspace,PN,' = ^',TN,';');
-              end;
-           end;
-          hp:=hp^.next;
-        end;
-       popshift;
-       if must_write_packed_field then
-         if assigned(ph) then
-           write_packed_fields_info(outfile,$2,ph^.str)
-         else if assigned($2^.p2) then
-           write_packed_fields_info(outfile,$2,$2^.p2^.str);
-       if assigned($2)then
-       dispose($2,done);
-       if assigned($3)then
-       dispose($3,done);
-       if assigned($4)then
-       dispose($4,done);
-     } |
-     TYPEDEF dname SEMICOLON
-     {
-       if block_type<>bt_type then
-         begin
-            if not(compactmode) then
-              writeln(outfile);
-            writeln(outfile,aktspace,'type');
-            block_type:=bt_type;
-         end;
-       shift(3);
-       (* write as pointer *)
-       writeln(outfile);
-       writeln(outfile,'(* generic typedef  *)');
-       writeln(outfile,aktspace,$2^.p,' = pointer;');
-       flush(outfile);
-       popshift;
-       if assigned($2) then
-        dispose($2,done);
-     }
-     | error  error_info SEMICOLON
-      { writeln(outfile,'in declaration at line ',line_no,' *)');
-        aktspace:='';
-        in_space_define:=0;
-        in_define:=false;
-        arglevel:=0;
-        if_nb:=0;
-        aktspace:='    ';
-        space_index:=1;
-        yyerrok;}
-     ;
-
-define_dec :
-     DEFINE dname LKLAMMER enum_list RKLAMMER para_def_expr NEW_LINE
-     {
-       (* DEFINE dname LKLAMMER enum_list RKLAMMER para_def_expr NEW_LINE *)
-       if not stripinfo then
-        begin
-          writeln (outfile,aktspace,'{ was #define dname(params) para_def_expr }');
-          writeln (implemfile,aktspace,'{ was #define dname(params) para_def_expr }');
-          if assigned($4) then
-           begin
-             writeln (outfile,aktspace,'{ argument types are unknown }');
-             writeln (implemfile,aktspace,'{ argument types are unknown }');
-           end;
-          if not assigned($6^.p3) then
-           begin
-             writeln(outfile,aktspace,'{ return type might be wrong }   ');
-             writeln(implemfile,aktspace,'{ return type might be wrong }   ');
-           end;
-        end;
-       block_type:=bt_func;
-       write(outfile,aktspace,'function ',$2^.p);
-       write(implemfile,aktspace,'function ',$2^.p);
-
-       if assigned($4) then
-         begin
-            write(outfile,'(');
-            write(implemfile,'(');
-            ph:=new(presobject,init_one(t_enumdef,$4));
-            write_def_params(outfile,ph);
-            write_def_params(implemfile,ph);
-            if assigned(ph) then dispose(ph,done);
-            ph:=nil;
-            (* types are unknown *)
-            write(outfile,' : longint)');
-            write(implemfile,' : longint)');
-         end;
-       if not assigned($6^.p3) then
-         begin
-            writeln(outfile,' : longint;',aktspace,commentstr);
-            writeln(implemfile,' : longint;');
-            flush(outfile);
-         end
-       else
-         begin
-            write(outfile,' : ');
-            write_type_specifier(outfile,$6^.p3);
-            writeln(outfile,';',aktspace,commentstr);
-            flush(outfile);
-            write(implemfile,' : ');
-            write_type_specifier(implemfile,$6^.p3);
-            writeln(implemfile,';');
-         end;
-       writeln(outfile);
-       flush(outfile);
-       hp:=new(presobject,init_two(t_funcname,$2,$6));
-       write_funexpr(implemfile,hp);
-       writeln(implemfile);
-       flush(implemfile);
-       if assigned(hp)then dispose(hp,done);
-     }|
-     DEFINE dname SPACE_DEFINE NEW_LINE
-     {
-       (* DEFINE dname SPACE_DEFINE NEW_LINE *)
-       writeln(outfile,'{$define ',$2^.p,'}',aktspace,commentstr);
-       flush(outfile);
-       if assigned($2)then
-        dispose($2,done);
-     }|
-     DEFINE dname NEW_LINE
-     {
-       writeln(outfile,'{$define ',$2^.p,'}',aktspace,commentstr);
-       flush(outfile);
-       if assigned($2)then
-        dispose($2,done);
-     } |
-     DEFINE dname SPACE_DEFINE def_expr NEW_LINE
-     {
-       (* DEFINE dname SPACE_DEFINE def_expr NEW_LINE *)
-       if ($4^.typ=t_exprlist) and
-          $4^.p1^.is_const and
-          not assigned($4^.next) then
-         begin
-            if block_type<>bt_const then
-              begin
-                 writeln(outfile);
-                 writeln(outfile,aktspace,'const');
-              end;
-            block_type:=bt_const;
-            shift(3);
-            write(outfile,aktspace,$2^.p);
-            write(outfile,' = ');
-            flush(outfile);
-            write_expr(outfile,$4^.p1);
-            writeln(outfile,';',aktspace,commentstr);
-            popshift;
-            if assigned($2) then
-            dispose($2,done);
-            if assigned($4) then
-            dispose($4,done);
-         end
-       else
-         begin
-            if not stripinfo then
-             begin
-               writeln (outfile,aktspace,'{ was #define dname def_expr }');
-               writeln (implemfile,aktspace,'{ was #define dname def_expr }');
-             end;
-            block_type:=bt_func;
-            write(outfile,aktspace,'function ',$2^.p);
-            write(implemfile,aktspace,'function ',$2^.p);
-            shift(2);
-            if not assigned($4^.p3) then
-              begin
-                 writeln(outfile,' : longint;');
-                 writeln(outfile,aktspace,'  { return type might be wrong }');
-                 flush(outfile);
-                 writeln(implemfile,' : longint;');
-                 writeln(implemfile,aktspace,'  { return type might be wrong }');
-              end
-            else
-              begin
-                 write(outfile,' : ');
-                 write_type_specifier(outfile,$4^.p3);
-                 writeln(outfile,';',aktspace,commentstr);
-                 flush(outfile);
-                 write(implemfile,' : ');
-                 write_type_specifier(implemfile,$4^.p3);
-                 writeln(implemfile,';');
-              end;
-            writeln(outfile);
-            flush(outfile);
-            hp:=new(presobject,init_two(t_funcname,$2,$4));
-            write_funexpr(implemfile,hp);
-            popshift;
-            dispose(hp,done);
-            writeln(implemfile);
-            flush(implemfile);
-         end;
-     }
-     | error error_info NEW_LINE
-      { writeln(outfile,'in define line ',line_no,' *)');
-        aktspace:='';
-        in_space_define:=0;
-        in_define:=false;
-        arglevel:=0;
-        if_nb:=0;
-        aktspace:='    ';
-        space_index:=1;
-
-        yyerrok;}
-     ;
-
-closed_list : LGKLAMMER member_list RGKLAMMER
-            {$$:=$2;} |
-            error  error_info RGKLAMMER
-            { writeln(outfile,' in member_list *)');
-            yyerrok;
-            $$:=nil;
-            }
-            ;
-
-closed_enum_list : LGKLAMMER enum_list RGKLAMMER
-            {$$:=$2;} |
-            error  error_info  RGKLAMMER
-            { writeln(outfile,' in enum_list *)');
-            yyerrok;
-            $$:=nil;
-            }
-            ;
-
-special_type_specifier :
-     STRUCT dname closed_list _PACKED
-     {
-       if (not is_packed) and (not packrecords) then
-         writeln(outfile,'{$PACKRECORDS 1}');
-       is_packed:=true;
-       $$:=new(presobject,init_two(t_structdef,$3,$2));
-     } |
-     STRUCT dname closed_list
-     {
-       if (is_packed) and (not packrecords) then
-         writeln(outfile,'{$PACKRECORDS 4}');
-       is_packed:=false;
-       $$:=new(presobject,init_two(t_structdef,$3,$2));
-     } |
-     UNION dname closed_list _PACKED
-     {
-       if (not is_packed) and (not packrecords) then
-         writeln(outfile,'{$PACKRECORDS 1}');
-       is_packed:=true;
-       $$:=new(presobject,init_two(t_uniondef,$3,$2));
-     } |
-     UNION dname closed_list
-     {
-       $$:=new(presobject,init_two(t_uniondef,$3,$2));
-     } |
-     UNION dname
-     {
-       $$:=$2;
-     } |
-     STRUCT dname
-     {
-       $$:=$2;
-     } |
-     ENUM dname closed_enum_list
-     {
-       $$:=new(presobject,init_two(t_enumdef,$3,$2));
-     } |
-     ENUM dname
-     {
-       $$:=$2;
-     };
-
-type_specifier :
-      _CONST type_specifier
-      {
-        if not stripinfo then
-         writeln(outfile,'(* Const before type ignored *)');
-        $$:=$2;
-        } |
-     UNION closed_list  _PACKED
-     {
-       if (not is_packed) and (not packrecords)then
-         writeln(outfile,'{$PACKRECORDS 1}');
-       is_packed:=true;
-       $$:=new(presobject,init_one(t_uniondef,$2));
-     } |
-     UNION closed_list
-     {
-       $$:=new(presobject,init_one(t_uniondef,$2));
-     } |
-     STRUCT closed_list _PACKED
-     {
-       if (not is_packed) and (not packrecords) then
-         writeln(outfile,'{$PACKRECORDS 1}');
-       is_packed:=true;
-       $$:=new(presobject,init_one(t_structdef,$2));
-     } |
-     STRUCT closed_list
-     {
-       if (is_packed) and (not packrecords) then
-         writeln(outfile,'{$PACKRECORDS 4}');
-       is_packed:=false;
-       $$:=new(presobject,init_one(t_structdef,$2));
-     } |
-     ENUM closed_enum_list
-     {
-       $$:=new(presobject,init_one(t_enumdef,$2));
-     } |
-     special_type_specifier
-     {
-       $$:=$1;
-     } |
-     simple_type_name { $$:=$1; }
-     ;
-
-member_list : member_declaration member_list
-     {
-       $$:=new(presobject,init_one(t_memberdeclist,$1));
-       $$^.next:=$2;
-     } |
-     member_declaration
-     {
-       $$:=new(presobject,init_one(t_memberdeclist,$1));
-     }
-     ;
-
-member_declaration :
-     type_specifier declarator_list SEMICOLON
-     {
-       $$:=new(presobject,init_two(t_memberdec,$1,$2));
-     }
-     ;
-
-dname : ID { (*dname*)
-           $$:=new(presobject,init_id(act_token));
-           }
-     ;
-special_type_name :
-     SIGNED special_type_name
-     {
-       hp:=$2;
-       $$:=hp;
-       if assigned(hp) then
-        begin
-          s:=strpas(hp^.p);
-          if UseCTypesUnit then
-          begin
-            if s=cint_STR then
-              s:=csint_STR
-            else if s=cshort_STR then
-              s:=csshort_STR
-            else if s=cchar_STR then
-              s:=cschar_STR
-            else if s=clong_STR then
-              s:=cslong_STR
-            else if s=clonglong_STR then
-              s:=cslonglong_STR
-            else if s=cint8_STR then
-              s:=cint8_STR
-            else if s=cint16_STR then
-              s:=cint16_STR
-            else if s=cint32_STR then
-              s:=cint32_STR
-            else if s=cint64_STR then
-              s:=cint64_STR
-            else
-             s:='';
-          end
-          else
-          begin
-            if s=UINT_STR then
-              s:=INT_STR
-            else if s=USHORT_STR then
-              s:=SHORT_STR
-            else if s=USMALL_STR then
-              s:=SMALL_STR
-            else if s=UCHAR_STR then
-              s:=CHAR_STR
-            else if s=QWORD_STR then
-              s:=INT64_STR
-            else
-              s:='';
-          end;
-          if s<>'' then
-           hp^.setstr(s);
-        end;
-     } |
-     UNSIGNED special_type_name
-     {
-       hp:=$2;
-       $$:=hp;
-       if assigned(hp) then
-        begin
-          s:=strpas(hp^.p);
-          if UseCTypesUnit then
-          begin
-            if s=cint_STR then
-              s:=cuint_STR
-            else if s=cshort_STR then
-              s:=cushort_STR
-            else if s=cchar_STR then
-              s:=cuchar_STR
-            else if s=clong_STR then
-              s:=culong_STR
-            else if s=clonglong_STR then
-              s:=culonglong_STR
-            else if s=cint8_STR then
-              s:=cuint8_STR
-            else if s=cint16_STR then
-              s:=cuint16_STR
-            else if s=cint32_STR then
-              s:=cuint32_STR
-            else if s=cint64_STR then
-              s:=cuint64_STR
-            else
-              s:='';
-          end
-          else
-          begin
-            if s=INT_STR then
-              s:=UINT_STR
-            else if s=SHORT_STR then
-              s:=USHORT_STR
-            else if s=SMALL_STR then
-              s:=USMALL_STR
-            else if s=CHAR_STR then
-              s:=UCHAR_STR
-            else if s=INT64_STR then
-              s:=QWORD_STR
-            else
-              s:='';
-          end;
-          if s<>'' then
-           hp^.setstr(s);
-        end;
-     } |
-     INT
-     {
-     if UseCTypesUnit then
-       $$:=new(presobject,init_id(cint_STR))
-     else
-       $$:=new(presobject,init_intid(INT_STR));
-     } |
-     LONG
-     {
-     if UseCTypesUnit then
-       $$:=new(presobject,init_id(clong_STR))
-     else
-       $$:=new(presobject,init_intid(INT_STR));
-     } |
-     LONG INT
-     {
-     if UseCTypesUnit then
-       $$:=new(presobject,init_id(clong_STR))
-     else
-       $$:=new(presobject,init_intid(INT_STR));
-     } |
-     LONG LONG
-     {
-     if UseCTypesUnit then
-       $$:=new(presobject,init_id(clonglong_STR))
-     else
-       $$:=new(presobject,init_intid(INT64_STR));
-     } |
-     LONG LONG INT
-     {
-     if UseCTypesUnit then
-       $$:=new(presobject,init_id(clonglong_STR))
-     else
-       $$:=new(presobject,init_intid(INT64_STR));
-     } |
-     SHORT
-     {
-     if UseCTypesUnit then
-       $$:=new(presobject,init_id(cshort_STR))
-     else
-       $$:=new(presobject,init_intid(SMALL_STR));
-     } |
-     SHORT INT
-     {
-     if UseCTypesUnit then
-       $$:=new(presobject,init_id(csint_STR))
-     else
-       $$:=new(presobject,init_intid(SMALL_STR));
-     } |
-     INT8
-     {
-     if UseCTypesUnit then
-       $$:=new(presobject,init_id(cint8_STR))
-     else
-       $$:=new(presobject,init_intid(SHORT_STR));
-     } |
-     INT16
-     {
-     if UseCTypesUnit then
-       $$:=new(presobject,init_id(cint16_STR))
-     else
-       $$:=new(presobject,init_intid(SMALL_STR));
-     } |
-     INT32
-     {
-     if UseCTypesUnit then
-       $$:=new(presobject,init_id(cint32_STR))
-     else
-       $$:=new(presobject,init_intid(INT_STR));
-     } |
-     INT64
-     {
-     if UseCTypesUnit then
-       $$:=new(presobject,init_id(cint64_STR))
-     else
-       $$:=new(presobject,init_intid(INT64_STR));
-     } |
-     REAL
-     {
-       $$:=new(presobject,init_intid(REAL_STR));
-     } |
-     VOID
-     {
-       $$:=new(presobject,init_no(t_void));
-     } |
-     _CHAR
-     {
-     if UseCTypesUnit then
-       $$:=new(presobject,init_id(cchar_STR))
-     else
-       $$:=new(presobject,init_intid(CHAR_STR));
-     } |
-     UNSIGNED
-     {
-     if UseCTypesUnit then
-       $$:=new(presobject,init_id(cunsigned_STR))
-     else
-       $$:=new(presobject,init_intid(UINT_STR));
-     }
-     ;
-
-simple_type_name :
-     special_type_name
-     {
-     $$:=$1;
-     }
-     |
-     dname
-     {
-     $$:=$1;
-     tn:=$$^.str;
-     if removeunderscore and
-        (length(tn)>1) and (tn[1]='_') then
-      $$^.setstr(Copy(tn,2,length(tn)-1));
-     }
-     ;
-
-declarator_list :
-     declarator_list COMMA declarator
-     {
-     $$:=$1;
-     hp:=$1;
-     while assigned(hp^.next) do
-       hp:=hp^.next;
-     hp^.next:=new(presobject,init_one(t_declist,$3));
-     }|
-     error error_info COMMA declarator_list
-     {
-     writeln(outfile,' in declarator_list *)');
-     $$:=$4;
-     yyerrok;
-     }|
-     error error_info
-     {
-     writeln(outfile,' in declarator_list *)');
-     yyerrok;
-     }|
-     declarator
-     {
-     $$:=new(presobject,init_one(t_declist,$1));
-     }
-     ;
-
-argument_declaration : type_specifier declarator
-     {
-       $$:=new(presobject,init_two(t_arg,$1,$2));
-     } |
-     type_specifier STAR declarator
-     {
-       (* type_specifier STAR declarator *)
-       hp:=new(presobject,init_one(t_pointerdef,$1));
-       $$:=new(presobject,init_two(t_arg,hp,$3));
-     } |
-     type_specifier abstract_declarator
-     {
-       $$:=new(presobject,init_two(t_arg,$1,$2));
-     }
-     ;
-
-argument_declaration_list : argument_declaration
-     {
-       $$:=new(presobject,init_two(t_arglist,$1,nil));
-     } |
-     argument_declaration COMMA argument_declaration_list
-     {
-       $$:=new(presobject,init_two(t_arglist,$1,nil));
-       $$^.next:=$3;
-     } |
-     ELLIPSIS
-     {
-       $$:=new(presobject,init_two(t_arglist,ellipsisarg,nil));
-     } |
-     {
-       $$:=nil;
-     }
-     ;
-
-size_overrider :
-       _FAR
-       { $$:=new(presobject,init_id('far'));}
-       | _NEAR
-       { $$:=new(presobject,init_id('near'));}
-       | _HUGE
-       { $$:=new(presobject,init_id('huge'));}
-       ;
-
-declarator :
-      _CONST declarator
-      {
-        if not stripinfo then
-         writeln(outfile,'(* Const before declarator ignored *)');
-        $$:=$2;
-        } |
-     size_overrider STAR declarator
-     {
-       if not stripinfo then
-        writeln(outfile,aktspace,'(* ',$1^.p,' ignored *)');
-       dispose($1,done);
-       hp:=$3;
-       $$:=hp;
-       while assigned(hp^.p1) do
-         hp:=hp^.p1;
-       hp^.p1:=new(presobject,init_one(t_pointerdef,nil));
-     } |
-     STAR declarator
-     {
-       (* %prec PSTAR this was wrong!! *)
-       hp:=$2;
-       $$:=hp;
-       while assigned(hp^.p1) do
-         hp:=hp^.p1;
-       hp^.p1:=new(presobject,init_one(t_pointerdef,nil));
-     } |
-     _AND declarator %prec P_AND
-     {
-       hp:=$2;
-       $$:=hp;
-       while assigned(hp^.p1) do
-         hp:=hp^.p1;
-       hp^.p1:=new(presobject,init_one(t_addrdef,nil));
-     } |
-     dname COLON expr
-       {
-         (*  size specifier supported *)
-         hp:=new(presobject,init_one(t_size_specifier,$3));
-         $$:=new(presobject,init_three(t_dec,nil,$1,hp));
-        }|
-     dname ASSIGN expr
-       {
-         if not stripinfo then
-          writeln(outfile,'(* Warning : default value for ',$1^.p,' ignored *)');
-         hp:=new(presobject,init_one(t_default_value,$3));
-         $$:=new(presobject,init_three(t_dec,nil,$1,hp));
-        }|
-     dname
-       {
-         $$:=new(presobject,init_two(t_dec,nil,$1));
-        }|
-     declarator LKLAMMER argument_declaration_list RKLAMMER
-     {
-       hp:=$1;
-       $$:=hp;
-       while assigned(hp^.p1) do
-         hp:=hp^.p1;
-       hp^.p1:=new(presobject,init_two(t_procdef,nil,$3));
-     } |
-     declarator no_arg
-     {
-       hp:=$1;
-       $$:=hp;
-       while assigned(hp^.p1) do
-         hp:=hp^.p1;
-       hp^.p1:=new(presobject,init_two(t_procdef,nil,nil));
-     } |
-     declarator LECKKLAMMER expr RECKKLAMMER
-     {
-       hp:=$1;
-       $$:=hp;
-       while assigned(hp^.p1) do
-         hp:=hp^.p1;
-       hp^.p1:=new(presobject,init_two(t_arraydef,nil,$3));
-     } |
-     declarator LECKKLAMMER RECKKLAMMER
-     {
-       (* this is translated into a pointer *)
-       hp:=$1;
-       $$:=hp;
-       while assigned(hp^.p1) do
-         hp:=hp^.p1;
-       hp^.p1:=new(presobject,init_two(t_arraydef,nil,nil));
-     } |
-     LKLAMMER declarator RKLAMMER
-     {
-       $$:=$2;
-     }
-     ;
-
-no_arg : LKLAMMER RKLAMMER |
-        LKLAMMER VOID RKLAMMER;
-
-abstract_declarator :
-      _CONST abstract_declarator
-      {
-        if not stripinfo then
-         writeln(outfile,'(* Const before abstract_declarator ignored *)');
-        $$:=$2;
-        } |
-     size_overrider STAR abstract_declarator
-     {
-       if not stripinfo then
-        writeln(outfile,aktspace,'(* ',$1^.p,' ignored *)');
-       dispose($1,done);
-       hp:=$3;
-       $$:=hp;
-       while assigned(hp^.p1) do
-         hp:=hp^.p1;
-       hp^.p1:=new(presobject,init_one(t_pointerdef,nil));
-     } |
-     STAR abstract_declarator %prec PSTAR
-     {
-       hp:=$2;
-       $$:=hp;
-       while assigned(hp^.p1) do
-         hp:=hp^.p1;
-       hp^.p1:=new(presobject,init_one(t_pointerdef,nil));
-     } |
-     abstract_declarator LKLAMMER argument_declaration_list RKLAMMER
-     {
-       hp:=$1;
-       $$:=hp;
-       while assigned(hp^.p1) do
-         hp:=hp^.p1;
-       hp^.p1:=new(presobject,init_two(t_procdef,nil,$3));
-     } |
-     abstract_declarator no_arg
-     {
-       hp:=$1;
-       $$:=hp;
-       while assigned(hp^.p1) do
-         hp:=hp^.p1;
-       hp^.p1:=new(presobject,init_two(t_procdef,nil,nil));
-     } |
-     abstract_declarator LECKKLAMMER expr RECKKLAMMER
-     {
-       hp:=$1;
-       $$:=hp;
-       while assigned(hp^.p1) do
-         hp:=hp^.p1;
-       hp^.p1:=new(presobject,init_two(t_arraydef,nil,$3));
-     } |
-     declarator LECKKLAMMER RECKKLAMMER
-     {
-       (* this is translated into a pointer *)
-       hp:=$1;
-       $$:=hp;
-       while assigned(hp^.p1) do
-         hp:=hp^.p1;
-       hp^.p1:=new(presobject,init_two(t_arraydef,nil,nil));
-     } |
-     LKLAMMER abstract_declarator RKLAMMER
-     {
-       $$:=$2;
-     } |
-     {
-       $$:=new(presobject,init_two(t_dec,nil,nil));
-     }
-     ;
-
-expr    : shift_expr
-          { $$:=$1; }
-          ;
-
-shift_expr :
-          expr _ASSIGN expr
-          { $$:=new(presobject,init_bop(':=',$1,$3)); }
-          | expr EQUAL expr
-          { $$:=new(presobject,init_bop('=',$1,$3));}
-          | expr UNEQUAL expr
-          { $$:=new(presobject,init_bop('<>',$1,$3));}
-          | expr GT expr
-          { $$:=new(presobject,init_bop('>',$1,$3));}
-          | expr GTE expr
-          { $$:=new(presobject,init_bop('>=',$1,$3));}
-          | expr LT expr
-          { $$:=new(presobject,init_bop('<',$1,$3));}
-          | expr LTE expr
-          { $$:=new(presobject,init_bop('<=',$1,$3));}
-          | expr _PLUS expr
-          { $$:=new(presobject,init_bop('+',$1,$3));}
-          | expr MINUS expr
-          { $$:=new(presobject,init_bop('-',$1,$3));}
-               | expr STAR expr
-          { $$:=new(presobject,init_bop('*',$1,$3));}
-               | expr _SLASH expr
-          { $$:=new(presobject,init_bop('/',$1,$3));}
-               | expr _OR expr
-          { $$:=new(presobject,init_bop(' or ',$1,$3));}
-               | expr _AND expr
-          { $$:=new(presobject,init_bop(' and ',$1,$3));}
-               | expr _NOT expr
-          { $$:=new(presobject,init_bop(' not ',$1,$3));}
-               | expr _SHL expr
-          { $$:=new(presobject,init_bop(' shl ',$1,$3));}
-               | expr _SHR expr
-          { $$:=new(presobject,init_bop(' shr ',$1,$3));}
-          | expr QUESTIONMARK colon_expr
-          {
-            $3^.p1:=$1;
-            $$:=$3;
-            inc(if_nb);
-            $$^.p:=strpnew('if_local'+str(if_nb));
-          } |
-          unary_expr {$$:=$1;}
-          ;
-
-colon_expr : expr COLON expr
-       { (* if A then B else C *)
-       $$:=new(presobject,init_three(t_ifexpr,nil,$1,$3));}
-       ;
-
-maybe_empty_unary_expr :
-                  unary_expr
-                  { $$:=$1; }
-                  |
-                  { $$:=nil;}
-                  ;
-
-unary_expr:
-     dname
-     {
-     $$:=$1;
-     } |
-     special_type_name
-     {
-     $$:=$1;
-     } |
-     CSTRING
-     {
-     (* remove L prefix for widestrings *)
-     s:=act_token;
-     if Win32headers and (s[1]='L') then
-       delete(s,1,1);
-     $$:=new(presobject,init_id(''''+copy(s,2,length(s)-2)+''''));
-     } |
-     NUMBER
-     {
-     $$:=new(presobject,init_id(act_token));
-     } |
-     unary_expr POINT expr
-     {
-     $$:=new(presobject,init_bop('.',$1,$3));
-     } |
-     unary_expr DEREF expr
-     {
-     $$:=new(presobject,init_bop('^.',$1,$3));
-     } |
-     MINUS unary_expr
-     {
-     $$:=new(presobject,init_preop('-',$2));
-     }|
-     _AND unary_expr %prec R_AND
-     {
-     $$:=new(presobject,init_preop('@',$2));
-     }|
-     _NOT unary_expr
-     {
-     $$:=new(presobject,init_preop(' not ',$2));
-     } |
-     LKLAMMER dname RKLAMMER maybe_empty_unary_expr
-     {
-     if assigned($4) then
-       $$:=new(presobject,init_two(t_typespec,$2,$4))
-     else
-       $$:=$2;
-     } |
-     LKLAMMER type_specifier RKLAMMER unary_expr
-     {
-     $$:=new(presobject,init_two(t_typespec,$2,$4));
-     } |
-     LKLAMMER type_specifier STAR RKLAMMER unary_expr
-     {
-     hp:=new(presobject,init_one(t_pointerdef,$2));
-     $$:=new(presobject,init_two(t_typespec,hp,$5));
-     } |
-     LKLAMMER type_specifier size_overrider STAR RKLAMMER unary_expr
-     {
-     if not stripinfo then
-      writeln(outfile,aktspace,'(* ',$3^.p,' ignored *)');
-     dispose($3,done);
-     write_type_specifier(outfile,$2);
-     writeln(outfile,' ignored *)');
-     hp:=new(presobject,init_one(t_pointerdef,$2));
-     $$:=new(presobject,init_two(t_typespec,hp,$6));
-     } |
-     dname LKLAMMER exprlist RKLAMMER
-     {
-     hp:=new(presobject,init_one(t_exprlist,$1));
-     $$:=new(presobject,init_three(t_funexprlist,hp,$3,nil));
-     } |
-     LKLAMMER shift_expr RKLAMMER
-     {
-     $$:=$2;
-     } |
-     LKLAMMER STAR unary_expr RKLAMMER maybe_space LKLAMMER exprlist RKLAMMER
-     {
-       $$:=new(presobject,init_two(t_callop,$3,$7));
-     } |
-     dname LECKKLAMMER exprlist RECKKLAMMER
-     {
-       $$:=new(presobject,init_two(t_arrayop,$1,$3));
-     }
-     ;
-
-enum_list :
-     enum_element COMMA enum_list
-     { (*enum_element COMMA enum_list *)
-       $$:=$1;
-       $$^.next:=$3;
-      } |
-      enum_element {
-       $$:=$1;
-      } |
-      {(* empty enum list *)
-       $$:=nil;};
-
-enum_element :
-     dname _ASSIGN expr
-     { begin (*enum_element: dname _ASSIGN expr *)
-        $$:=new(presobject,init_two(t_enumlist,$1,$3));
-       end;
-     } |
-     dname
-     {
-       begin (*enum_element: dname*)
-       $$:=new(presobject,init_two(t_enumlist,$1,nil));
-       end;
-     };
-
-
-def_expr :
-     unary_expr
-     {
-         if $1^.typ=t_funexprlist then
-           $$:=$1
-         else
-           $$:=new(presobject,init_two(t_exprlist,$1,nil));
-         (* if here is a type specifier
-            we know the return type *)
-         if ($1^.typ=t_typespec) then
-           $$^.p3:=$1^.p1^.get_copy;
-     }
-     ;
-
-para_def_expr :
-     SPACE_DEFINE def_expr
-     {
-     $$:=$2;
-     } |
-     maybe_space LKLAMMER def_expr RKLAMMER
-     {
-     $$:=$3
-     }
-     ;
-
-exprlist : exprelem COMMA exprlist
-    { (*exprlist COMMA expr*)
-       $$:=$1;
-       $1^.next:=$3;
-     } |
-     exprelem
-     {
-       $$:=$1;
-     } |
-     { (* empty expression list *)
-       $$:=nil; };
-
-exprelem :
-           expr
-           {
-             $$:=new(presobject,init_one(t_exprlist,$1));
-           };
-
-%%
-
-function yylex : Integer;
-begin
-  yylex:=scan.yylex;
-  line_no:=yylineno;
-end;
-
-procedure WriteFileHeader(var headerfile: Text);
-var
- i: integer;
- originalstr: string;
-begin
-{ write unit header }
-  if not includefile then
-   begin
-     if createdynlib then
-       writeln(headerfile,'{$mode objfpc}');
-     writeln(headerfile,'unit ',unitname,';');
-     writeln(headerfile,'interface');
-     writeln(headerfile);
-     if UseCTypesUnit then
-     begin
-       writeln(headerfile,'uses');
-       writeln(headerfile,'  ctypes;');
-       writeln(headerfile);
-     end;
-     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;
-  freedynlibproc:=TStringList.Create;
-  loaddynlibproc:=TStringList.Create;
-  yydebug:=true;
-  aktspace:='';
-  block_type:=bt_no;
-  IsExtern:=false;
-{ Read commandline options }
-  ProcessOptions;
-  if not CompactMode then
-   aktspace:='  ';
-{ open input and output files }
-  assign(yyinput, inputfilename);
-  {$I-}
-   reset(yyinput);
-  {$I+}
-  if ioresult<>0 then
-   begin
-     writeln('file ',inputfilename,' not found!');
-     halt(1);
-   end;
-  { This is the intermediate output file }
-  assign(outfile, 'ext3.tmp');
-  {$I-}
-  rewrite(outfile);
-  {$I+}
-  if ioresult<>0 then
-   begin
-     writeln('file ext3.tmp could not be created!');
-     halt(1);
-   end;
-  writeln(outfile);
-{ Open tempfiles }
-  { 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! }
-  yyparse;
-{ Write implementation if needed }
-   if not(includefile) then
-    begin
-      writeln(outfile);
-      writeln(outfile,'implementation');
-      writeln(outfile);
-    end;
-   { here we have a problem if a line is longer than 255 chars !! }
-   reset(implemfile);
-   while not eof(implemfile) do
-    begin
-      readln(implemfile,SS);
-      writeln(outfile,SS);
-    end;
-
-  if createdynlib then
-    begin
-      writeln(outfile,'  uses');
-      writeln(outfile,'    SysUtils, dynlibs;');
-      writeln(outfile);
-      writeln(outfile,'  var');
-      writeln(outfile,'    hlib : tlibhandle;');
-      writeln(outfile);
-      writeln(outfile);
-      writeln(outfile,'  procedure Free',unitname,';');
-      writeln(outfile,'    begin');
-      writeln(outfile,'      FreeLibrary(hlib);');
-
-      for i:=0 to (freedynlibproc.Count-1) do
-        Writeln(outfile,'      ',freedynlibproc[i]);
-
-      writeln(outfile,'    end;');
-      writeln(outfile);
-      writeln(outfile);
-      writeln(outfile,'  procedure Load',unitname,'(lib : pchar);');
-      writeln(outfile,'    begin');
-      writeln(outfile,'      Free',unitname,';');
-      writeln(outfile,'      hlib:=LoadLibrary(lib);');
-      writeln(outfile,'      if hlib=0 then');
-      writeln(outfile,'        raise Exception.Create(format(''Could not load library: %s'',[lib]));');
-      writeln(outfile);
-      for i:=0 to (loaddynlibproc.Count-1) do
-        Writeln(outfile,'      ',loaddynlibproc[i]);
-      writeln(outfile,'    end;');
-
-      writeln(outfile);
-      writeln(outfile);
-
-      writeln(outfile,'initialization');
-      writeln(outfile,'  Load',unitname,'(''',unitname,''');');
-      writeln(outfile,'finalization');
-      writeln(outfile,'  Free',unitname,';');
-    end;
-
-   { write end of file }
-   writeln(outfile);
-   if not(includefile) then
-     writeln(outfile,'end.');
-   { close and erase tempfiles }
-  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;
-  freedynlibproc.free;
-  loaddynlibproc.free;
-end.
+%{
+program h2pas;
+
+(*
+    Copyright (c) 1998-2000 by Florian Klaempfl
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************)
+
+{$message TODO: warning Unit types is only needed due to issue 7910}
+
+   uses
+     SysUtils,types, classes,
+     options,scan,converu,lexlib,yacclib;
+
+   type
+     YYSTYPE = presobject;
+
+   const
+     SHORT_STR = 'shortint';
+     USHORT_STR = 'byte';
+     //C++ SHORT types usually map to the small types
+     SMALL_STR  = 'smallint';
+     USMALL_STR = 'word';
+     INT_STR    = 'longint';
+     UINT_STR   = 'dword';
+     CHAR_STR   = 'char';
+     UCHAR_STR  = USHORT_STR; { should we use byte or char for 'unsigned char' ?? }
+
+     INT64_STR  = 'int64';
+     QWORD_STR  = 'qword';
+     FLOAT_STR  = 'single';
+     WCHAR_STR  = 'widechar';
+
+  {ctypes strings}
+  const
+    cint8_STR       = 'cint8';
+    cuint8_STR      = 'cuint8';
+    cchar_STR       = 'cchar';
+    cschar_STR      = 'cschar';
+    cuchar_STR      = 'cuchar';
+
+    cint16_STR      = 'cint16';
+    cuint16_STR     = 'cuint16';
+    cshort_STR      = 'cshort';
+    csshort_STR     = 'csshort';
+    cushort_STR     = 'cushort';
+
+    cint32_STR      = 'cint32';
+    cuint32_STR     = 'cuint32';
+    cint_STR        = 'cint';
+    csint_STR       = 'csint';
+    cuint_STR       = 'cuint';
+
+    csigned_STR     = 'csigned';
+    cunsigned_STR   = 'cunsigned';
+
+    cint64_STR      = 'cint64';
+    cuint64_STR     = 'cuint64';
+    clonglong_STR   = 'clonglong';
+    cslonglong_STR  = 'cslonglong';
+    culonglong_STR  = 'culonglong';
+
+    cbool_STR       = 'cbool';
+
+    clong_STR       = 'clong';
+    cslong_STR      = 'cslong';
+    culong_STR      = 'culong';
+
+    cfloat_STR      = 'cfloat';
+    cdouble_STR     = 'cdouble';
+    clongdouble_STR = 'clongdouble';
+
+  const
+    MAX_CTYPESARRAY = 25;
+    CTypesArray : array [0..MAX_CTYPESARRAY] of string =
+      (cint8_STR,     cuint8_STR,
+       cchar_STR,     cschar_STR,     cuchar_STR,
+       cint16_STR,    cuint16_STR,
+       cshort_STR,    csshort_STR,    cushort_STR,
+       csigned_STR,   cunsigned_STR,
+       cint32_STR,    cuint32_STR,    cint_STR,
+       csint_STR,     cuint_STR,
+       cint64_STR,    cuint64_STR,
+       clonglong_STR, cslonglong_STR, culonglong_STR,
+
+       cbool_STR,
+       clong_STR,      cslong_STR,    culong_STR);
+
+
+  var
+     hp,ph    : presobject;
+     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;
+     freedynlibproc,
+     loaddynlibproc : tstringlist;
+
+
+(* $ define yydebug
+ compile with -dYYDEBUG to get debugging info *)
+
+  const
+     (* number of a?b:c construction in one define *)
+     if_nb : longint = 0;
+     is_packed : boolean = false;
+     is_procvar : boolean = false;
+
+  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
+             i : byte;
+          begin
+             space_array[space_index]:=space_number;
+             inc(space_index);
+             for i:=1 to space_number do
+               aktspace:=aktspace+' ';
+          end;
+
+        procedure popshift;
+          begin
+             dec(space_index);
+             if space_index<0 then
+               internalerror(20);
+             delete(aktspace,1,space_array[space_index]);
+          end;
+
+    function str(i : longint) : string;
+      var
+         s : string;
+      begin
+         system.str(i,s);
+         str:=s;
+      end;
+
+    function hexstr(i : cardinal) : string;
+
+    const
+      HexTbl : array[0..15] of char='0123456789ABCDEF';
+    var
+      str : string;
+    begin
+      str:='';
+      while i<>0 do
+        begin
+           str:=hextbl[i and $F]+str;
+           i:=i shr 4;
+        end;
+      if str='' then str:='0';
+      hexstr:='$'+str;
+    end;
+
+    function uppercase(s : string) : string;
+      var
+         i : byte;
+      begin
+         for i:=1 to length(s) do
+           s[i]:=UpCase(s[i]);
+         uppercase:=s;
+      end;
+
+    procedure write_type_specifier(var outfile:text; p : presobject);forward;
+    procedure write_p_a_def(var outfile:text; p,simple_type : presobject);forward;
+    procedure write_ifexpr(var outfile:text; p : presobject);forward;
+    procedure write_funexpr(var outfile:text; p : presobject);forward;
+
+    procedure yymsg(const msg : string);
+      begin
+         writeln('line ',line_no,': ',msg);
+      end;
+
+
+    { This converts pascal reserved words to
+      the correct syntax.
+    }
+    function FixId(const s:string):string;
+    const
+     maxtokens = 14;
+     reservedid: array[1..maxtokens] of string[14] =
+       (
+         'CLASS',
+         'DISPOSE',
+         'FUNCTION',
+         'FALSE',
+         'LABEL',
+         'NEW',
+         'PROPERTY',
+         'PROCEDURE',
+         'RECORD',
+         'REPEAT',
+         'STRING',
+         'TYPE',
+         'TRUE',
+         'UNTIL'
+       );
+      var
+        b : boolean;
+        up : string;
+        i: integer;
+      begin
+        if s='' then
+         begin
+           FixId:='';
+           exit;
+         end;
+        b:=false;
+        up:=Uppercase(s);
+        for i:=1 to maxtokens do
+          begin
+            if up=reservedid[i] then
+               begin
+                  b:=true;
+                  break;
+                end;
+          end;
+        if b then
+         FixId:='_'+s
+        else
+         FixId:=s;
+      end;
+
+
+
+    function TypeName(const s:string):string;
+      var
+        i : longint;
+      begin
+        i:=1;
+        if RemoveUnderScore and (length(s)>1) and (s[1]='_') then
+         i:=2;
+        if PrependTypes then
+         TypeName:='T'+Copy(s,i,255)
+        else
+         TypeName:=Copy(s,i,255);
+      end;
+
+    function IsACType(const s : String) : Boolean;
+    var i : Integer;
+    begin
+      IsACType := True;
+      for i := 0 to MAX_CTYPESARRAY do
+      begin
+        if s = CTypesArray[i] then
+        begin
+          Exit;
+        end;
+      end;
+      IsACType := False;
+    end;
+
+    function PointerName(const s:string):string;
+      var
+        i : longint;
+      begin
+        if UseCTypesUnit then
+        begin
+          if IsACType(s) then
+          begin
+            PointerName := 'p'+s;
+            exit;
+          end;
+        end;
+        i:=1;
+        if RemoveUnderScore and (length(s)>1) and (s[1]='_') then
+         i:=2;
+        if UsePPointers then
+        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;
+
+    procedure write_packed_fields_info(var outfile:text; p : presobject; ph : string);
+      var
+         hp1,hp2,hp3 : presobject;
+         is_sized : boolean;
+         line : string;
+         flag_index : longint;
+         name : pchar;
+         ps : byte;
+
+      begin
+         { write out the tempfile created }
+         close(tempfile);
+         reset(tempfile);
+         is_sized:=false;
+         flag_index:=0;
+         writeln(outfile);
+         writeln(outfile,aktspace,'const');
+         shift(3);
+         while not eof(tempfile) do
+           begin
+              readln(tempfile,line);
+              ps:=pos('&',line);
+              if ps>0 then
+                line:=copy(line,1,ps-1)+ph+'_'+copy(line,ps+1,255);
+              writeln(outfile,aktspace,line);
+           end;
+         writeln(outfile);
+         close(tempfile);
+         rewrite(tempfile);
+         popshift;
+         (* walk through all members *)
+         hp1 := p^.p1;
+         while assigned(hp1) do
+           begin
+              (* hp2 is t_memberdec *)
+              hp2:=hp1^.p1;
+              (*  hp3 is t_declist *)
+              hp3:=hp2^.p2;
+              while assigned(hp3) do
+                begin
+                   if assigned(hp3^.p1^.p3) and
+                      (hp3^.p1^.p3^.typ = t_size_specifier) then
+                     begin
+                        is_sized:=true;
+                        name:=hp3^.p1^.p2^.p;
+                        { get function in interface }
+                        write(outfile,aktspace,'function ',name);
+                        write(outfile,'(var a : ',ph,') : ');
+                        shift(2);
+                        write_p_a_def(outfile,hp3^.p1^.p1,hp2^.p1);
+                        writeln(outfile,';');
+                        popshift;
+                        { get function in implementation }
+                        write(implemfile,aktspace,'function ',name);
+                        write(implemfile,'(var a : ',ph,') : ');
+                        if not compactmode then
+                         shift(2);
+                        write_p_a_def(implemfile,hp3^.p1^.p1,hp2^.p1);
+                        writeln(implemfile,';');
+                        writeln(implemfile,aktspace,'begin');
+                        shift(3);
+                        write(implemfile,aktspace,name,':=(a.flag',flag_index);
+                        writeln(implemfile,' and bm_',ph,'_',name,') shr bp_',ph,'_',name,';');
+                        popshift;
+                        writeln(implemfile,aktspace,'end;');
+                        if not compactmode then
+                         popshift;
+                        writeln(implemfile,'');
+                        { set function in interface }
+                        write(outfile,aktspace,'procedure set_',name);
+                        write(outfile,'(var a : ',ph,'; __',name,' : ');
+                        shift(2);
+                        write_p_a_def(outfile,hp3^.p1^.p1,hp2^.p1);
+                        writeln(outfile,');');
+                        popshift;
+                        { set function in implementation }
+                        write(implemfile,aktspace,'procedure set_',name);
+                        write(implemfile,'(var a : ',ph,'; __',name,' : ');
+                        if not compactmode then
+                         shift(2);
+                        write_p_a_def(implemfile,hp3^.p1^.p1,hp2^.p1);
+                        writeln(implemfile,');');
+                        writeln(implemfile,aktspace,'begin');
+                        shift(3);
+                        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(implemfile,aktspace,'end;');
+                        if not compactmode then
+                         popshift;
+                        writeln(implemfile,'');
+                     end
+                   else if is_sized then
+                     begin
+                        is_sized:=false;
+                        inc(flag_index);
+                     end;
+                   hp3:=hp3^.next;
+                end;
+              hp1:=hp1^.next;
+           end;
+         must_write_packed_field:=false;
+         block_type:=bt_no;
+      end;
+
+
+    procedure write_expr(var outfile:text; p : presobject);
+      begin
+      if assigned(p) then
+        begin
+         case p^.typ of
+            t_id,
+            t_ifexpr :
+              write(outfile,FixId(p^.p));
+            t_funexprlist :
+              write_funexpr(outfile,p);
+             t_exprlist :
+               begin
+                 if assigned(p^.p1) then
+                   write_expr(outfile,p^.p1);
+                 if assigned(p^.next) then
+                   begin
+                     write(', ');
+                     write_expr(outfile,p^.next);
+                   end;
+               end;
+            t_preop : begin
+                         write(outfile,p^.p,'(');
+                         write_expr(outfile,p^.p1);
+                         write(outfile,')');
+                         flush(outfile);
+                      end;
+            t_typespec : begin
+                         write_type_specifier(outfile,p^.p1);
+                         write(outfile,'(');
+                         write_expr(outfile,p^.p2);
+                         write(outfile,')');
+                         flush(outfile);
+                      end;
+            t_bop : begin
+                       if p^.p1^.typ<>t_id then
+                         write(outfile,'(');
+                       write_expr(outfile,p^.p1);
+                       if p^.p1^.typ<>t_id then
+                       write(outfile,')');
+                       write(outfile,p^.p);
+                       if p^.p2^.typ<>t_id then
+                         write(outfile,'(');
+                       write_expr(outfile,p^.p2);
+                       if p^.p2^.typ<>t_id then
+                         write(outfile,')');
+                       flush(outfile);
+                    end;
+            t_arrayop :
+                    begin
+                      write_expr(outfile,p^.p1);
+                      write(outfile,p^.p,'[');
+                      write_expr(outfile,p^.p2);
+                      write(outfile,']');
+                      flush(outfile);
+                    end;
+            t_callop :
+                    begin
+                      write_expr(outfile,p^.p1);
+                      write(outfile,p^.p,'(');
+                      write_expr(outfile,p^.p2);
+                      write(outfile,')');
+                      flush(outfile);
+                    end;
+            else
+              begin
+                writeln(ord(p^.typ));
+                internalerror(2);
+              end;
+            end;
+         end;
+      end;
+
+
+    procedure write_ifexpr(var outfile:text; p : presobject);
+      begin
+         flush(outfile);
+         write(outfile,'if ');
+         write_expr(outfile,p^.p1);
+         writeln(outfile,' then');
+         write(outfile,aktspace,'  ');
+         write(outfile,p^.p);
+         write(outfile,':=');
+         write_expr(outfile,p^.p2);
+         writeln(outfile);
+         writeln(outfile,aktspace,'else');
+         write(outfile,aktspace,'  ');
+         write(outfile,p^.p);
+         write(outfile,':=');
+         write_expr(outfile,p^.p3);
+         writeln(outfile,';');
+         write(outfile,aktspace);
+         flush(outfile);
+      end;
+
+
+    procedure write_all_ifexpr(var outfile:text; p : presobject);
+      begin
+      if assigned(p) then
+        begin
+           case p^.typ of
+             t_id :;
+             t_preop :
+               write_all_ifexpr(outfile,p^.p1);
+             t_callop,
+             t_arrayop,
+             t_bop :
+               begin
+                  write_all_ifexpr(outfile,p^.p1);
+                  write_all_ifexpr(outfile,p^.p2);
+               end;
+             t_ifexpr :
+               begin
+                  write_all_ifexpr(outfile,p^.p1);
+                  write_all_ifexpr(outfile,p^.p2);
+                  write_all_ifexpr(outfile,p^.p3);
+                  write_ifexpr(outfile,p);
+               end;
+             t_typespec :
+                  write_all_ifexpr(outfile,p^.p2);
+             t_funexprlist,
+             t_exprlist :
+               begin
+                 if assigned(p^.p1) then
+                   write_all_ifexpr(outfile,p^.p1);
+                 if assigned(p^.next) then
+                   write_all_ifexpr(outfile,p^.next);
+               end
+             else
+               internalerror(6);
+           end;
+        end;
+      end;
+
+    procedure write_funexpr(var outfile:text; p : presobject);
+      var
+         i : longint;
+
+      begin
+      if assigned(p) then
+        begin
+           case p^.typ of
+             t_ifexpr :
+               write(outfile,p^.p);
+             t_exprlist :
+               begin
+                  write_expr(outfile,p^.p1);
+                  if assigned(p^.next) then
+                    begin
+                      write(outfile,',');
+                      write_funexpr(outfile,p^.next);
+                    end
+               end;
+             t_funcname :
+               begin
+                  if not compactmode then
+                   shift(2);
+                  if if_nb>0 then
+                    begin
+                       writeln(outfile,aktspace,'var');
+                       write(outfile,aktspace,'   ');
+                       for i:=1 to if_nb do
+                         begin
+                            write(outfile,'if_local',i);
+                            if i<if_nb then
+                              write(outfile,', ')
+                            else
+                              writeln(outfile,' : longint;');
+                         end;
+                       writeln(outfile,aktspace,'(* result types are not known *)');
+                       if_nb:=0;
+                    end;
+                  writeln(outfile,aktspace,'begin');
+                  shift(3);
+                  write(outfile,aktspace);
+                  write_all_ifexpr(outfile,p^.p2);
+                  write_expr(outfile,p^.p1);
+                  write(outfile,':=');
+                  write_funexpr(outfile,p^.p2);
+                  writeln(outfile,';');
+                  popshift;
+                  writeln(outfile,aktspace,'end;');
+                  if not compactmode then
+                   popshift;
+                  flush(outfile);
+               end;
+             t_funexprlist :
+               begin
+                  if assigned(p^.p3) then
+                    begin
+                       write_type_specifier(outfile,p^.p3);
+                       write(outfile,'(');
+                    end;
+                  if assigned(p^.p1) then
+                    write_funexpr(outfile,p^.p1);
+                  if assigned(p^.p2) then
+                    begin
+                      write(outfile,'(');
+                      write_funexpr(outfile,p^.p2);
+                      write(outfile,')');
+                    end;
+                  if assigned(p^.p3) then
+                    write(outfile,')');
+               end
+             else internalerror(5);
+           end;
+        end;
+      end;
+
+     function ellipsisarg : presobject;
+       begin
+          ellipsisarg:=new(presobject,init_two(t_arg,nil,nil));
+       end;
+
+    const
+       (* 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);
+      var
+         len,para : longint;
+         old_in_args : boolean;
+         varpara : boolean;
+         lastp : presobject;
+         hs : string;
+      begin
+         NeedEllipsisOverload:=false;
+         para:=1;
+         len:=0;
+         lastp:=nil;
+         old_in_args:=in_args;
+         in_args:=true;
+         write(outfile,'(');
+         shift(2);
+
+         (* walk through all arguments *)
+         (* p must be of type t_arglist *)
+         while assigned(p) do
+           begin
+              if p^.typ<>t_arglist then
+                internalerror(10);
+              (* is ellipsis ? *)
+              if not assigned(p^.p1^.p1) and
+                 not assigned(p^.p1^.next) then
+                begin
+                   write(outfile,'args:array of const');
+                   (* if variable number of args we must allways pop *)
+                   no_pop:=false;
+                   (* Needs 2 declarations, also one without args, becuase
+                      in C you can omit the second parameter. Default parameter
+                      doesn't help as that isn't possible with array of const *)
+                   NeedEllipsisOverload:=true;
+                   (* Remove this para *)
+                   if assigned(lastp) then
+                    lastp^.next:=nil;
+                   dispose(p,done);
+                   (* leave the loop as p isnot valid anymore *)
+                   break;
+                end
+              (* we need to correct this in the pp file after *)
+              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^.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^.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
+                        write(outfile,'var ');
+                        inc(len,4);
+                     end;
+
+                   (* write new parameter name *)
+                   if assigned(p^.p1^.p2^.p2) then
+                     begin
+                        hs:=FixId(p^.p1^.p2^.p2^.p);
+                        write(outfile,hs);
+                        inc(len,length(hs));
+                     end
+                   else
+                     begin
+                       If removeUnderscore then
+                         begin
+                           Write (outfile,'para',para);
+                           inc(Len,5);
+                         end
+                       else
+                         begin
+                           write(outfile,'_para',para);
+                           inc(Len,6);
+                         end;
+                     end;
+                   write(outfile,':');
+                   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);
+
+                end;
+              lastp:=p;
+              p:=p^.next;
+              if assigned(p) then
+                begin
+                   write(outfile,'; ');
+                   { if len>40 then : too complicated to compute }
+                   if (para mod 5) = 0 then
+                     begin
+                        writeln(outfile);
+                        write(outfile,aktspace);
+                     end;
+                end;
+              inc(para);
+           end;
+         write(outfile,')');
+         flush(outfile);
+         in_args:=old_in_args;
+         popshift;
+      end;
+
+
+
+    procedure write_p_a_def(var outfile:text; p,simple_type : presobject);
+      var
+         i : longint;
+         error : integer;
+         pointerwritten,
+         constant : boolean;
+
+      begin
+         if not(assigned(p)) then
+           begin
+              write_type_specifier(outfile,simple_type);
+              exit;
+           end;
+         case p^.typ of
+            t_pointerdef : begin
+                              (* procedure variable ? *)
+                              if assigned(p^.p1) and (p^.p1^.typ=t_procdef) then
+                                begin
+                                   is_procvar:=true;
+                                   (* distinguish between procedure and function *)
+                                   if (simple_type^.typ=t_void) and (p^.p1^.p1=nil) then
+                                     begin
+                                        write(outfile,'procedure ');
+
+                                        shift(10);
+                                        (* write arguments *)
+                                        if assigned(p^.p1^.p2) then
+                                          write_args(outfile,p^.p1^.p2);
+                                        flush(outfile);
+                                        popshift;
+                                     end
+                                   else
+                                     begin
+                                        write(outfile,'function ');
+                                        shift(9);
+                                        (* write arguments *)
+                                        if assigned(p^.p1^.p2) then
+                                          write_args(outfile,p^.p1^.p2);
+                                        write(outfile,':');
+                                        flush(outfile);
+                                        write_p_a_def(outfile,p^.p1^.p1,simple_type);
+                                        popshift;
+                                     end
+                                end
+                              else
+                                begin
+                                   (* generate "pointer" ? *)
+                                   if (simple_type^.typ=t_void) and (p^.p1=nil) then
+                                     begin
+                                       write(outfile,'pointer');
+                                       flush(outfile);
+                                     end
+                                   else
+                                     begin
+                                       pointerwritten:=false;
+                                       if (p^.p1=nil) and UsePPointers then
+                                        begin
+                                          if (simple_type^.typ=t_id) then
+                                           begin
+                                             write(outfile,PointerName(simple_type^.p));
+                                             pointerwritten:=true;
+                                           end
+                                          { structure }
+                                          else if (simple_type^.typ in [t_uniondef,t_structdef]) and
+                                                  (simple_type^.p1=nil) and (simple_type^.p2^.typ=t_id) then
+                                           begin
+                                             write(outfile,PointerName(simple_type^.p2^.p));
+                                             pointerwritten:=true;
+                                           end;
+                                        end;
+                                      if not pointerwritten then
+                                       begin
+                                         if in_args then
+                                         begin
+                                          write(outfile,'P');
+                                          pointerprefix:=true;
+                                         end
+                                         else
+                                          write(outfile,'^');
+                                         write_p_a_def(outfile,p^.p1,simple_type);
+                                         pointerprefix:=false;
+                                       end;
+                                     end;
+                                end;
+                           end;
+            t_arraydef : begin
+                             constant:=false;
+                             if assigned(p^.p2) then
+                              begin
+                                if p^.p2^.typ=t_id then
+                                 begin
+                                   val(p^.p2^.str,i,error);
+                                   if error=0 then
+                                    begin
+                                      dec(i);
+                                      constant:=true;
+                                    end;
+                                 end;
+                                if not constant then
+                                 begin
+                                   write(outfile,'array[0..(');
+                                   write_expr(outfile,p^.p2);
+                                   write(outfile,')-1] of ');
+                                 end
+                                else
+                                 begin
+                                   write(outfile,'array[0..',i,'] of ');
+                                 end;
+                              end
+                             else
+                              begin
+                                (* open array *)
+                                write(outfile,'array of ');
+                              end;
+                             flush(outfile);
+                             write_p_a_def(outfile,p^.p1,simple_type);
+                          end;
+            else internalerror(1);
+         end;
+      end;
+
+    procedure write_type_specifier(var outfile:text; p : presobject);
+      var
+         hp1,hp2,hp3,lastexpr : presobject;
+         i,l,w : longint;
+         error : integer;
+         current_power,
+         mask : cardinal;
+         flag_index : longint;
+         current_level : byte;
+         pointerwritten,
+         is_sized : boolean;
+
+      begin
+         case p^.typ of
+            t_id :
+              begin
+                if pointerprefix then
+                  if UseCtypesUnit then
+                  begin
+                    if not IsACType(p^.p) then
+                    begin
+                      PTypeList.Add('P'+p^.str);
+                    end;
+                  end
+                  else
+                   PTypeList.Add('P'+p^.str);
+                if p^.intname then
+                 write(outfile,p^.p)
+                else
+                 write(outfile,TypeName(p^.p));
+              end;
+            { what can we do with void defs  ? }
+            t_void :
+              write(outfile,'pointer');
+            t_pointerdef :
+              begin
+                 pointerwritten:=false;
+                 if (p^.p1^.typ=t_void) then
+                  begin
+                    write(outfile,'pointer');
+                    pointerwritten:=true;
+                  end
+                 else
+                  if UsePPointers then
+                   begin
+                     if (p^.p1^.typ=t_id) then
+                      begin
+                        write(outfile,PointerName(p^.p1^.p));
+                        pointerwritten:=true;
+                      end
+                     { structure }
+                     else if (p^.p1^.typ in [t_uniondef,t_structdef]) and
+                             (p^.p1^.p1=nil) and (p^.p1^.p2^.typ=t_id) then
+                      begin
+                        write(outfile,PointerName(p^.p1^.p2^.p));
+                        pointerwritten:=true;
+                      end;
+                   end;
+                 if not pointerwritten then
+                  begin
+                    if in_args then
+                    begin
+                      if UseCTypesUnit and (IsACType(p^.p1^.p)=False) then
+                        write(outfile,'P')
+                      else
+                        write(outfile,'p');
+                      pointerprefix:=true;
+                    end
+                    else
+                    begin
+                      if UseCTypesUnit and (IsACType(p^.p1^.p)=False) then
+                        write(outfile,'^')
+                      else
+                        write(outfile,'p');
+                    end;
+                    write_type_specifier(outfile,p^.p1);
+                    pointerprefix:=false;
+                  end;
+              end;
+            t_enumdef :
+              begin
+                 if (typedef_level>1) and (p^.p1=nil) and
+                    (p^.p2^.typ=t_id) then
+                   begin
+                      if pointerprefix then
+                        if UseCTypesUnit and (IsACType( p^.p2^.p )=False) then
+                          PTypeList.Add('P'+p^.p2^.str);
+                      write(outfile,p^.p2^.p);
+                   end
+                 else
+                 if not EnumToConst then
+                   begin
+                      write(outfile,'(');
+                      hp1:=p^.p1;
+                      w:=length(aktspace);
+                      while assigned(hp1) do
+                        begin
+                           write(outfile,hp1^.p1^.p);
+                           if assigned(hp1^.p2) then
+                             begin
+                                write(outfile,' := ');
+                                write_expr(outfile,hp1^.p2);
+                                w:=w+6;(* strlen(hp1^.p); *)
+                             end;
+                           w:=w+length(hp1^.p1^.str);
+                           hp1:=hp1^.next;
+                           if assigned(hp1) then
+                             write(outfile,',');
+                           if w>40 then
+                             begin
+                                 writeln(outfile);
+                                 write(outfile,aktspace);
+                                 w:=length(aktspace);
+                             end;
+                           flush(outfile);
+                        end;
+                      write(outfile,')');
+                      flush(outfile);
+                   end
+                 else
+                   begin
+                      Writeln (outfile,' Longint;');
+                      hp1:=p^.p1;
+                      l:=0;
+                      lastexpr:=nil;
+                      Writeln (outfile,copy(aktspace,1,length(aktspace)-2),'Const');
+                      while assigned(hp1) do
+                        begin
+                           write (outfile,aktspace,hp1^.p1^.p,' = ');
+                           if assigned(hp1^.p2) then
+                             begin
+                                write_expr(outfile,hp1^.p2);
+                                writeln(outfile,';');
+                                lastexpr:=hp1^.p2;
+                                if lastexpr^.typ=t_id then
+                                  begin
+                                     val(lastexpr^.str,l,error);
+                                     if error=0 then
+                                       begin
+                                          inc(l);
+                                          lastexpr:=nil;
+                                       end
+                                     else
+                                       l:=1;
+                                  end
+                                else
+                                  l:=1;
+                             end
+                           else
+                             begin
+                                if assigned(lastexpr) then
+                                  begin
+                                     write(outfile,'(');
+                                     write_expr(outfile,lastexpr);
+                                     writeln(outfile,')+',l,';');
+                                  end
+                                else
+                                  writeln (outfile,l,';');
+                                inc(l);
+                             end;
+                           hp1:=hp1^.next;
+                           flush(outfile);
+                        end;
+                      block_type:=bt_const;
+                  end;
+               end;
+            t_structdef :
+              begin
+                 inc(typedef_level);
+                 flag_index:=-1;
+                 is_sized:=false;
+                 current_level:=0;
+                 if ((in_args) or (typedef_level>1)) and
+                    (p^.p1=nil) and (p^.p2^.typ=t_id) then
+                   begin
+                      if pointerprefix then
+                        if UseCTypesUnit and (IsACType(p^.p2^.str)=false) then
+                          PTypeList.Add('P'+p^.p2^.str);
+                     write(outfile,TypeName(p^.p2^.p));
+                   end
+                 else
+                   begin
+                      if packrecords then
+                        writeln(outfile,'packed record')
+                      else
+                        writeln(outfile,'record');
+                      shift(3);
+                      hp1:=p^.p1;
+
+                      (* walk through all members *)
+                      while assigned(hp1) do
+                        begin
+                           (* hp2 is t_memberdec *)
+                           hp2:=hp1^.p1;
+                           (*  hp3 is t_declist *)
+                           hp3:=hp2^.p2;
+                           while assigned(hp3) do
+                             begin
+                                if not assigned(hp3^.p1^.p3) or
+                                   (hp3^.p1^.p3^.typ <> t_size_specifier) then
+                                  begin
+                                     if is_sized then
+                                       begin
+                                          if current_level <= 16 then
+                                            writeln(outfile,'word;')
+                                          else if current_level <= 32 then
+                                            writeln(outfile,'longint;')
+                                          else
+                                            internalerror(11);
+                                          is_sized:=false;
+                                       end;
+
+                                     write(outfile,aktspace,FixId(hp3^.p1^.p2^.p));
+                                     write(outfile,' : ');
+                                     shift(2);
+                                     write_p_a_def(outfile,hp3^.p1^.p1,hp2^.p1);
+                                     popshift;
+                                  end;
+                                { size specifier  or default value ? }
+                                if assigned(hp3^.p1^.p3) then
+                                  begin
+                                     { we could use mask to implement this }
+                                     { because we need to respect the positions }
+                                     if hp3^.p1^.p3^.typ = t_size_specifier then
+                                       begin
+                                          if not is_sized then
+                                            begin
+                                               current_power:=1;
+                                               current_level:=0;
+                                               inc(flag_index);
+                                               write(outfile,aktspace,'flag',flag_index,' : ');
+                                            end;
+                                          must_write_packed_field:=true;
+                                          is_sized:=true;
+                                          { can it be something else than a constant ? }
+                                          { it can be a macro !! }
+                                          if hp3^.p1^.p3^.p1^.typ=t_id then
+                                            begin
+                                              val(hp3^.p1^.p3^.p1^.str,l,error);
+                                              if error=0 then
+                                                begin
+                                                   mask:=0;
+                                                   for i:=1 to l do
+                                                     begin
+                                                        inc(mask,current_power);
+                                                        current_power:=current_power*2;
+                                                     end;
+                                                   write(tempfile,'bm_&',hp3^.p1^.p2^.p);
+                                                   writeln(tempfile,' = ',hexstr(mask),';');
+                                                   write(tempfile,'bp_&',hp3^.p1^.p2^.p);
+                                                   writeln(tempfile,' = ',current_level,';');
+                                                   current_level:=current_level + l;
+                                                   { go to next flag if 31 }
+                                                   if current_level = 32 then
+                                                     begin
+                                                        write(outfile,'longint');
+                                                        is_sized:=false;
+                                                     end;
+                                                end;
+                                            end;
+
+                                       end
+                                     else if hp3^.p1^.p3^.typ = t_default_value then
+                                       begin
+                                          write(outfile,'{=');
+                                          write_expr(outfile,hp3^.p1^.p3^.p1);
+                                          write(outfile,' ignored}');
+                                       end;
+                                  end;
+                                if not is_sized then
+                                  begin
+                                     if is_procvar then
+                                       begin
+                                          if not no_pop then
+                                            begin
+                                               write(outfile,';cdecl');
+                                               no_pop:=true;
+                                            end;
+                                          is_procvar:=false;
+                                       end;
+                                     writeln(outfile,';');
+                                  end;
+                                hp3:=hp3^.next;
+                             end;
+                           hp1:=hp1^.next;
+                        end;
+                      if is_sized then
+                        begin
+                           if current_level <= 16 then
+                             writeln(outfile,'word;')
+                           else if current_level <= 32 then
+                             writeln(outfile,'longint;')
+                           else
+                             internalerror(11);
+                           is_sized:=false;
+                        end;
+                      popshift;
+                      write(outfile,aktspace,'end');
+                      flush(outfile);
+                   end;
+                 dec(typedef_level);
+              end;
+            t_uniondef :
+              begin
+                 inc(typedef_level);
+                 if (typedef_level>1) and (p^.p1=nil) and
+                    (p^.p2^.typ=t_id) then
+                   begin
+                      write(outfile,p^.p2^.p);
+                   end
+                 else
+                   begin
+                      inc(typedef_level);
+                      if packrecords then
+                        writeln(outfile,'packed record')
+                      else
+                        writeln(outfile,'record');
+                      shift(2);
+                      writeln(outfile,aktspace,'case longint of');
+                      shift(3);
+                      l:=0;
+                      hp1:=p^.p1;
+
+                      (* walk through all members *)
+                      while assigned(hp1) do
+                        begin
+                           (* hp2 is t_memberdec *)
+                           hp2:=hp1^.p1;
+                           (* hp3 is t_declist *)
+                           hp3:=hp2^.p2;
+                           while assigned(hp3) do
+                             begin
+                                write(outfile,aktspace,l,' : ( ');
+                                write(outfile,FixId(hp3^.p1^.p2^.p),' : ');
+                                shift(2);
+                                write_p_a_def(outfile,hp3^.p1^.p1,hp2^.p1);
+                                popshift;
+                                writeln(outfile,' );');
+                                hp3:=hp3^.next;
+                                inc(l);
+                             end;
+                           hp1:=hp1^.next;
+                        end;
+                      popshift;
+                      write(outfile,aktspace,'end');
+                      popshift;
+                      flush(outfile);
+                      dec(typedef_level);
+                   end;
+                 dec(typedef_level);
+              end;
+            else
+              internalerror(3);
+         end;
+      end;
+
+    procedure write_def_params(var outfile:text; p : presobject);
+      var
+         hp1 : presobject;
+      begin
+         case p^.typ of
+            t_enumdef : begin
+                           hp1:=p^.p1;
+                           while assigned(hp1) do
+                             begin
+                                write(outfile,FixId(hp1^.p1^.p));
+                                hp1:=hp1^.next;
+                                if assigned(hp1) then
+                                  write(outfile,',')
+                                else
+                                  write(outfile);
+                                flush(outfile);
+                             end;
+                           flush(outfile);
+                        end;
+         else internalerror(4);
+         end;
+      end;
+
+
+    procedure write_statement_block(var outfile:text; p : presobject);
+      begin
+        writeln(outfile,aktspace,'begin');
+        while assigned(p) do
+          begin
+            shift(2);
+            if assigned(p^.p1) then
+              begin
+                case p^.p1^.typ of
+                  t_whilenode:
+                    begin
+                      write(outfile,aktspace,'while ');
+                      write_expr(outfile,p^.p1^.p1);
+                      writeln(outfile,' do');
+                      shift(2);
+                      write_statement_block(outfile,p^.p1^.p2);
+                      popshift;
+                    end;
+                  else
+                    begin
+                      write(outfile,aktspace);
+                      write_expr(outfile,p^.p1);
+                      writeln(outfile,';');
+                    end;
+                end;
+              end;
+            p:=p^.next;
+            popshift;
+          end;
+        writeln(outfile,aktspace,'end;');
+      end;
+
+%}
+
+%token _WHILE _FOR _DO _GOTO _CONTINUE _BREAK
+%token TYPEDEF DEFINE
+%token COLON SEMICOLON COMMA
+%token LKLAMMER RKLAMMER LECKKLAMMER RECKKLAMMER
+%token LGKLAMMER RGKLAMMER
+%token STRUCT UNION ENUM
+%token ID NUMBER CSTRING
+%token SHORT UNSIGNED LONG INT FLOAT _CHAR
+%token VOID _CONST
+%token _FAR _HUGE _NEAR
+%token NEW_LINE SPACE_DEFINE
+%token EXTERN STDCALL CDECL CALLBACK PASCAL WINAPI APIENTRY WINGDIAPI SYS_TRAP
+%token _PACKED
+%token ELLIPSIS
+%right _ASSIGN
+%right R_AND
+%left EQUAL UNEQUAL GT LT GTE LTE
+%left QUESTIONMARK COLON
+%left _OR
+%left _AND
+%left _PLUS MINUS
+%left _SHR _SHL
+%left STAR _SLASH
+%right _NOT
+%right LKLAMMER
+%right PSTAR
+%right P_AND
+%right LECKKLAMMER
+%left POINT DEREF
+%left COMMA
+%left STICK
+%token SIGNED
+%token INT8 INT16 INT32 INT64
+%%
+
+file : declaration_list
+     ;
+
+maybe_space :
+     SPACE_DEFINE
+     {
+       $$:=nil;
+     } |
+     {
+       $$:=nil;
+     }
+     ;
+
+error_info : {
+                  writeln(outfile,'(* error ');
+                  writeln(outfile,yyline);
+             };
+
+declaration_list : declaration_list  declaration
+     {  if yydebug then writeln('declaration reduced at line ',line_no);
+        if yydebug then writeln(outfile,'(* declaration reduced *)');
+     }
+     | declaration_list define_dec
+     {  if yydebug then writeln('define declaration reduced at line ',line_no);
+        if yydebug then writeln(outfile,'(* define declaration reduced *)');
+     }
+     | declaration
+     {  if yydebug then writeln('declaration reduced at line ',line_no);
+     }
+     | define_dec
+     {  if yydebug then writeln('define declaration reduced at line ',line_no);
+     }
+     ;
+
+dec_specifier :
+     EXTERN { $$:=new(presobject,init_id('extern')); }
+     |{ $$:=new(presobject,init_id('intern')); }
+     ;
+
+dec_modifier :
+     STDCALL { $$:=new(presobject,init_id('no_pop')); }
+     | CDECL { $$:=new(presobject,init_id('cdecl')); }
+     | CALLBACK { $$:=new(presobject,init_id('no_pop')); }
+     | PASCAL { $$:=new(presobject,init_id('no_pop')); }
+     | WINAPI { $$:=new(presobject,init_id('no_pop')); }
+     | APIENTRY { $$:=new(presobject,init_id('no_pop')); }
+     | WINGDIAPI { $$:=new(presobject,init_id('no_pop')); }
+     | { $$:=nil }
+     ;
+
+systrap_specifier:
+     SYS_TRAP LKLAMMER dname RKLAMMER { $$:=$3; }
+     | { $$:=nil; }
+     ;
+
+statement :
+     expr SEMICOLON { $$:=$1; } |
+     _WHILE LKLAMMER expr RKLAMMER statement_list { $$:=new(presobject,init_two(t_whilenode,$3,$5)); }
+     ;
+
+
+statement_list : statement statement_list
+     {
+       $$:=new(presobject,init_one(t_statement_list,$1));
+       $$^.next:=$2;
+     } |
+     statement
+     {
+       $$:=new(presobject,init_one(t_statement_list,$1));
+     } |
+     SEMICOLON
+     {
+       $$:=new(presobject,init_one(t_statement_list,nil));
+     } |
+     {
+       $$:=new(presobject,init_one(t_statement_list,nil));
+     }
+     ;
+
+statement_block :
+     LGKLAMMER statement_list RGKLAMMER { $$:=$2; }
+     ;
+
+declaration :
+     dec_specifier type_specifier dec_modifier declarator_list statement_block
+     {
+       IsExtern:=false;
+       (* by default we must pop the args pushed on stack *)
+       no_pop:=false;
+       if (assigned($4)and assigned($4^.p1)and assigned($4^.p1^.p1))
+         and ($4^.p1^.p1^.typ=t_procdef) then
+          begin
+             repeat
+             If UseLib then
+               IsExtern:=true
+             else
+               IsExtern:=assigned($1)and($1^.str='extern');
+             no_pop:=assigned($3) and ($3^.str='no_pop');
+
+             if (block_type<>bt_func) and not(createdynlib) then
+               begin
+                 writeln(outfile);
+                 block_type:=bt_func;
+               end;
+
+             (* dyn. procedures must be put into a var block *)
+             if createdynlib then
+               begin
+                 if (block_type<>bt_var) then
+                  begin
+                     if not(compactmode) then
+                       writeln(outfile);
+                     writeln(outfile,aktspace,'var');
+                     block_type:=bt_var;
+                  end;
+                 shift(2);
+               end;
+             if not CompactMode then
+              begin
+                write(outfile,aktspace);
+                if not IsExtern then
+                 write(implemfile,aktspace);
+              end;
+             (* distinguish between procedure and function *)
+             if assigned($2) then
+              if ($2^.typ=t_void) and ($4^.p1^.p1^.p1=nil) then
+               begin
+                 if createdynlib then
+                   begin
+                     write(outfile,$4^.p1^.p2^.p,' : procedure');
+                   end
+                 else
+                   begin
+                     shift(10);
+                     write(outfile,'procedure ',$4^.p1^.p2^.p);
+                   end;
+                 if assigned($4^.p1^.p1^.p2) then
+                   write_args(outfile,$4^.p1^.p1^.p2);
+                 if createdynlib then
+                    begin
+                      loaddynlibproc.add('pointer('+$4^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+$4^.p1^.p2^.p+''');');
+                      freedynlibproc.add($4^.p1^.p2^.p+':=nil;');
+                    end
+                  else if not IsExtern then
+                  begin
+                    write(implemfile,'procedure ',$4^.p1^.p2^.p);
+                    if assigned($4^.p1^.p1^.p2) then
+                     write_args(implemfile,$4^.p1^.p1^.p2);
+                  end;
+               end
+             else
+               begin
+                 if createdynlib then
+                   begin
+                     write(outfile,$4^.p1^.p2^.p,' : function');
+                   end
+                 else
+                   begin
+                     shift(9);
+                     write(outfile,'function ',$4^.p1^.p2^.p);
+                   end;
+
+                  if assigned($4^.p1^.p1^.p2) then
+                    write_args(outfile,$4^.p1^.p1^.p2);
+                  write(outfile,':');
+                  write_p_a_def(outfile,$4^.p1^.p1^.p1,$2);
+                  if createdynlib then
+                    begin
+                      loaddynlibproc.add('pointer('+$4^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+$4^.p1^.p2^.p+''');');
+                      freedynlibproc.add($4^.p1^.p2^.p+':=nil;');
+                    end
+                  else if not IsExtern then
+                   begin
+                     write(implemfile,'function ',$4^.p1^.p2^.p);
+                     if assigned($4^.p1^.p1^.p2) then
+                      write_args(implemfile,$4^.p1^.p1^.p2);
+                     write(implemfile,':');
+                     write_p_a_def(implemfile,$4^.p1^.p1^.p1,$2);
+                   end;
+               end;
+             (* No CDECL in interface for Uselib *)
+             if IsExtern and (not no_pop) then
+               write(outfile,';cdecl');
+             popshift;
+             if createdynlib then
+               begin
+                 writeln(outfile,';');
+               end
+             else if UseLib then
+               begin
+                 if IsExtern then
+                  begin
+                    write (outfile,';external');
+                    If UseName then
+                     Write(outfile,' External_library name ''',$4^.p1^.p2^.p,'''');
+                  end;
+                 writeln(outfile,';');
+               end
+             else
+               begin
+                 writeln(outfile,';');
+                 if not IsExtern then
+                  begin
+                    writeln(implemfile,';');
+                    shift(2);
+                    if $5^.typ=t_statement_list then
+                      write_statement_block(implemfile,$5);
+                    popshift;
+                  end;
+               end;
+             IsExtern:=false;
+             if not(compactmode) and not(createdynlib) then
+              writeln(outfile);
+            until not NeedEllipsisOverload;
+          end
+        else (* $4^.p1^.p1^.typ=t_procdef *)
+        if assigned($4)and assigned($4^.p1) then
+          begin
+             shift(2);
+             if block_type<>bt_var then
+               begin
+                  if not(compactmode) then
+                    writeln(outfile);
+                  writeln(outfile,aktspace,'var');
+               end;
+             block_type:=bt_var;
+
+             shift(3);
+
+             IsExtern:=assigned($1)and($1^.str='extern');
+             (* walk through all declarations *)
+             hp:=$4;
+             while assigned(hp) and assigned(hp^.p1) do
+               begin
+                  (* write new var name *)
+                  if assigned(hp^.p1^.p2) and assigned(hp^.p1^.p2^.p) then
+                    write(outfile,aktspace,hp^.p1^.p2^.p);
+                  write(outfile,' : ');
+                  shift(2);
+                  (* write its type *)
+                  write_p_a_def(outfile,hp^.p1^.p1,$2);
+                  if assigned(hp^.p1^.p2)and assigned(hp^.p1^.p2^.p)then
+                    begin
+                       if isExtern then
+                         write(outfile,';cvar;external')
+                       else
+                         write(outfile,';cvar;public');
+                    end;
+                  writeln(outfile,';');
+                  popshift;
+                  hp:=hp^.p2;
+               end;
+             popshift;
+             popshift;
+          end;
+        if assigned($1) then
+          dispose($1,done);
+        if assigned($2) then
+          dispose($2,done);
+        if assigned($3) then
+          dispose($3,done);
+        if assigned($4) then
+          dispose($4,done);
+        if assigned($5) then
+          dispose($5,done);
+     }
+     | dec_specifier type_specifier dec_modifier declarator_list systrap_specifier SEMICOLON
+     {
+       IsExtern:=false;
+       (* by default we must pop the args pushed on stack *)
+       no_pop:=false;
+       if (assigned($4)and assigned($4^.p1)and assigned($4^.p1^.p1))
+         and ($4^.p1^.p1^.typ=t_procdef) then
+          begin
+             repeat
+             If UseLib then
+               IsExtern:=true
+             else
+               IsExtern:=assigned($1)and($1^.str='extern');
+             no_pop:=assigned($3) and ($3^.str='no_pop');
+
+             if (block_type<>bt_func) and not(createdynlib) then
+               begin
+                 writeln(outfile);
+                 block_type:=bt_func;
+               end;
+
+             (* dyn. procedures must be put into a var block *)
+             if createdynlib then
+               begin
+                 if (block_type<>bt_var) then
+                  begin
+                     if not(compactmode) then
+                       writeln(outfile);
+                     writeln(outfile,aktspace,'var');
+                     block_type:=bt_var;
+                  end;
+                 shift(2);
+               end;
+             if not CompactMode then
+              begin
+                write(outfile,aktspace);
+                if not IsExtern then
+                 write(implemfile,aktspace);
+              end;
+             (* distinguish between procedure and function *)
+             if assigned($2) then
+              if ($2^.typ=t_void) and ($4^.p1^.p1^.p1=nil) then
+               begin
+                 if createdynlib then
+                   begin
+                     write(outfile,$4^.p1^.p2^.p,' : procedure');
+                   end
+                 else
+                   begin
+                     shift(10);
+                     write(outfile,'procedure ',$4^.p1^.p2^.p);
+                   end;
+                 if assigned($4^.p1^.p1^.p2) then
+                   write_args(outfile,$4^.p1^.p1^.p2);
+                 if createdynlib then
+                    begin
+                      loaddynlibproc.add('pointer('+$4^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+$4^.p1^.p2^.p+''');');
+                      freedynlibproc.add($4^.p1^.p2^.p+':=nil;');
+                    end
+                  else if not IsExtern then
+                  begin
+                    write(implemfile,'procedure ',$4^.p1^.p2^.p);
+                    if assigned($4^.p1^.p1^.p2) then
+                     write_args(implemfile,$4^.p1^.p1^.p2);
+                  end;
+               end
+             else
+               begin
+                 if createdynlib then
+                   begin
+                     write(outfile,$4^.p1^.p2^.p,' : function');
+                   end
+                 else
+                   begin
+                     shift(9);
+                     write(outfile,'function ',$4^.p1^.p2^.p);
+                   end;
+
+                  if assigned($4^.p1^.p1^.p2) then
+                    write_args(outfile,$4^.p1^.p1^.p2);
+                  write(outfile,':');
+                  write_p_a_def(outfile,$4^.p1^.p1^.p1,$2);
+                  if createdynlib then
+                    begin
+                      loaddynlibproc.add('pointer('+$4^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+$4^.p1^.p2^.p+''');');
+                      freedynlibproc.add($4^.p1^.p2^.p+':=nil;');
+                    end
+                  else if not IsExtern then
+                   begin
+                     write(implemfile,'function ',$4^.p1^.p2^.p);
+                     if assigned($4^.p1^.p1^.p2) then
+                      write_args(implemfile,$4^.p1^.p1^.p2);
+                     write(implemfile,':');
+                     write_p_a_def(implemfile,$4^.p1^.p1^.p1,$2);
+                   end;
+               end;
+             if assigned($5) then
+               write(outfile,';systrap ',$5^.p);
+             (* No CDECL in interface for Uselib *)
+             if IsExtern and (not no_pop) then
+               write(outfile,';cdecl');
+             popshift;
+             if createdynlib then
+               begin
+                 writeln(outfile,';');
+               end
+             else if UseLib then
+               begin
+                 if IsExtern then
+                  begin
+                    write (outfile,';external');
+                    If UseName then
+                     Write(outfile,' External_library name ''',$4^.p1^.p2^.p,'''');
+                  end;
+                 writeln(outfile,';');
+               end
+             else
+               begin
+                 writeln(outfile,';');
+                 if not IsExtern then
+                  begin
+                    writeln(implemfile,';');
+                    writeln(implemfile,aktspace,'begin');
+                    writeln(implemfile,aktspace,'  { You must implement this function }');
+                    writeln(implemfile,aktspace,'end;');
+                  end;
+               end;
+             IsExtern:=false;
+             if not(compactmode) and not(createdynlib) then
+              writeln(outfile);
+            until not NeedEllipsisOverload;
+          end
+        else (* $4^.p1^.p1^.typ=t_procdef *)
+        if assigned($4)and assigned($4^.p1) then
+          begin
+             shift(2);
+             if block_type<>bt_var then
+               begin
+                  if not(compactmode) then
+                    writeln(outfile);
+                  writeln(outfile,aktspace,'var');
+               end;
+             block_type:=bt_var;
+
+             shift(3);
+
+             IsExtern:=assigned($1)and($1^.str='extern');
+             (* walk through all declarations *)
+             hp:=$4;
+             while assigned(hp) and assigned(hp^.p1) do
+               begin
+                  (* write new var name *)
+                  if assigned(hp^.p1^.p2) and assigned(hp^.p1^.p2^.p) then
+                    write(outfile,aktspace,hp^.p1^.p2^.p);
+                  write(outfile,' : ');
+                  shift(2);
+                  (* write its type *)
+                  write_p_a_def(outfile,hp^.p1^.p1,$2);
+                  if assigned(hp^.p1^.p2)and assigned(hp^.p1^.p2^.p)then
+                    begin
+                       if isExtern then
+                         write(outfile,';cvar;external')
+                       else
+                         write(outfile,';cvar;public');
+                    end;
+                  writeln(outfile,';');
+                  popshift;
+                  hp:=hp^.p2;
+               end;
+             popshift;
+             popshift;
+          end;
+        if assigned($1)then  dispose($1,done);
+        if assigned($2)then  dispose($2,done);
+        if assigned($4)then  dispose($4,done);
+     } |
+     special_type_specifier SEMICOLON
+     {
+       if block_type<>bt_type then
+         begin
+            if not(compactmode) then
+              writeln(outfile);
+            writeln(outfile,aktspace,'type');
+            block_type:=bt_type;
+         end;
+       shift(3);
+       if ( yyv[yysp-1]^.p2  <> nil ) then
+         begin
+         (* write new type name *)
+         TN:=TypeName($1^.p2^.p);
+         PN:=PointerName($1^.p2^.p);
+         (* define a Pointer type also for structs *)
+         if UsePPointers and (Uppercase(tn)<>Uppercase(pn)) and
+            assigned($1) and ($1^.typ in [t_uniondef,t_structdef]) then
+          writeln(outfile,aktspace,PN,' = ^',TN,';');
+         write(outfile,aktspace,TN,' = ');
+         shift(2);
+         hp:=$1;
+         write_type_specifier(outfile,hp);
+         popshift;
+         (* enum_to_const can make a switch to const *)
+         if block_type=bt_type then
+          writeln(outfile,';');
+         writeln(outfile);
+         flush(outfile);
+         popshift;
+         if must_write_packed_field then
+           write_packed_fields_info(outfile,hp,TN);
+         if assigned(hp) then
+           dispose(hp,done)
+         end
+       else
+         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;');
+         writeln(outfile);
+         popshift;
+         end;
+     } |
+     TYPEDEF STRUCT dname dname SEMICOLON
+     {
+       (* TYPEDEF STRUCT dname dname SEMICOLON *)
+       if block_type<>bt_type then
+         begin
+            if not(compactmode) then
+              writeln(outfile);
+            writeln(outfile,aktspace,'type');
+            block_type:=bt_type;
+         end;
+       PN:=TypeName($3^.p);
+       TN:=TypeName($4^.p);
+       if Uppercase(tn)<>Uppercase(pn) then
+        begin
+          shift(3);
+          writeln(outfile,aktspace,PN,' = ',TN,';');
+          popshift;
+        end;
+       if assigned($3) then
+        dispose($3,done);
+       if assigned($4) then
+        dispose($4,done);
+     } |
+     TYPEDEF type_specifier LKLAMMER dec_modifier declarator RKLAMMER maybe_space LKLAMMER argument_declaration_list RKLAMMER SEMICOLON
+     {
+       (* TYPEDEF type_specifier LKLAMMER dec_modifier declarator RKLAMMER maybe_space LKLAMMER argument_declaration_list RKLAMMER SEMICOLON *)
+       if block_type<>bt_type then
+         begin
+            if not(compactmode) then
+              writeln(outfile);
+            writeln(outfile,aktspace,'type');
+            block_type:=bt_type;
+         end;
+       no_pop:=assigned($4) and ($4^.str='no_pop');
+       shift(3);
+       (* walk through all declarations *)
+       hp:=$5;
+       if assigned(hp) then
+        begin
+          hp:=$5;
+          while assigned(hp^.p1) do
+           hp:=hp^.p1;
+          hp^.p1:=new(presobject,init_two(t_procdef,nil,$9));
+          hp:=$5;
+          if assigned(hp^.p1) and assigned(hp^.p1^.p1) then
+           begin
+             writeln(outfile);
+             (* write new type name *)
+             write(outfile,aktspace,TypeName(hp^.p2^.p),' = ');
+             shift(2);
+             write_p_a_def(outfile,hp^.p1,$2);
+             popshift;
+             (* if no_pop it is normal fpc calling convention *)
+             if is_procvar and
+                (not no_pop) then
+               write(outfile,';cdecl');
+             writeln(outfile,';');
+             flush(outfile);
+           end;
+        end;
+       popshift;
+       if assigned($2)then
+       dispose($2,done);
+       if assigned($4)then
+       dispose($4,done);
+       if assigned($5)then (* disposes also $9 *)
+       dispose($5,done);
+     } |
+     TYPEDEF type_specifier dec_modifier declarator_list SEMICOLON
+     {
+       (* TYPEDEF type_specifier dec_modifier declarator_list SEMICOLON *)
+       if block_type<>bt_type then
+         begin
+            if not(compactmode) then
+              writeln(outfile);
+            writeln(outfile,aktspace,'type');
+            block_type:=bt_type;
+         end;
+       no_pop:=assigned($3) and ($3^.str='no_pop');
+       shift(3);
+       (* Get the name to write the type definition for, try
+          to use the tag name first *)
+       if assigned($2^.p2) then
+        begin
+          ph:=$2^.p2;
+        end
+       else
+        begin
+          if not assigned($4^.p1^.p2) then
+           internalerror(4444);
+          ph:=$4^.p1^.p2;
+        end;
+       (* write type definition *)
+       is_procvar:=false;
+       writeln(outfile);
+       TN:=TypeName(ph^.p);
+       PN:=PointerName(ph^.p);
+       if UsePPointers and (Uppercase(tn)<>Uppercase(pn)) and
+          assigned($2) and ($2^.typ<>t_procdef) then
+         writeln(outfile,aktspace,PN,' = ^',TN,';');
+       (* write new type name *)
+       write(outfile,aktspace,TN,' = ');
+       shift(2);
+       write_type_specifier(outfile,$2);
+       popshift;
+       (* if no_pop it is normal fpc calling convention *)
+       if is_procvar and
+          (not no_pop) then
+         write(outfile,';cdecl');
+       writeln(outfile,';');
+       flush(outfile);
+       (* write alias names, ph points to the name already used *)
+       hp:=$4;
+       while assigned(hp) do
+        begin
+          if (hp<>ph) and assigned(hp^.p1^.p2) then
+           begin
+             PN:=TypeName(ph^.p);
+             TN:=TypeName(hp^.p1^.p2^.p);
+             if Uppercase(TN)<>Uppercase(PN) then
+              begin
+                write(outfile,aktspace,TN,' = ');
+                write_p_a_def(outfile,hp^.p1^.p1,ph);
+                writeln(outfile,';');
+                PN:=PointerName(hp^.p1^.p2^.p);
+                if UsePPointers and (Uppercase(tn)<>Uppercase(pn)) and
+                  assigned($2) and ($2^.typ<>t_procdef) then
+                 writeln(outfile,aktspace,PN,' = ^',TN,';');
+              end;
+           end;
+          hp:=hp^.next;
+        end;
+       popshift;
+       if must_write_packed_field then
+         if assigned(ph) then
+           write_packed_fields_info(outfile,$2,ph^.str)
+         else if assigned($2^.p2) then
+           write_packed_fields_info(outfile,$2,$2^.p2^.str);
+       if assigned($2)then
+       dispose($2,done);
+       if assigned($3)then
+       dispose($3,done);
+       if assigned($4)then
+       dispose($4,done);
+     } |
+     TYPEDEF dname SEMICOLON
+     {
+       if block_type<>bt_type then
+         begin
+            if not(compactmode) then
+              writeln(outfile);
+            writeln(outfile,aktspace,'type');
+            block_type:=bt_type;
+         end;
+       shift(3);
+       (* write as pointer *)
+       writeln(outfile);
+       writeln(outfile,'(* generic typedef  *)');
+       writeln(outfile,aktspace,$2^.p,' = pointer;');
+       flush(outfile);
+       popshift;
+       if assigned($2) then
+        dispose($2,done);
+     }
+     | error  error_info SEMICOLON
+      { writeln(outfile,'in declaration at line ',line_no,' *)');
+        aktspace:='';
+        in_space_define:=0;
+        in_define:=false;
+        arglevel:=0;
+        if_nb:=0;
+        aktspace:='    ';
+        space_index:=1;
+        yyerrok;}
+     ;
+
+define_dec :
+     DEFINE dname LKLAMMER enum_list RKLAMMER para_def_expr NEW_LINE
+     {
+       (* DEFINE dname LKLAMMER enum_list RKLAMMER para_def_expr NEW_LINE *)
+       if not stripinfo then
+        begin
+          writeln (outfile,aktspace,'{ was #define dname(params) para_def_expr }');
+          writeln (implemfile,aktspace,'{ was #define dname(params) para_def_expr }');
+          if assigned($4) then
+           begin
+             writeln (outfile,aktspace,'{ argument types are unknown }');
+             writeln (implemfile,aktspace,'{ argument types are unknown }');
+           end;
+          if not assigned($6^.p3) then
+           begin
+             writeln(outfile,aktspace,'{ return type might be wrong }   ');
+             writeln(implemfile,aktspace,'{ return type might be wrong }   ');
+           end;
+        end;
+       block_type:=bt_func;
+       write(outfile,aktspace,'function ',$2^.p);
+       write(implemfile,aktspace,'function ',$2^.p);
+
+       if assigned($4) then
+         begin
+            write(outfile,'(');
+            write(implemfile,'(');
+            ph:=new(presobject,init_one(t_enumdef,$4));
+            write_def_params(outfile,ph);
+            write_def_params(implemfile,ph);
+            if assigned(ph) then dispose(ph,done);
+            ph:=nil;
+            (* types are unknown *)
+            write(outfile,' : longint)');
+            write(implemfile,' : longint)');
+         end;
+       if not assigned($6^.p3) then
+         begin
+            writeln(outfile,' : longint;',aktspace,commentstr);
+            writeln(implemfile,' : longint;');
+            flush(outfile);
+         end
+       else
+         begin
+            write(outfile,' : ');
+            write_type_specifier(outfile,$6^.p3);
+            writeln(outfile,';',aktspace,commentstr);
+            flush(outfile);
+            write(implemfile,' : ');
+            write_type_specifier(implemfile,$6^.p3);
+            writeln(implemfile,';');
+         end;
+       writeln(outfile);
+       flush(outfile);
+       hp:=new(presobject,init_two(t_funcname,$2,$6));
+       write_funexpr(implemfile,hp);
+       writeln(implemfile);
+       flush(implemfile);
+       if assigned(hp)then dispose(hp,done);
+     }|
+     DEFINE dname SPACE_DEFINE NEW_LINE
+     {
+       (* DEFINE dname SPACE_DEFINE NEW_LINE *)
+       writeln(outfile,'{$define ',$2^.p,'}',aktspace,commentstr);
+       flush(outfile);
+       if assigned($2)then
+        dispose($2,done);
+     }|
+     DEFINE dname NEW_LINE
+     {
+       writeln(outfile,'{$define ',$2^.p,'}',aktspace,commentstr);
+       flush(outfile);
+       if assigned($2)then
+        dispose($2,done);
+     } |
+     DEFINE dname SPACE_DEFINE def_expr NEW_LINE
+     {
+       (* DEFINE dname SPACE_DEFINE def_expr NEW_LINE *)
+       if ($4^.typ=t_exprlist) and
+          $4^.p1^.is_const and
+          not assigned($4^.next) then
+         begin
+            if block_type<>bt_const then
+              begin
+                 writeln(outfile);
+                 writeln(outfile,aktspace,'const');
+              end;
+            block_type:=bt_const;
+            shift(3);
+            write(outfile,aktspace,$2^.p);
+            write(outfile,' = ');
+            flush(outfile);
+            write_expr(outfile,$4^.p1);
+            writeln(outfile,';',aktspace,commentstr);
+            popshift;
+            if assigned($2) then
+            dispose($2,done);
+            if assigned($4) then
+            dispose($4,done);
+         end
+       else
+         begin
+            if not stripinfo then
+             begin
+               writeln (outfile,aktspace,'{ was #define dname def_expr }');
+               writeln (implemfile,aktspace,'{ was #define dname def_expr }');
+             end;
+            block_type:=bt_func;
+            write(outfile,aktspace,'function ',$2^.p);
+            write(implemfile,aktspace,'function ',$2^.p);
+            shift(2);
+            if not assigned($4^.p3) then
+              begin
+                 writeln(outfile,' : longint;');
+                 writeln(outfile,aktspace,'  { return type might be wrong }');
+                 flush(outfile);
+                 writeln(implemfile,' : longint;');
+                 writeln(implemfile,aktspace,'  { return type might be wrong }');
+              end
+            else
+              begin
+                 write(outfile,' : ');
+                 write_type_specifier(outfile,$4^.p3);
+                 writeln(outfile,';',aktspace,commentstr);
+                 flush(outfile);
+                 write(implemfile,' : ');
+                 write_type_specifier(implemfile,$4^.p3);
+                 writeln(implemfile,';');
+              end;
+            writeln(outfile);
+            flush(outfile);
+            hp:=new(presobject,init_two(t_funcname,$2,$4));
+            write_funexpr(implemfile,hp);
+            popshift;
+            dispose(hp,done);
+            writeln(implemfile);
+            flush(implemfile);
+         end;
+     }
+     | error error_info NEW_LINE
+      { writeln(outfile,'in define line ',line_no,' *)');
+        aktspace:='';
+        in_space_define:=0;
+        in_define:=false;
+        arglevel:=0;
+        if_nb:=0;
+        aktspace:='    ';
+        space_index:=1;
+
+        yyerrok;}
+     ;
+
+closed_list : LGKLAMMER member_list RGKLAMMER
+            {$$:=$2;} |
+            error  error_info RGKLAMMER
+            { writeln(outfile,' in member_list *)');
+            yyerrok;
+            $$:=nil;
+            }
+            ;
+
+closed_enum_list : LGKLAMMER enum_list RGKLAMMER
+            {$$:=$2;} |
+            error  error_info  RGKLAMMER
+            { writeln(outfile,' in enum_list *)');
+            yyerrok;
+            $$:=nil;
+            }
+            ;
+
+special_type_specifier :
+     STRUCT dname closed_list _PACKED
+     {
+       if (not is_packed) and (not packrecords) then
+         writeln(outfile,'{$PACKRECORDS 1}');
+       is_packed:=true;
+       $$:=new(presobject,init_two(t_structdef,$3,$2));
+     } |
+     STRUCT dname closed_list
+     {
+       if (is_packed) and (not packrecords) then
+         writeln(outfile,'{$PACKRECORDS 4}');
+       is_packed:=false;
+       $$:=new(presobject,init_two(t_structdef,$3,$2));
+     } |
+     UNION dname closed_list _PACKED
+     {
+       if (not is_packed) and (not packrecords) then
+         writeln(outfile,'{$PACKRECORDS 1}');
+       is_packed:=true;
+       $$:=new(presobject,init_two(t_uniondef,$3,$2));
+     } |
+     UNION dname closed_list
+     {
+       $$:=new(presobject,init_two(t_uniondef,$3,$2));
+     } |
+     UNION dname
+     {
+       $$:=$2;
+     } |
+     STRUCT dname
+     {
+       $$:=$2;
+     } |
+     ENUM dname closed_enum_list
+     {
+       $$:=new(presobject,init_two(t_enumdef,$3,$2));
+     } |
+     ENUM dname
+     {
+       $$:=$2;
+     };
+
+type_specifier :
+      _CONST type_specifier
+      {
+        if not stripinfo then
+         writeln(outfile,'(* Const before type ignored *)');
+        $$:=$2;
+        } |
+     UNION closed_list  _PACKED
+     {
+       if (not is_packed) and (not packrecords)then
+         writeln(outfile,'{$PACKRECORDS 1}');
+       is_packed:=true;
+       $$:=new(presobject,init_one(t_uniondef,$2));
+     } |
+     UNION closed_list
+     {
+       $$:=new(presobject,init_one(t_uniondef,$2));
+     } |
+     STRUCT closed_list _PACKED
+     {
+       if (not is_packed) and (not packrecords) then
+         writeln(outfile,'{$PACKRECORDS 1}');
+       is_packed:=true;
+       $$:=new(presobject,init_one(t_structdef,$2));
+     } |
+     STRUCT closed_list
+     {
+       if (is_packed) and (not packrecords) then
+         writeln(outfile,'{$PACKRECORDS 4}');
+       is_packed:=false;
+       $$:=new(presobject,init_one(t_structdef,$2));
+     } |
+     ENUM closed_enum_list
+     {
+       $$:=new(presobject,init_one(t_enumdef,$2));
+     } |
+     special_type_specifier
+     {
+       $$:=$1;
+     } |
+     simple_type_name { $$:=$1; }
+     ;
+
+member_list : member_declaration member_list
+     {
+       $$:=new(presobject,init_one(t_memberdeclist,$1));
+       $$^.next:=$2;
+     } |
+     member_declaration
+     {
+       $$:=new(presobject,init_one(t_memberdeclist,$1));
+     }
+     ;
+
+member_declaration :
+     type_specifier declarator_list SEMICOLON
+     {
+       $$:=new(presobject,init_two(t_memberdec,$1,$2));
+     }
+     ;
+
+dname : ID { (*dname*)
+           $$:=new(presobject,init_id(act_token));
+           }
+     ;
+special_type_name :
+     SIGNED special_type_name
+     {
+       hp:=$2;
+       $$:=hp;
+       if assigned(hp) then
+        begin
+          s:=strpas(hp^.p);
+          if UseCTypesUnit then
+          begin
+            if s=cint_STR then
+              s:=csint_STR
+            else if s=cshort_STR then
+              s:=csshort_STR
+            else if s=cchar_STR then
+              s:=cschar_STR
+            else if s=clong_STR then
+              s:=cslong_STR
+            else if s=clonglong_STR then
+              s:=cslonglong_STR
+            else if s=cint8_STR then
+              s:=cint8_STR
+            else if s=cint16_STR then
+              s:=cint16_STR
+            else if s=cint32_STR then
+              s:=cint32_STR
+            else if s=cint64_STR then
+              s:=cint64_STR
+            else
+             s:='';
+          end
+          else
+          begin
+            if s=UINT_STR then
+              s:=INT_STR
+            else if s=USHORT_STR then
+              s:=SHORT_STR
+            else if s=USMALL_STR then
+              s:=SMALL_STR
+            else if s=UCHAR_STR then
+              s:=CHAR_STR
+            else if s=QWORD_STR then
+              s:=INT64_STR
+            else
+              s:='';
+          end;
+          if s<>'' then
+           hp^.setstr(s);
+        end;
+     } |
+     UNSIGNED special_type_name
+     {
+       hp:=$2;
+       $$:=hp;
+       if assigned(hp) then
+        begin
+          s:=strpas(hp^.p);
+          if UseCTypesUnit then
+          begin
+            if s=cint_STR then
+              s:=cuint_STR
+            else if s=cshort_STR then
+              s:=cushort_STR
+            else if s=cchar_STR then
+              s:=cuchar_STR
+            else if s=clong_STR then
+              s:=culong_STR
+            else if s=clonglong_STR then
+              s:=culonglong_STR
+            else if s=cint8_STR then
+              s:=cuint8_STR
+            else if s=cint16_STR then
+              s:=cuint16_STR
+            else if s=cint32_STR then
+              s:=cuint32_STR
+            else if s=cint64_STR then
+              s:=cuint64_STR
+            else
+              s:='';
+          end
+          else
+          begin
+            if s=INT_STR then
+              s:=UINT_STR
+            else if s=SHORT_STR then
+              s:=USHORT_STR
+            else if s=SMALL_STR then
+              s:=USMALL_STR
+            else if s=CHAR_STR then
+              s:=UCHAR_STR
+            else if s=INT64_STR then
+              s:=QWORD_STR
+            else
+              s:='';
+          end;
+          if s<>'' then
+           hp^.setstr(s);
+        end;
+     } |
+     INT
+     {
+     if UseCTypesUnit then
+       $$:=new(presobject,init_id(cint_STR))
+     else
+       $$:=new(presobject,init_intid(INT_STR));
+     } |
+     LONG
+     {
+     if UseCTypesUnit then
+       $$:=new(presobject,init_id(clong_STR))
+     else
+       $$:=new(presobject,init_intid(INT_STR));
+     } |
+     LONG INT
+     {
+     if UseCTypesUnit then
+       $$:=new(presobject,init_id(clong_STR))
+     else
+       $$:=new(presobject,init_intid(INT_STR));
+     } |
+     LONG LONG
+     {
+     if UseCTypesUnit then
+       $$:=new(presobject,init_id(clonglong_STR))
+     else
+       $$:=new(presobject,init_intid(INT64_STR));
+     } |
+     LONG LONG INT
+     {
+     if UseCTypesUnit then
+       $$:=new(presobject,init_id(clonglong_STR))
+     else
+       $$:=new(presobject,init_intid(INT64_STR));
+     } |
+     SHORT
+     {
+     if UseCTypesUnit then
+       $$:=new(presobject,init_id(cshort_STR))
+     else
+       $$:=new(presobject,init_intid(SMALL_STR));
+     } |
+     SHORT INT
+     {
+     if UseCTypesUnit then
+       $$:=new(presobject,init_id(csint_STR))
+     else
+       $$:=new(presobject,init_intid(SMALL_STR));
+     } |
+     INT8
+     {
+     if UseCTypesUnit then
+       $$:=new(presobject,init_id(cint8_STR))
+     else
+       $$:=new(presobject,init_intid(SHORT_STR));
+     } |
+     INT16
+     {
+     if UseCTypesUnit then
+       $$:=new(presobject,init_id(cint16_STR))
+     else
+       $$:=new(presobject,init_intid(SMALL_STR));
+     } |
+     INT32
+     {
+     if UseCTypesUnit then
+       $$:=new(presobject,init_id(cint32_STR))
+     else
+       $$:=new(presobject,init_intid(INT_STR));
+     } |
+     INT64
+     {
+     if UseCTypesUnit then
+       $$:=new(presobject,init_id(cint64_STR))
+     else
+       $$:=new(presobject,init_intid(INT64_STR));
+     } |
+     FLOAT
+     {
+     if UseCTypesUnit then
+       $$:=new(presobject,init_id(cfloat_STR))
+     else
+       $$:=new(presobject,init_intid(FLOAT_STR));
+     } |
+     VOID
+     {
+       $$:=new(presobject,init_no(t_void));
+     } |
+     _CHAR
+     {
+     if UseCTypesUnit then
+       $$:=new(presobject,init_id(cchar_STR))
+     else
+       $$:=new(presobject,init_intid(CHAR_STR));
+     } |
+     UNSIGNED
+     {
+     if UseCTypesUnit then
+       $$:=new(presobject,init_id(cunsigned_STR))
+     else
+       $$:=new(presobject,init_intid(UINT_STR));
+     }
+     ;
+
+simple_type_name :
+     special_type_name
+     {
+     $$:=$1;
+     }
+     |
+     dname
+     {
+     $$:=$1;
+     tn:=$$^.str;
+     if removeunderscore and
+        (length(tn)>1) and (tn[1]='_') then
+      $$^.setstr(Copy(tn,2,length(tn)-1));
+     }
+     ;
+
+declarator_list :
+     declarator_list COMMA declarator
+     {
+     $$:=$1;
+     hp:=$1;
+     while assigned(hp^.next) do
+       hp:=hp^.next;
+     hp^.next:=new(presobject,init_one(t_declist,$3));
+     }|
+     error error_info COMMA declarator_list
+     {
+     writeln(outfile,' in declarator_list *)');
+     $$:=$4;
+     yyerrok;
+     }|
+     error error_info
+     {
+     writeln(outfile,' in declarator_list *)');
+     yyerrok;
+     }|
+     declarator
+     {
+     $$:=new(presobject,init_one(t_declist,$1));
+     }
+     ;
+
+argument_declaration : type_specifier declarator
+     {
+       $$:=new(presobject,init_two(t_arg,$1,$2));
+     } |
+     type_specifier STAR declarator
+     {
+       (* type_specifier STAR declarator *)
+       hp:=new(presobject,init_one(t_pointerdef,$1));
+       $$:=new(presobject,init_two(t_arg,hp,$3));
+     } |
+     type_specifier abstract_declarator
+     {
+       $$:=new(presobject,init_two(t_arg,$1,$2));
+     }
+     ;
+
+argument_declaration_list : argument_declaration
+     {
+       $$:=new(presobject,init_two(t_arglist,$1,nil));
+     } |
+     argument_declaration COMMA argument_declaration_list
+     {
+       $$:=new(presobject,init_two(t_arglist,$1,nil));
+       $$^.next:=$3;
+     } |
+     ELLIPSIS
+     {
+       $$:=new(presobject,init_two(t_arglist,ellipsisarg,nil));
+     } |
+     {
+       $$:=nil;
+     }
+     ;
+
+size_overrider :
+       _FAR
+       { $$:=new(presobject,init_id('far'));}
+       | _NEAR
+       { $$:=new(presobject,init_id('near'));}
+       | _HUGE
+       { $$:=new(presobject,init_id('huge'));}
+       ;
+
+declarator :
+      _CONST declarator
+      {
+        if not stripinfo then
+         writeln(outfile,'(* Const before declarator ignored *)');
+        $$:=$2;
+        } |
+     size_overrider STAR declarator
+     {
+       if not stripinfo then
+        writeln(outfile,aktspace,'(* ',$1^.p,' ignored *)');
+       dispose($1,done);
+       hp:=$3;
+       $$:=hp;
+       while assigned(hp^.p1) do
+         hp:=hp^.p1;
+       hp^.p1:=new(presobject,init_one(t_pointerdef,nil));
+     } |
+     STAR declarator
+     {
+       (* %prec PSTAR this was wrong!! *)
+       hp:=$2;
+       $$:=hp;
+       while assigned(hp^.p1) do
+         hp:=hp^.p1;
+       hp^.p1:=new(presobject,init_one(t_pointerdef,nil));
+     } |
+     _AND declarator %prec P_AND
+     {
+       hp:=$2;
+       $$:=hp;
+       while assigned(hp^.p1) do
+         hp:=hp^.p1;
+       hp^.p1:=new(presobject,init_one(t_addrdef,nil));
+     } |
+     dname COLON expr
+       {
+         (*  size specifier supported *)
+         hp:=new(presobject,init_one(t_size_specifier,$3));
+         $$:=new(presobject,init_three(t_dec,nil,$1,hp));
+        }|
+     dname ASSIGN expr
+       {
+         if not stripinfo then
+          writeln(outfile,'(* Warning : default value for ',$1^.p,' ignored *)');
+         hp:=new(presobject,init_one(t_default_value,$3));
+         $$:=new(presobject,init_three(t_dec,nil,$1,hp));
+        }|
+     dname
+       {
+         $$:=new(presobject,init_two(t_dec,nil,$1));
+        }|
+     declarator LKLAMMER argument_declaration_list RKLAMMER
+     {
+       hp:=$1;
+       $$:=hp;
+       while assigned(hp^.p1) do
+         hp:=hp^.p1;
+       hp^.p1:=new(presobject,init_two(t_procdef,nil,$3));
+     } |
+     declarator no_arg
+     {
+       hp:=$1;
+       $$:=hp;
+       while assigned(hp^.p1) do
+         hp:=hp^.p1;
+       hp^.p1:=new(presobject,init_two(t_procdef,nil,nil));
+     } |
+     declarator LECKKLAMMER expr RECKKLAMMER
+     {
+       hp:=$1;
+       $$:=hp;
+       while assigned(hp^.p1) do
+         hp:=hp^.p1;
+       hp^.p1:=new(presobject,init_two(t_arraydef,nil,$3));
+     } |
+     declarator LECKKLAMMER RECKKLAMMER
+     {
+       (* this is translated into a pointer *)
+       hp:=$1;
+       $$:=hp;
+       while assigned(hp^.p1) do
+         hp:=hp^.p1;
+       hp^.p1:=new(presobject,init_two(t_arraydef,nil,nil));
+     } |
+     LKLAMMER declarator RKLAMMER
+     {
+       $$:=$2;
+     }
+     ;
+
+no_arg : LKLAMMER RKLAMMER |
+        LKLAMMER VOID RKLAMMER;
+
+abstract_declarator :
+      _CONST abstract_declarator
+      {
+        if not stripinfo then
+         writeln(outfile,'(* Const before abstract_declarator ignored *)');
+        $$:=$2;
+        } |
+     size_overrider STAR abstract_declarator
+     {
+       if not stripinfo then
+        writeln(outfile,aktspace,'(* ',$1^.p,' ignored *)');
+       dispose($1,done);
+       hp:=$3;
+       $$:=hp;
+       while assigned(hp^.p1) do
+         hp:=hp^.p1;
+       hp^.p1:=new(presobject,init_one(t_pointerdef,nil));
+     } |
+     STAR abstract_declarator %prec PSTAR
+     {
+       hp:=$2;
+       $$:=hp;
+       while assigned(hp^.p1) do
+         hp:=hp^.p1;
+       hp^.p1:=new(presobject,init_one(t_pointerdef,nil));
+     } |
+     abstract_declarator LKLAMMER argument_declaration_list RKLAMMER
+     {
+       hp:=$1;
+       $$:=hp;
+       while assigned(hp^.p1) do
+         hp:=hp^.p1;
+       hp^.p1:=new(presobject,init_two(t_procdef,nil,$3));
+     } |
+     abstract_declarator no_arg
+     {
+       hp:=$1;
+       $$:=hp;
+       while assigned(hp^.p1) do
+         hp:=hp^.p1;
+       hp^.p1:=new(presobject,init_two(t_procdef,nil,nil));
+     } |
+     abstract_declarator LECKKLAMMER expr RECKKLAMMER
+     {
+       hp:=$1;
+       $$:=hp;
+       while assigned(hp^.p1) do
+         hp:=hp^.p1;
+       hp^.p1:=new(presobject,init_two(t_arraydef,nil,$3));
+     } |
+     declarator LECKKLAMMER RECKKLAMMER
+     {
+       (* this is translated into a pointer *)
+       hp:=$1;
+       $$:=hp;
+       while assigned(hp^.p1) do
+         hp:=hp^.p1;
+       hp^.p1:=new(presobject,init_two(t_arraydef,nil,nil));
+     } |
+     LKLAMMER abstract_declarator RKLAMMER
+     {
+       $$:=$2;
+     } |
+     {
+       $$:=new(presobject,init_two(t_dec,nil,nil));
+     }
+     ;
+
+expr    : shift_expr
+          { $$:=$1; }
+          ;
+
+shift_expr :
+          expr _ASSIGN expr
+          { $$:=new(presobject,init_bop(':=',$1,$3)); }
+          | expr EQUAL expr
+          { $$:=new(presobject,init_bop('=',$1,$3));}
+          | expr UNEQUAL expr
+          { $$:=new(presobject,init_bop('<>',$1,$3));}
+          | expr GT expr
+          { $$:=new(presobject,init_bop('>',$1,$3));}
+          | expr GTE expr
+          { $$:=new(presobject,init_bop('>=',$1,$3));}
+          | expr LT expr
+          { $$:=new(presobject,init_bop('<',$1,$3));}
+          | expr LTE expr
+          { $$:=new(presobject,init_bop('<=',$1,$3));}
+          | expr _PLUS expr
+          { $$:=new(presobject,init_bop('+',$1,$3));}
+          | expr MINUS expr
+          { $$:=new(presobject,init_bop('-',$1,$3));}
+               | expr STAR expr
+          { $$:=new(presobject,init_bop('*',$1,$3));}
+               | expr _SLASH expr
+          { $$:=new(presobject,init_bop('/',$1,$3));}
+               | expr _OR expr
+          { $$:=new(presobject,init_bop(' or ',$1,$3));}
+               | expr _AND expr
+          { $$:=new(presobject,init_bop(' and ',$1,$3));}
+               | expr _NOT expr
+          { $$:=new(presobject,init_bop(' not ',$1,$3));}
+               | expr _SHL expr
+          { $$:=new(presobject,init_bop(' shl ',$1,$3));}
+               | expr _SHR expr
+          { $$:=new(presobject,init_bop(' shr ',$1,$3));}
+          | expr QUESTIONMARK colon_expr
+          {
+            $3^.p1:=$1;
+            $$:=$3;
+            inc(if_nb);
+            $$^.p:=strpnew('if_local'+str(if_nb));
+          } |
+          unary_expr {$$:=$1;}
+          ;
+
+colon_expr : expr COLON expr
+       { (* if A then B else C *)
+       $$:=new(presobject,init_three(t_ifexpr,nil,$1,$3));}
+       ;
+
+maybe_empty_unary_expr :
+                  unary_expr
+                  { $$:=$1; }
+                  |
+                  { $$:=nil;}
+                  ;
+
+unary_expr:
+     dname
+     {
+     $$:=$1;
+     } |
+     special_type_name
+     {
+     $$:=$1;
+     } |
+     CSTRING
+     {
+     (* remove L prefix for widestrings *)
+     s:=act_token;
+     if Win32headers and (s[1]='L') then
+       delete(s,1,1);
+     $$:=new(presobject,init_id(''''+copy(s,2,length(s)-2)+''''));
+     } |
+     NUMBER
+     {
+     $$:=new(presobject,init_id(act_token));
+     } |
+     unary_expr POINT expr
+     {
+     $$:=new(presobject,init_bop('.',$1,$3));
+     } |
+     unary_expr DEREF expr
+     {
+     $$:=new(presobject,init_bop('^.',$1,$3));
+     } |
+     MINUS unary_expr
+     {
+     $$:=new(presobject,init_preop('-',$2));
+     }|
+     _AND unary_expr %prec R_AND
+     {
+     $$:=new(presobject,init_preop('@',$2));
+     }|
+     _NOT unary_expr
+     {
+     $$:=new(presobject,init_preop(' not ',$2));
+     } |
+     LKLAMMER dname RKLAMMER maybe_empty_unary_expr
+     {
+     if assigned($4) then
+       $$:=new(presobject,init_two(t_typespec,$2,$4))
+     else
+       $$:=$2;
+     } |
+     LKLAMMER type_specifier RKLAMMER unary_expr
+     {
+     $$:=new(presobject,init_two(t_typespec,$2,$4));
+     } |
+     LKLAMMER type_specifier STAR RKLAMMER unary_expr
+     {
+     hp:=new(presobject,init_one(t_pointerdef,$2));
+     $$:=new(presobject,init_two(t_typespec,hp,$5));
+     } |
+     LKLAMMER type_specifier size_overrider STAR RKLAMMER unary_expr
+     {
+     if not stripinfo then
+      writeln(outfile,aktspace,'(* ',$3^.p,' ignored *)');
+     dispose($3,done);
+     write_type_specifier(outfile,$2);
+     writeln(outfile,' ignored *)');
+     hp:=new(presobject,init_one(t_pointerdef,$2));
+     $$:=new(presobject,init_two(t_typespec,hp,$6));
+     } |
+     dname LKLAMMER exprlist RKLAMMER
+     {
+     hp:=new(presobject,init_one(t_exprlist,$1));
+     $$:=new(presobject,init_three(t_funexprlist,hp,$3,nil));
+     } |
+     LKLAMMER shift_expr RKLAMMER
+     {
+     $$:=$2;
+     } |
+     LKLAMMER STAR unary_expr RKLAMMER maybe_space LKLAMMER exprlist RKLAMMER
+     {
+       $$:=new(presobject,init_two(t_callop,$3,$7));
+     } |
+     dname LECKKLAMMER exprlist RECKKLAMMER
+     {
+       $$:=new(presobject,init_two(t_arrayop,$1,$3));
+     }
+     ;
+
+enum_list :
+     enum_element COMMA enum_list
+     { (*enum_element COMMA enum_list *)
+       $$:=$1;
+       $$^.next:=$3;
+      } |
+      enum_element {
+       $$:=$1;
+      } |
+      {(* empty enum list *)
+       $$:=nil;};
+
+enum_element :
+     dname _ASSIGN expr
+     { begin (*enum_element: dname _ASSIGN expr *)
+        $$:=new(presobject,init_two(t_enumlist,$1,$3));
+       end;
+     } |
+     dname
+     {
+       begin (*enum_element: dname*)
+       $$:=new(presobject,init_two(t_enumlist,$1,nil));
+       end;
+     };
+
+
+def_expr :
+     unary_expr
+     {
+         if $1^.typ=t_funexprlist then
+           $$:=$1
+         else
+           $$:=new(presobject,init_two(t_exprlist,$1,nil));
+         (* if here is a type specifier
+            we know the return type *)
+         if ($1^.typ=t_typespec) then
+           $$^.p3:=$1^.p1^.get_copy;
+     }
+     ;
+
+para_def_expr :
+     SPACE_DEFINE def_expr
+     {
+     $$:=$2;
+     } |
+     maybe_space LKLAMMER def_expr RKLAMMER
+     {
+     $$:=$3
+     }
+     ;
+
+exprlist : exprelem COMMA exprlist
+    { (*exprlist COMMA expr*)
+       $$:=$1;
+       $1^.next:=$3;
+     } |
+     exprelem
+     {
+       $$:=$1;
+     } |
+     { (* empty expression list *)
+       $$:=nil; };
+
+exprelem :
+           expr
+           {
+             $$:=new(presobject,init_one(t_exprlist,$1));
+           };
+
+%%
+
+function yylex : Integer;
+begin
+  yylex:=scan.yylex;
+  line_no:=yylineno;
+end;
+
+procedure WriteFileHeader(var headerfile: Text);
+var
+ i: integer;
+ originalstr: string;
+begin
+{ write unit header }
+  if not includefile then
+   begin
+     if createdynlib then
+       writeln(headerfile,'{$mode objfpc}');
+     writeln(headerfile,'unit ',unitname,';');
+     writeln(headerfile,'interface');
+     writeln(headerfile);
+     if UseCTypesUnit then
+     begin
+       writeln(headerfile,'uses');
+       writeln(headerfile,'  ctypes;');
+       writeln(headerfile);
+     end;
+     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;
+  freedynlibproc:=TStringList.Create;
+  loaddynlibproc:=TStringList.Create;
+  yydebug:=true;
+  aktspace:='';
+  block_type:=bt_no;
+  IsExtern:=false;
+{ Read commandline options }
+  ProcessOptions;
+  if not CompactMode then
+   aktspace:='  ';
+{ open input and output files }
+  assign(yyinput, inputfilename);
+  {$I-}
+   reset(yyinput);
+  {$I+}
+  if ioresult<>0 then
+   begin
+     writeln('file ',inputfilename,' not found!');
+     halt(1);
+   end;
+  { This is the intermediate output file }
+  assign(outfile, 'ext3.tmp');
+  {$I-}
+  rewrite(outfile);
+  {$I+}
+  if ioresult<>0 then
+   begin
+     writeln('file ext3.tmp could not be created!');
+     halt(1);
+   end;
+  writeln(outfile);
+{ Open tempfiles }
+  { 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! }
+  yyparse;
+{ Write implementation if needed }
+   if not(includefile) then
+    begin
+      writeln(outfile);
+      writeln(outfile,'implementation');
+      writeln(outfile);
+    end;
+   { here we have a problem if a line is longer than 255 chars !! }
+   reset(implemfile);
+   while not eof(implemfile) do
+    begin
+      readln(implemfile,SS);
+      writeln(outfile,SS);
+    end;
+
+  if createdynlib then
+    begin
+      writeln(outfile,'  uses');
+      writeln(outfile,'    SysUtils, dynlibs;');
+      writeln(outfile);
+      writeln(outfile,'  var');
+      writeln(outfile,'    hlib : tlibhandle;');
+      writeln(outfile);
+      writeln(outfile);
+      writeln(outfile,'  procedure Free',unitname,';');
+      writeln(outfile,'    begin');
+      writeln(outfile,'      FreeLibrary(hlib);');
+
+      for i:=0 to (freedynlibproc.Count-1) do
+        Writeln(outfile,'      ',freedynlibproc[i]);
+
+      writeln(outfile,'    end;');
+      writeln(outfile);
+      writeln(outfile);
+      writeln(outfile,'  procedure Load',unitname,'(lib : pchar);');
+      writeln(outfile,'    begin');
+      writeln(outfile,'      Free',unitname,';');
+      writeln(outfile,'      hlib:=LoadLibrary(lib);');
+      writeln(outfile,'      if hlib=0 then');
+      writeln(outfile,'        raise Exception.Create(format(''Could not load library: %s'',[lib]));');
+      writeln(outfile);
+      for i:=0 to (loaddynlibproc.Count-1) do
+        Writeln(outfile,'      ',loaddynlibproc[i]);
+      writeln(outfile,'    end;');
+
+      writeln(outfile);
+      writeln(outfile);
+
+      writeln(outfile,'initialization');
+      writeln(outfile,'  Load',unitname,'(''',unitname,''');');
+      writeln(outfile,'finalization');
+      writeln(outfile,'  Free',unitname,';');
+    end;
+
+   { write end of file }
+   writeln(outfile);
+   if not(includefile) then
+     writeln(outfile,'end.');
+   { close and erase tempfiles }
+  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;
+  freedynlibproc.free;
+  loaddynlibproc.free;
+end.

utils/h2pas/scan.l

@@ -1005,7 +1005,7 @@ D [0-9]
 "int16"                 if NotInCPlusBlock then return(INT16) else skip_until_eol;
 "int32"                 if NotInCPlusBlock then return(INT32) else skip_until_eol;
 "int64"                 if NotInCPlusBlock then return(INT64) else skip_until_eol;
-"float"                 if NotInCPlusBlock then return(REAL) else skip_until_eol;
+"float"                 if NotInCPlusBlock then return(FLOAT) else skip_until_eol;
 "const"                 if NotInCPlusBlock then return(_CONST) else skip_until_eol;
 "CONST"                 if NotInCPlusBlock then return(_CONST) else skip_until_eol;
 "FAR"                   if NotInCPlusBlock then return(_FAR) else skip_until_eol;

utils/h2pas/testit.h

@@ -1,88 +1,90 @@
-/*
-   Test header file to test conversion program.
-*/
-
-typedef struct {
-  int x;
-  int y;
-  } a;
-
-typedef union fpk {
-  int X;
-  int y;
-  int z;
-} b;
-
-typedef _test test;
-
-struct _test
-{
-  int x;
-  int y;
-};
-
-struct XML_cp {
-  enum XML_Content_Type         type;
-  enum XML_Content_Quant        quant;
-  struct _test                  test;
-  union _test2                  test2;
-  XML_Char *                    name;
-  unsigned int                  numchildren;
-  XML_Content *                 children;
-};
-
-typedef void (*XML_AttlistDeclHandler) (void           *userData,
-                                        const XML_Char *elname,
-                                        const XML_Char *attname,
-                                        const XML_Char *att_type,
-                                        const XML_Char *dflt,
-                                        int             isrequired);
-void proc(int *,int);
-void proc(int *p,int i);
-
-typedef enum { First, second, third } C;
-
-typedef enum { DFirst = 1, DSecond = 2, DThird = 3 } D;
-
-typedef enum { EFirst = 100, ESecond, EThird } D;
-
-void someproc(char *Firstarg,...);
-
-mytype* somefunc (char *firstarg);
-
-#define test 0x012345UL
-
-extern long long i641;
-extern unsigned long long q641;
-extern long long int i642;
-extern unsigned long long int q642;
-
-typedef DWORD (WINAPI *LPTHREAD_START_ROUTINE)(LPVOID);
-typedef DWORD(WINAPI *LPPROGRESS_ROUTINE)(LARGE_INTEGER,LARGE_INTEGER,LARGE_INTEGER,LARGE_INTEGER,DWORD,DWORD,HANDLE,HANDLE,LPVOID);
-
-typedef Status (*XcmsConversionProc)();
-
-typedef XrmHashTable XrmSearchList[];
-
-#define XrmStringToRepresentation(string)   XrmStringToQuark(string)
-#define XrmRepresentationToString(type)   XrmQuarkToString(type)
-
-typedef struct _XRenderPictureAttributes {
-    Bool                repeat;
-    Picture             alpha_map;
-    int                 alpha_x_origin;
-    int                 alpha_y_origin;
-    int                 clip_x_origin;
-    int                 clip_y_origin;
-    Pixmap              clip_mask;
-    Bool                graphics_exposures;
-    int                 subwindow_mode;
-    int                 poly_edge;
-    int                 poly_mode;
-    Atom                dither;
-} XRenderPictureAttributes;
-
-void   gdk_gc_set_dashes          (GdkGC            *gc,
-                                   gint              dash_offset,
-                                   gint8             dash_list[],
-                                   gint              n);
+/*
+   Test header file to test conversion program.
+*/
+
+typedef struct {
+  int x;
+  int y;
+  } a;
+
+typedef union fpk {
+  int X;
+  int y;
+  int z;
+} b;
+
+typedef _test test;
+
+struct _test
+{
+  int x;
+  int y;
+};
+
+struct XML_cp {
+  enum XML_Content_Type         type;
+  enum XML_Content_Quant        quant;
+  struct _test                  test;
+  union _test2                  test2;
+  XML_Char *                    name;
+  unsigned int                  numchildren;
+  XML_Content *                 children;
+};
+
+typedef void (*XML_AttlistDeclHandler) (void           *userData,
+                                        const XML_Char *elname,
+                                        const XML_Char *attname,
+                                        const XML_Char *att_type,
+                                        const XML_Char *dflt,
+                                        int             isrequired);
+void proc(int *,int);
+void proc(int *p,int i);
+
+float f();
+
+typedef enum { First, second, third } C;
+
+typedef enum { DFirst = 1, DSecond = 2, DThird = 3 } D;
+
+typedef enum { EFirst = 100, ESecond, EThird } D;
+
+void someproc(char *Firstarg,...);
+
+mytype* somefunc (char *firstarg);
+
+#define test 0x012345UL
+
+extern long long i641;
+extern unsigned long long q641;
+extern long long int i642;
+extern unsigned long long int q642;
+
+typedef DWORD (WINAPI *LPTHREAD_START_ROUTINE)(LPVOID);
+typedef DWORD(WINAPI *LPPROGRESS_ROUTINE)(LARGE_INTEGER,LARGE_INTEGER,LARGE_INTEGER,LARGE_INTEGER,DWORD,DWORD,HANDLE,HANDLE,LPVOID);
+
+typedef Status (*XcmsConversionProc)();
+
+typedef XrmHashTable XrmSearchList[];
+
+#define XrmStringToRepresentation(string)   XrmStringToQuark(string)
+#define XrmRepresentationToString(type)   XrmQuarkToString(type)
+
+typedef struct _XRenderPictureAttributes {
+    Bool                repeat;
+    Picture             alpha_map;
+    int                 alpha_x_origin;
+    int                 alpha_y_origin;
+    int                 clip_x_origin;
+    int                 clip_y_origin;
+    Pixmap              clip_mask;
+    Bool                graphics_exposures;
+    int                 subwindow_mode;
+    int                 poly_edge;
+    int                 poly_mode;
+    Atom                dither;
+} XRenderPictureAttributes;
+
+void   gdk_gc_set_dashes          (GdkGC            *gc,
+                                   gint              dash_offset,
+                                   gint8             dash_list[],
+                                   gint              n);