* reinserted

compiler/psub.pas

@@ -0,0 +1,2414 @@
+{
+    $Id$
+    Copyright (c) 1998 by Florian Klaempfl, Daniel Mantione
+
+    Does the parsing of the procedures/functions
+
+    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.
+
+ ****************************************************************************
+}
+unit psub;
+interface
+
+uses cobjects,symtable;
+
+const
+  pd_global    = $1;    { directive must be global }
+  pd_body      = $2;    { directive needs a body }
+  pd_implemen  = $4;    { directive can be used implementation section }
+  pd_interface = $8;    { directive can be used interface section }
+  pd_object    = $10;   { directive can be used object declaration }
+  pd_procvar   = $20;   { directive can be used procvar declaration }
+  pd_notobject    = $40;{ directive can not be used object declaration }
+
+procedure compile_proc_body(const proc_names:Tstringcontainer;
+                            make_global,parent_has_class:boolean);
+procedure parse_proc_head(options : word);
+procedure parse_proc_dec;
+procedure parse_var_proc_directives(var sym : ptypesym);
+procedure parse_object_proc_directives(var sym : pprocsym);
+procedure read_proc;
+
+
+implementation
+
+uses
+  globtype,systems,tokens,
+  strings,globals,verbose,files,
+  scanner,aasm,tree,types,
+  import,gendef,
+  hcodegen,temp_gen,pass_1
+{$ifndef NOPASS2}
+  ,pass_2
+{$endif}
+{$ifdef GDB}
+  ,gdb
+{$endif GDB}
+{$ifdef i386}
+  ,i386base,i386asm
+  ,tgeni386,cgai386
+  {$ifndef NoOpt}
+  ,aopt386
+  {$endif}
+{$endif}
+{$ifdef m68k}
+  ,m68k,tgen68k,cga68k
+{$endif}
+  { parser specific stuff }
+  ,pbase,pdecl,pexpr,pstatmnt
+  ;
+
+var
+  realname:string;  { contains the real name of a procedure as it's typed }
+
+
+procedure formal_parameter_list;
+{
+  handle_procvar needs the same changes
+}
+var
+  sc      : Pstringcontainer;
+  s       : string;
+  storetokenpos : tfileposinfo;
+  p       : Pdef;
+  hsym    : psym;
+  hvs,
+  vs      : Pvarsym;
+  hs1,hs2 : string;
+  varspez : Tvarspez;
+  inserthigh : boolean;
+begin
+  consume(LKLAMMER);
+  inc(testcurobject);
+  repeat
+    if try_to_consume(_VAR) then
+      varspez:=vs_var
+    else
+      if try_to_consume(_CONST) then
+        varspez:=vs_const
+      else
+        varspez:=vs_value;
+    inserthigh:=false;
+    if idtoken=_SELF then
+      begin
+         { we parse the defintion in the class definition }
+         if assigned(procinfo._class) and procinfo._class^.isclass then
+           begin
+{$ifndef UseNiceNames}
+            hs2:=hs2+'$'+'self';
+{$else UseNiceNames}
+            hs2:=hs2+tostr(length('self'))+'self';
+{$endif UseNiceNames}
+            vs:=new(Pvarsym,init('@',procinfo._class));
+            vs^.varspez:=vs_var;
+          { insert the sym in the parasymtable }
+            aktprocsym^.definition^.parast^.insert(vs);
+
+            aktprocsym^.definition^.options:=aktprocsym^.definition^.options or pocontainsself;
+            inc(procinfo.ESI_offset,vs^.address);
+            consume(idtoken);
+            consume(COLON);
+            p:=single_type(hs1);
+            aktprocsym^.definition^.concatdef(p,vs_value);
+            CheckTypes(p,procinfo._class);
+           end
+         else
+           consume(ID);
+      end
+    else
+      begin
+       { read identifiers }
+         sc:=idlist;
+
+       { read type declaration, force reading for value and const paras }
+         if (token=COLON) or (varspez=vs_value) then
+          begin
+            consume(COLON);
+          { check for an open array }
+            if token=_ARRAY then
+             begin
+               consume(_ARRAY);
+               consume(_OF);
+             { define range and type of range }
+               p:=new(Parraydef,init(0,-1,s32bitdef));
+             { array of const ? }
+               if (token=_CONST) and (m_objpas in aktmodeswitches) then
+                begin
+                  consume(_CONST);
+                  srsym:=nil;
+                  if assigned(objpasunit) then
+                   getsymonlyin(objpasunit,'TVARREC');
+                  if not assigned(srsym) then
+                   InternalError(1234124);
+                  Parraydef(p)^.definition:=ptypesym(srsym)^.definition;
+                  Parraydef(p)^.IsArrayOfConst:=true;
+                  hs1:='array_of_const';
+                end
+               else
+                begin
+                { define field type }
+                  Parraydef(p)^.definition:=single_type(hs1);
+                  hs1:='array_of_'+hs1;
+                end;
+               inserthigh:=true;
+             end
+            { open string ? }
+            else if (varspez=vs_var) and
+                    (
+                      (
+                        ((token=_STRING) or (idtoken=_SHORTSTRING)) and
+                        (cs_openstring in aktmoduleswitches) and
+                        not(cs_ansistrings in aktlocalswitches)
+                      ) or
+                    (idtoken=_OPENSTRING)) then
+             begin
+               consume(token);
+               p:=openshortstringdef;
+               hs1:='openstring';
+               inserthigh:=true;
+             end
+            { everything else }
+            else
+             p:=single_type(hs1);
+          end
+         else
+          begin
+     {$ifndef UseNiceNames}
+            hs1:='$$$';
+     {$else UseNiceNames}
+            hs1:='var';
+     {$endif UseNiceNames}
+            p:=cformaldef;
+            { }
+          end;
+         hs2:=aktprocsym^.definition^.mangledname;
+         storetokenpos:=tokenpos;
+         while not sc^.empty do
+          begin
+            s:=sc^.get_with_tokeninfo(tokenpos);
+            aktprocsym^.definition^.concatdef(p,varspez);
+     {$ifndef UseNiceNames}
+            hs2:=hs2+'$'+hs1;
+     {$else UseNiceNames}
+            hs2:=hs2+tostr(length(hs1))+hs1;
+     {$endif UseNiceNames}
+            vs:=new(Pvarsym,init(s,p));
+            vs^.varspez:=varspez;
+          { we have to add this to avoid var param to be in registers !!!}
+            if (varspez in [vs_var,vs_const]) and push_addr_param(p) then
+              vs^.var_options := vs^.var_options or vo_regable;
+
+            { search for duplicate ids in object members/methods    }
+            { but only the current class, I don't know why ...      }
+            { at least TP and Delphi do it in that way   (FK) }
+            if assigned(procinfo._class) and
+               (lexlevel=normal_function_level) then
+             begin
+               hsym:=procinfo._class^.publicsyms^.search(vs^.name);
+               if assigned(hsym) then
+                DuplicateSym(hsym);
+             end;
+
+          { do we need a local copy }
+            if (varspez=vs_value) and push_addr_param(p) and
+               not(is_open_array(p) or is_array_of_const(p)) then
+              vs^.setname('val'+vs^.name);
+
+          { insert the sym in the parasymtable }
+            aktprocsym^.definition^.parast^.insert(vs);
+
+          { also need to push a high value? }
+            if inserthigh then
+             begin
+               hvs:=new(Pvarsym,init('high'+s,s32bitdef));
+               hvs^.varspez:=vs_const;
+               aktprocsym^.definition^.parast^.insert(hvs);
+             end;
+
+          end;
+         dispose(sc,done);
+         tokenpos:=storetokenpos;
+      end;
+    aktprocsym^.definition^.setmangledname(hs2);
+  until not try_to_consume(SEMICOLON);
+  dec(testcurobject);
+  consume(RKLAMMER);
+end;
+
+
+
+procedure parse_proc_head(options : word);
+var sp:stringid;
+    pd:Pprocdef;
+    paramoffset:longint;
+    sym:Psym;
+    hs:string;
+    st : psymtable;
+    overloaded_level:word;
+    procstartfilepos : tfileposinfo;
+begin
+{ Save the position where this procedure really starts and set col to 1 which
+  looks nicer }
+  procstartfilepos:=aktfilepos;
+  procstartfilepos.column:=1;
+
+  if (options and pooperator) <> 0 then
+    begin
+      sp:=overloaded_names[optoken];
+      realname:=sp;
+    end
+  else
+    begin
+      sp:=pattern;
+      realname:=orgpattern;
+      consume(ID);
+    end;
+
+{ method ? }
+  if not(parse_only) and try_to_consume(POINT) then
+   begin
+     getsym(sp,true);
+     sym:=srsym;
+     { qualifier is class name ? }
+     if (sym^.typ<>typesym) or
+        (ptypesym(sym)^.definition^.deftype<>objectdef) then
+       begin
+          Message(parser_e_class_id_expected);
+          aktprocsym:=nil;
+          consume(ID);
+       end
+     else
+       begin
+          { used to allow private syms to be seen }
+          aktobjectdef:=pobjectdef(ptypesym(sym)^.definition);
+          sp:=pattern;
+          realname:=orgpattern;
+          consume(ID);
+          procinfo._class:=pobjectdef(ptypesym(sym)^.definition);
+          aktprocsym:=pprocsym(procinfo._class^.publicsyms^.search(sp));
+          aktobjectdef:=nil;
+          { we solve this below }
+          if not(assigned(aktprocsym)) then
+            Message(parser_e_methode_id_expected);
+       end;
+   end
+  else
+   begin
+     { check for constructor/destructor which is not allowed here }
+     if (not parse_only) and
+        ((options and (poconstructor or podestructor))<>0) then
+        Message(parser_e_constructors_always_objects);
+
+     aktprocsym:=pprocsym(symtablestack^.search(sp));
+
+     if lexlevel=normal_function_level then
+{$ifdef UseNiceNames}
+       hs:=procprefix+'_'+tostr(length(sp))+sp
+{$else UseNiceNames}
+       hs:=procprefix+'_'+sp
+{$endif UseNiceNames}
+     else
+{$ifdef UseNiceNames}
+       hs:=lowercase(procprefix)+'_'+tostr(length(sp))+sp;
+{$else UseNiceNames}
+       hs:=procprefix+'_$'+sp;
+{$endif UseNiceNames}
+     if not(parse_only) then
+       begin
+         {The procedure we prepare for is in the implementation
+          part of the unit we compile. It is also possible that we
+          are compiling a program, which is also some kind of
+          implementaion part.
+
+          We need to find out if the procedure is global. If it is
+          global, it is in the global symtable.}
+         if not assigned(aktprocsym) then
+          begin
+            {Search the procedure in the global symtable.}
+            aktprocsym:=Pprocsym(search_a_symtable(sp,globalsymtable));
+            if assigned(aktprocsym) then
+             begin
+               {Check if it is a procedure.}
+               if aktprocsym^.typ<>procsym then
+                DuplicateSym(aktprocsym);
+               {The procedure has been found. So it is
+                a global one. Set the flags to mark this.}
+               procinfo.flags:=procinfo.flags or pi_is_global;
+             end;
+          end;
+       end;
+   end;
+  { problem with procedures inside methods }
+{$ifndef UseNiceNames}
+  if assigned(procinfo._class) then
+    if (pos('_$$_',procprefix)=0) then
+      hs:=procprefix+'_$$_'+procinfo._class^.objname^+'_'+sp
+    else
+      hs:=procprefix+'_$'+sp;
+{$else UseNiceNames}
+  if assigned(procinfo._class) then
+    if (pos('_5Class_',procprefix)=0) then
+      hs:=procprefix+'_5Class_'+procinfo._class^.name^+'_'+tostr(length(sp))+sp
+    else
+      hs:=procprefix+'_'+tostr(length(sp))+sp;
+{$endif UseNiceNames}
+
+  if assigned(aktprocsym) then
+   begin
+     { Check if overloading is enabled }
+     if not(m_fpc in aktmodeswitches) then
+      begin
+        if aktprocsym^.typ<>procsym then
+         begin
+           DuplicateSym(aktprocsym);
+           { try to recover by creating a new aktprocsym }
+           aktprocsym:=new(pprocsym,init(sp));
+         end
+        else
+         begin
+           if not(aktprocsym^.definition^.forwarddef) then
+            Message(parser_e_procedure_overloading_is_off);
+         end;
+      end
+     else
+      begin
+        { Check if the overloaded sym is realy a procsym }
+        if aktprocsym^.typ<>procsym then
+         begin
+           Message1(parser_e_overloaded_no_procedure,aktprocsym^.name);
+           { try to recover by creating a new aktprocsym }
+           aktprocsym:=new(pprocsym,init(sp));
+         end;
+      end;
+   end
+  else
+   begin
+     { create a new procsym and set the real filepos }
+     aktprocsym:=new(pprocsym,init(sp));
+     { for operator we have only one definition for each overloaded
+       operation }
+     if ((options and pooperator) <> 0) then
+       begin
+          { the only problem is that nextoverloaded might not be in a unit
+            known for the unit itself }
+          if assigned(overloaded_operators[optoken]) then
+            aktprocsym^.definition:=overloaded_operators[optoken]^.definition;
+       end;
+     symtablestack^.insert(aktprocsym);
+   end;
+
+  { create a new procdef }
+  { register object/class methods in publicsyms symtable }
+  { but not internal functions !!! }
+  st:=symtablestack;
+  if assigned(procinfo._class) and
+     (symtablestack^.symtabletype in [globalsymtable,staticsymtable]) then
+    begin
+      { change symtablestack to get correct definition registration }
+      pd:=new(pprocdef,init);
+    end
+  else
+    pd:=new(pprocdef,init);
+
+  if assigned(procinfo._class) then
+    pd^._class := procinfo._class;
+
+  { set the options from the caller (podestructor or poconstructor) }
+  pd^.options:=pd^.options or options;
+
+  { calculate the offset of the parameters }
+  paramoffset:=8;
+
+  { calculate frame pointer offset }
+  if lexlevel>normal_function_level then
+    begin
+      procinfo.framepointer_offset:=paramoffset;
+      inc(paramoffset,target_os.size_of_pointer);
+      { this is needed to get correct framepointer push for local
+        forward functions !! }
+      pd^.parast^.symtablelevel:=lexlevel;
+    end;
+
+  if assigned (Procinfo._Class)  and
+     not(Procinfo._Class^.isclass) and
+     (((pd^.options and poconstructor)<>0)
+     or ((pd^.options and podestructor)<>0)) then
+     inc(paramoffset,target_os.size_of_pointer);
+
+  { self pointer offset                       }
+  { self isn't pushed in nested procedure of methods }
+  if assigned(procinfo._class) and (lexlevel=normal_function_level) then
+    begin
+      procinfo.ESI_offset:=paramoffset;
+      if assigned(aktprocsym^.definition) and
+         ((aktprocsym^.definition^.options and pocontainsself)=0) then
+        inc(paramoffset,target_os.size_of_pointer);
+    end;
+
+  { destructor flag ? }
+  if assigned (Procinfo._Class) and
+     procinfo._class^.isclass
+     and ((pd^.options and podestructor)<>0) then
+     inc(paramoffset,target_os.size_of_pointer);
+
+  procinfo.call_offset:=paramoffset;
+
+  pd^.parast^.datasize:=0;
+
+  pd^.nextoverloaded:=aktprocsym^.definition;
+  aktprocsym^.definition:=pd;
+  aktprocsym^.definition^.fileinfo:=procstartfilepos;
+  aktprocsym^.definition^.setmangledname(hs);
+
+  { update also the current filepos for aktprocsym }
+  aktprocsym^.fileinfo:=procstartfilepos;
+
+  if not parse_only then
+    begin
+       overloaded_level:=0;
+       { we need another procprefix !!! }
+       { count, but only those in the same unit !!}
+       while assigned(pd) and
+          (pd^.owner^.symtabletype in [globalsymtable,staticsymtable]) do
+         begin
+            { only count already implemented functions }
+            if  not(pd^.forwarddef) then
+              inc(overloaded_level);
+            pd:=pd^.nextoverloaded;
+         end;
+       if overloaded_level>0 then
+         procprefix:=hs+'$'+tostr(overloaded_level)+'$'
+       else
+         procprefix:=hs+'$';
+    end;
+
+  { this must also be inserted in the right symtable !! PM }
+  { otherwise we get subbtle problems with
+    definitions of args defs in staticsymtable for
+    implementation of a global method }
+  if token=LKLAMMER then
+    formal_parameter_list;
+  { so we only restore the symtable now }
+  symtablestack:=st;
+  if ((options and pooperator)<>0) {and (overloaded_operators[optoken]=nil) } then
+    overloaded_operators[optoken]:=aktprocsym;
+end;
+
+
+procedure parse_proc_dec;
+var
+  hs : string;
+  isclassmethod : boolean;
+begin
+  inc(lexlevel);
+{ read class method }
+  if token=_CLASS then
+   begin
+     consume(_CLASS);
+     isclassmethod:=true;
+   end
+  else
+   isclassmethod:=false;
+  case token of
+     _FUNCTION : begin
+                   consume(_FUNCTION);
+                   parse_proc_head(0);
+                   if token<>COLON then
+                    begin
+                       if not(aktprocsym^.definition^.forwarddef) or
+                         (m_repeat_forward in aktmodeswitches) then
+                       begin
+                         consume(COLON);
+                         consume_all_until(SEMICOLON);
+                       end;
+                    end
+                   else
+                    begin
+                      consume(COLON);
+                      aktprocsym^.definition^.retdef:=single_type(hs);
+                      aktprocsym^.definition^.test_if_fpu_result;
+                    end;
+                 end;
+    _PROCEDURE : begin
+                   consume(_PROCEDURE);
+                   parse_proc_head(0);
+                   aktprocsym^.definition^.retdef:=voiddef;
+                 end;
+  _CONSTRUCTOR : begin
+                   consume(_CONSTRUCTOR);
+                   parse_proc_head(poconstructor);
+                   if (procinfo._class^.options and oo_is_class)<>0 then
+                    begin
+                      { CLASS constructors return the created instance }
+                      aktprocsym^.definition^.retdef:=procinfo._class;
+                    end
+                   else
+                    begin
+                      { OBJECT constructors return a boolean }
+{$IfDef GDB}
+                      { GDB doesn't like unnamed types !}
+                      aktprocsym^.definition^.retdef:=globaldef('boolean');
+{$Else GDB}
+                      aktprocsym^.definition^.retdef:=new(porddef,init(bool8bit,0,1));
+{$Endif GDB}
+                    end;
+                 end;
+   _DESTRUCTOR : begin
+                   consume(_DESTRUCTOR);
+                   parse_proc_head(podestructor);
+                   aktprocsym^.definition^.retdef:=voiddef;
+                 end;
+     _OPERATOR : begin
+                   if lexlevel>normal_function_level then
+                     Message(parser_e_no_local_operator);
+                   consume(_OPERATOR);
+                   if not(token in [PLUS..last_overloaded]) then
+                     Message(parser_e_overload_operator_failed);
+                   optoken:=token;
+                   consume(Token);
+                   procinfo.flags:=procinfo.flags or pi_operator;
+                   parse_proc_head(pooperator);
+                   if token<>ID then
+                     consume(ID)
+                   else
+                     begin
+                       opsym:=new(pvarsym,init(pattern,voiddef));
+                       consume(ID);
+                     end;
+                   if not try_to_consume(COLON) then
+                     begin
+                       consume(COLON);
+                       aktprocsym^.definition^.retdef:=generrordef;
+                       consume_all_until(SEMICOLON);
+                     end
+                   else
+                    begin
+                      aktprocsym^.definition^.retdef:=
+                       single_type(hs);
+                      aktprocsym^.definition^.test_if_fpu_result;
+                      if (optoken in [EQUAL,GT,LT,GTE,LTE]) and
+                         ((aktprocsym^.definition^.retdef^.deftype<>
+                         orddef) or (porddef(aktprocsym^.definition^.
+                         retdef)^.typ<>bool8bit)) then
+                        Message(parser_e_comparative_operator_return_boolean);
+                       opsym^.definition:=aktprocsym^.definition^.retdef;
+                     end;
+                 end;
+  end;
+  if isclassmethod and
+     assigned(aktprocsym) then
+    aktprocsym^.definition^.options:=aktprocsym^.definition^.options or poclassmethod;
+  consume(SEMICOLON);
+  dec(lexlevel);
+end;
+
+
+{****************************************************************************
+                        Procedure directive handlers
+****************************************************************************}
+
+{$ifdef tp}
+  {$F+}
+{$endif}
+
+procedure pd_far(const procnames:Tstringcontainer);
+begin
+  Message(parser_w_proc_far_ignored);
+end;
+
+procedure pd_near(const procnames:Tstringcontainer);
+begin
+  Message(parser_w_proc_near_ignored);
+end;
+
+procedure pd_export(const procnames:Tstringcontainer);
+begin
+  procnames.insert(realname);
+  procinfo.exported:=true;
+  if cs_link_deffile in aktglobalswitches then
+    deffile.AddExport(aktprocsym^.definition^.mangledname);
+  if assigned(procinfo._class) then
+    Message(parser_e_methods_dont_be_export);
+  if lexlevel<>normal_function_level then
+    Message(parser_e_dont_nest_export);
+end;
+
+procedure pd_inline(const procnames:Tstringcontainer);
+begin
+  if not(cs_support_inline in aktmoduleswitches) then
+   Message(parser_e_proc_inline_not_supported);
+end;
+
+procedure pd_forward(const procnames:Tstringcontainer);
+begin
+  aktprocsym^.definition^.forwarddef:=true;
+  aktprocsym^.properties:=aktprocsym^.properties or sp_forwarddef;
+end;
+
+procedure pd_stdcall(const procnames:Tstringcontainer);
+begin
+end;
+
+procedure pd_safecall(const procnames:Tstringcontainer);
+begin
+end;
+
+procedure pd_alias(const procnames:Tstringcontainer);
+begin
+  consume(COLON);
+  procnames.insert(get_stringconst);
+end;
+
+procedure pd_asmname(const procnames:Tstringcontainer);
+begin
+  aktprocsym^.definition^.setmangledname(target_os.Cprefix+pattern);
+  if token=CCHAR then
+    consume(CCHAR)
+  else
+    consume(CSTRING);
+  { we don't need anything else }
+  aktprocsym^.definition^.forwarddef:=false;
+end;
+
+procedure pd_intern(const procnames:Tstringcontainer);
+begin
+  consume(COLON);
+  aktprocsym^.definition^.extnumber:=get_intconst;
+end;
+
+procedure pd_system(const procnames:Tstringcontainer);
+begin
+  aktprocsym^.definition^.setmangledname(realname);
+end;
+
+procedure pd_abstract(const procnames:Tstringcontainer);
+begin
+  if (aktprocsym^.definition^.options and povirtualmethod)<>0 then
+    aktprocsym^.definition^.options:=aktprocsym^.definition^.options or poabstractmethod
+  else
+    Message(parser_e_only_virtual_methods_abstract);
+  { the method is defined }
+  aktprocsym^.definition^.forwarddef:=false;
+end;
+
+procedure pd_virtual(const procnames:Tstringcontainer);
+begin
+  if (aktprocsym^.definition^._class^.options and oo_is_class=0) and
+     ((aktprocsym^.definition^.options and poconstructor)<>0) then
+    Message(parser_e_constructor_cannot_be_not_virtual);
+end;
+
+procedure pd_static(const procnames:Tstringcontainer);
+begin
+  if (cs_static_keyword in aktmoduleswitches) then
+   {and (idtoken=_STATIC) was wrong idtoken is already consumed (PM) }
+    begin
+      aktprocsym^.properties:=aktprocsym^.properties or sp_static;
+      aktprocsym^.definition^.options:=aktprocsym^.definition^.options or postaticmethod;
+    end;
+end;
+
+procedure pd_override(const procnames:Tstringcontainer);
+begin
+  if (aktprocsym^.definition^._class^.options and oo_is_class=0) then
+    Message(parser_e_no_object_override);
+end;
+
+
+procedure pd_cdecl(const procnames:Tstringcontainer);
+begin
+  if aktprocsym^.definition^.deftype<>procvardef then
+    aktprocsym^.definition^.setmangledname(target_os.Cprefix+realname);
+end;
+
+
+procedure pd_register(const procnames:Tstringcontainer);
+begin
+  Message(parser_w_proc_register_ignored);
+end;
+
+
+procedure pd_syscall(const procnames:Tstringcontainer);
+begin
+  aktprocsym^.definition^.options:=aktprocsym^.definition^.options or poclearstack;
+  aktprocsym^.definition^.forwarddef:=false;
+  aktprocsym^.definition^.extnumber:=get_intconst;
+end;
+
+
+procedure pd_external(const procnames:Tstringcontainer);
+{
+  If import_dll=nil the procedure is assumed to be in another
+  object file. In that object file it should have the name to
+  which import_name is pointing to. Otherwise, the procedure is
+  assumed to be in the DLL to which import_dll is pointing to. In
+  that case either import_nr<>0 or import_name<>nil is true, so
+  the procedure is either imported by number or by name. (DM)
+}
+var
+  import_dll,
+  import_name : string;
+  import_nr   : word;
+begin
+  aktprocsym^.definition^.forwarddef:=false;
+{ If the procedure should be imported from a DLL, a constant string follows.
+  This isn't really correct, an contant string expression follows
+  so we check if an semicolon follows, else a string constant have to
+  follow (FK) }
+  import_nr:=0;
+  import_name:='';
+  if not(token=SEMICOLON) and not(idtoken=_NAME) then
+    begin
+      import_dll:=get_stringconst;
+      if (idtoken=_NAME) then
+       begin
+         consume(_NAME);
+         import_name:=get_stringconst;
+       end;
+      if (idtoken=_INDEX) then
+       begin
+         {After the word index follows the index number in the DLL.}
+         consume(_INDEX);
+         import_nr:=get_intconst;
+       end;
+      if (import_nr=0) and (import_name='') then
+        {if (aktprocsym^.definition^.options and pocdecl)<>0 then
+          import_name:=aktprocsym^.definition^.mangledname
+        else
+          Message(parser_w_empty_import_name);}
+        { this should work both for win32 and Linux !! PM }
+        import_name:=realname;
+      if not(current_module^.uses_imports) then
+       begin
+         current_module^.uses_imports:=true;
+         importlib^.preparelib(current_module^.modulename^);
+       end;
+      importlib^.importprocedure(aktprocsym^.mangledname,import_dll,import_nr,import_name)
+    end
+  else
+    begin
+      if (idtoken=_NAME) then
+       begin
+         consume(_NAME);
+         import_name:=get_stringconst;
+         aktprocsym^.definition^.setmangledname(import_name);
+       end
+      else
+       begin
+         { external shouldn't override the cdecl/system name }
+         if (aktprocsym^.definition^.options and poclearstack)=0 then
+           aktprocsym^.definition^.setmangledname(aktprocsym^.name);
+       end;
+    end;
+end;
+
+{$ifdef TP}
+  {$F-}
+{$endif}
+
+function parse_proc_direc(const proc_names:Tstringcontainer;var pdflags:word):boolean;
+{
+  Parse the procedure directive, returns true if a correct directive is found
+}
+const
+   namelength=15;
+type
+   pd_handler=procedure(const procnames:Tstringcontainer);
+   proc_dir_rec=record
+     idtok    : ttoken;
+     handler  : pd_handler;      {Handler.}
+     flag     : longint;            {Procedure flag. May be zero}
+     pd_flags : longint;             {Parse options}
+     mut_excl : longint;             {List of mutually exclusive flags.}
+   end;
+const
+  {Should contain the number of procedure directives we support.}
+  num_proc_directives=27;
+  proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
+   (
+    (
+      idtok:_ABSTRACT;
+      handler:{$ifndef TP}@{$endif}pd_abstract;
+      flag:poabstractmethod;
+      pd_flags:pd_interface+pd_object;
+      mut_excl:poexports+poinline+pointernproc+pointerrupt+poexternal+poconstructor+podestructor
+    ),(
+      idtok:_ALIAS;
+      handler:{$ifndef TP}@{$endif}pd_alias;
+      flag:0;
+      pd_flags:pd_implemen+pd_body;
+      mut_excl:poinline+poexternal
+    ),(
+      idtok:_ASMNAME;
+      handler:{$ifndef TP}@{$endif}pd_asmname;
+      flag:pocdecl+poclearstack+poexternal;
+      pd_flags:pd_interface+pd_implemen;
+      mut_excl:pointernproc+poexternal
+    ),(
+      idtok:_ASSEMBLER;
+      handler:nil;
+      flag:poassembler;pd_flags:pd_implemen+pd_body;
+      mut_excl:pointernproc+poexternal
+    ),(
+      idtok:_CDECL;
+      handler:{$ifndef TP}@{$endif}pd_cdecl;
+      flag:pocdecl+poclearstack+posavestdregs;
+      pd_flags:pd_interface+pd_implemen+pd_body+pd_procvar;
+      mut_excl:poleftright+poinline+poassembler+pointernproc+poexternal
+    ),(
+      idtok:_DYNAMIC;
+      handler:{$ifndef TP}@{$endif}pd_virtual;
+      flag:povirtualmethod;
+      pd_flags:pd_interface+pd_object;
+      mut_excl:poexports+poinline+pointernproc+pointerrupt+poexternal
+    ),(
+      idtok:_EXPORT;
+      handler:{$ifndef TP}@{$endif}pd_export;
+      flag:poexports;
+      pd_flags:pd_body+pd_global+pd_interface+pd_implemen{??};
+      mut_excl:poexternal+poinline+pointernproc+pointerrupt
+    ),(
+      idtok:_EXTERNAL;
+      handler:{$ifndef TP}@{$endif}pd_external;
+      flag:poexternal;
+      pd_flags:pd_implemen+pd_interface;
+      mut_excl:poexports+poinline+pointernproc+pointerrupt+poassembler+popalmossyscall
+    ),(
+      idtok:_FAR;handler:{$ifndef TP}@{$endif}pd_far;
+      flag:0;
+      pd_flags:pd_implemen+pd_body+pd_interface+pd_procvar;
+      mut_excl:pointernproc
+    ),(
+      idtok:_FORWARD;
+      handler:{$ifndef TP}@{$endif}pd_forward;
+      flag:0;
+      pd_flags:pd_implemen;
+      mut_excl:pointernproc+poexternal
+    ),(
+      idtok:_INLINE;
+      handler:{$ifndef TP}@{$endif}pd_inline;
+      flag:poinline;
+      pd_flags:pd_implemen+pd_body;
+      mut_excl:poexports+poexternal+pointernproc+pointerrupt+poconstructor+podestructor
+    ),(
+      idtok:_INTERNCONST;
+      handler:{$ifndef TP}@{$endif}pd_intern;
+      flag:pointernconst;
+      pd_flags:pd_implemen+pd_body;
+      mut_excl:pointernproc+pooperator
+    ),(
+      idtok:_INTERNPROC;
+      handler:{$ifndef TP}@{$endif}pd_intern;
+      flag:pointernproc;
+      pd_flags:pd_implemen;
+      mut_excl:poexports+poexternal+pointerrupt+poassembler+poclearstack+poleftright+poiocheck+
+               poconstructor+podestructor+pooperator
+    ),(
+      idtok:_INTERRUPT;
+      handler:nil;
+      flag:pointerrupt;
+      pd_flags:pd_implemen+pd_body;
+      mut_excl:pointernproc+poclearstack+poleftright+poinline+
+               poconstructor+podestructor+pooperator+poexternal
+    ),(
+      idtok:_IOCHECK;
+      handler:nil;
+      flag:poiocheck;
+      pd_flags:pd_implemen+pd_body;
+      mut_excl:pointernproc+poexternal
+    ),(
+      idtok:_NEAR;
+      handler:{$ifndef TP}@{$endif}pd_near;
+      flag:0;
+      pd_flags:pd_implemen+pd_body+pd_procvar;
+      mut_excl:pointernproc
+    ),(
+      idtok:_OVERRIDE;
+      handler:{$ifndef TP}@{$endif}pd_override;
+      flag:pooverridingmethod or povirtualmethod;
+      pd_flags:pd_interface+pd_object;
+      mut_excl:poexports+poinline+pointernproc+pointerrupt+poexternal
+    ),(
+      idtok:_PASCAL;
+      handler:nil;
+      flag:poleftright;
+      pd_flags:pd_implemen+pd_body+pd_procvar;
+      mut_excl:pointernproc+poexternal
+    ),(
+      idtok:_POPSTACK;
+      handler:nil;
+      flag:poclearstack;
+      pd_flags:pd_interface+pd_implemen+pd_body+pd_procvar;
+      mut_excl:poinline+pointernproc+poassembler+poexternal
+    ),(
+      idtok:_PUBLIC;
+      handler:nil;
+      flag:0;
+      pd_flags:pd_implemen+pd_body+pd_global+pd_notobject;
+      mut_excl:pointernproc+poinline+poexternal
+    ),(
+      idtok:_REGISTER;
+      handler:{$ifndef TP}@{$endif}pd_register;
+      flag:poregister;
+      pd_flags:pd_interface+pd_implemen+pd_body+pd_procvar;
+      mut_excl:poleftright+pocdecl+pointernproc+poexternal
+    ),(
+      idtok:_SAFECALL;
+      handler:{$ifndef TP}@{$endif}pd_safecall;
+      flag:posafecall+posavestdregs;
+      pd_flags:pd_interface+pd_implemen+pd_body+pd_procvar;
+      mut_excl:poleftright+pocdecl+pointernproc+poinline+poexternal
+    ),(
+      idtok:_STATIC;
+      handler:{$ifndef TP}@{$endif}pd_static;
+      flag:postaticmethod;
+      pd_flags:pd_interface+pd_object;
+      mut_excl:poexports+poinline+pointernproc+pointerrupt+poexternal+
+               poconstructor+podestructor
+    ),(
+      idtok:_STDCALL;
+      handler:{$ifndef TP}@{$endif}pd_stdcall;
+      flag:postdcall+posavestdregs;
+      pd_flags:pd_interface+pd_implemen+pd_body+pd_procvar;
+      mut_excl:poleftright+pocdecl+pointernproc+poinline+poexternal
+    ),(
+      idtok:_SYSCALL;
+      handler:{$ifndef TP}@{$endif}pd_syscall;
+      flag:popalmossyscall;
+      pd_flags:pd_interface;
+      mut_excl:poexports+poinline+pointernproc+pointerrupt+poassembler+poexternal
+    ),(
+      idtok:_SYSTEM;
+      handler:{$ifndef TP}@{$endif}pd_system;
+      flag:poclearstack;
+      pd_flags:pd_implemen;
+      mut_excl:poleftright+poinline+poassembler+pointernproc+poexternal
+    ),(
+      idtok:_VIRTUAL;
+      handler:{$ifndef TP}@{$endif}pd_virtual;
+      flag:povirtualmethod;
+      pd_flags:pd_interface+pd_object;
+      mut_excl:poexports+poinline+pointernproc+pointerrupt+poexternal
+    )
+   );
+
+var
+  p     : longint;
+  found : boolean;
+  name  : string;
+begin
+  parse_proc_direc:=false;
+  name:=pattern;
+  found:=false;
+  for p:=1 to num_proc_directives do
+   if proc_direcdata[p].idtok=idtoken then
+    begin
+      found:=true;
+      break;
+    end;
+
+{ Check if the procedure directive is known }
+  if not found then
+   begin
+      { parsing a procvar type the name can be any
+        next variable !! }
+      if (pdflags and (pd_procvar or pd_object))=0 then
+        Message1(parser_w_unknown_proc_directive_ignored,name);
+      exit;
+   end;
+
+  { static needs a special treatment }
+  if (idtoken=_STATIC) and not (cs_static_keyword in aktmoduleswitches) then
+    exit;
+
+{ Conflicts between directives ? }
+  if (aktprocsym^.definition^.options and proc_direcdata[p].mut_excl)<>0 then
+   begin
+     Message1(parser_e_proc_dir_conflict,name);
+     exit;
+   end;
+
+{ Check if the directive is only for objects }
+  if ((proc_direcdata[p].pd_flags and pd_object)<>0) and
+     not assigned(aktprocsym^.definition^._class) then
+    begin
+      exit;
+    end;
+{ check if method and directive not for object public }
+  if ((proc_direcdata[p].pd_flags and pd_notobject)<>0) and
+     assigned(aktprocsym^.definition^._class) then
+    begin
+      exit;
+    end;
+
+{ consume directive, and turn flag on }
+  consume(token);
+  parse_proc_direc:=true;
+
+{ Check the pd_flags if the directive should be allowed }
+  if ((pdflags and pd_interface)<>0) and
+     ((proc_direcdata[p].pd_flags and pd_interface)=0) then
+    begin
+      Message1(parser_e_proc_dir_not_allowed_in_interface,name);
+      exit;
+    end;
+  if ((pdflags and pd_implemen)<>0) and
+     ((proc_direcdata[p].pd_flags and pd_implemen)=0) then
+    begin
+      Message1(parser_e_proc_dir_not_allowed_in_implementation,name);
+      exit;
+    end;
+  if ((pdflags and pd_procvar)<>0) and
+     ((proc_direcdata[p].pd_flags and pd_procvar)=0) then
+    begin
+      Message1(parser_e_proc_dir_not_allowed_in_procvar,name);
+      exit;
+    end;
+
+{ Return the new pd_flags }
+  if (proc_direcdata[p].pd_flags and pd_body)=0 then
+    pdflags:=pdflags and (not pd_body);
+  if (proc_direcdata[p].pd_flags and pd_global)<>0 then
+    pdflags:=pdflags or pd_global;
+
+{ Add the correct flag }
+  aktprocsym^.definition^.options:=aktprocsym^.definition^.options or proc_direcdata[p].flag;
+
+ { Adjust positions of args for cdecl or stdcall }
+   if (aktprocsym^.definition^.deftype=procdef) and
+      ((aktprocsym^.definition^.options and (pocdecl or postdcall))<>0) then
+     aktprocsym^.definition^.parast^.set_alignment(target_os.size_of_longint);
+
+{ Call the handler }
+  if pointer({$ifndef FPC}@{$endif}proc_direcdata[p].handler)<>nil then
+    proc_direcdata[p].handler(proc_names);
+end;
+
+{***************************************************************************}
+
+function check_identical : boolean;
+{
+  Search for idendical definitions,
+  if there is a forward, then kill this.
+
+  Returns the result of the forward check.
+
+  Removed from unter_dec to keep the source readable
+}
+const
+{List of procedure options that affect the procedure type.}
+  po_type_params=poconstructor+podestructor+pooperator;
+
+  po_call_params=pocdecl+poclearstack+poleftright+poregister;
+
+var
+  hd,pd : Pprocdef;
+  storeparast : psymtable;
+  ad,fd : psym;
+  s : string;
+begin
+  check_identical:=false;
+  pd:=aktprocsym^.definition;
+  if assigned(pd) then
+   begin
+   { Is there an overload/forward ? }
+     if assigned(pd^.nextoverloaded) then
+      begin
+      { walk the procdef list }
+        while (assigned(pd)) and (assigned(pd^.nextoverloaded)) do
+         begin
+           if not(m_repeat_forward in aktmodeswitches) or
+              equal_paras(aktprocsym^.definition^.para1,pd^.nextoverloaded^.para1,false) then
+             begin
+               if pd^.nextoverloaded^.forwarddef then
+               { remove the forward definition  but don't delete it,      }
+               { the symtable is the owner !!  }
+                 begin
+                   hd:=pd^.nextoverloaded;
+                 { Check if the procedure type and return type are correct }
+                   if ((hd^.options and po_type_params)<>(aktprocsym^.definition^.options and po_type_params)) or
+                      (not(is_equal(hd^.retdef,aktprocsym^.definition^.retdef)) and
+                      (m_repeat_forward in aktmodeswitches)) then
+                     begin
+                       Message1(parser_e_header_dont_match_forward,aktprocsym^.demangledName);
+                       exit;
+                     end;
+                 { Check calling convention }
+                   if ((hd^.options and po_call_params)<>(aktprocsym^.definition^.options and po_call_params)) then
+                    begin
+                      { only trigger an error, becuase it doesn't hurt }
+                      Message(parser_e_call_convention_dont_match_forward);
+                    end;
+                 { manglednames are equal? }
+                   hd^.count:=false;
+                   if (m_repeat_forward in aktmodeswitches) or
+                      aktprocsym^.definition^.haspara then
+                    begin
+                      if (hd^.mangledname<>aktprocsym^.definition^.mangledname) then
+                       begin
+                         { When overloading is not possible then we issue an error }
+                         if not(m_repeat_forward in aktmodeswitches) then
+                          begin
+                            Message1(parser_e_header_dont_match_forward,aktprocsym^.demangledName);
+                            exit;
+                          end;
+
+                         if (aktprocsym^.definition^.options and poexternal)=0 then
+                           Message2(parser_n_interface_name_diff_implementation_name,hd^.mangledname,
+                             aktprocsym^.definition^.mangledname);
+                       { reset the mangledname of the interface part to be sure }
+                       { this is wrong because the mangled name might have been used already !! }
+                          if hd^.is_used then
+                            renameasmsymbol(hd^.mangledname,aktprocsym^.definition^.mangledname);
+                          hd^.setmangledname(aktprocsym^.definition^.mangledname);
+                       { so we need to keep the name of interface !!
+                         No!!!! The procedure directives can change the mangledname.
+                         I fixed this by first calling check_identical and then doing
+                         the proc directives, but this is not a good solution.(DM)}
+                         { this is also wrong (PM)
+                         aktprocsym^.definition^.setmangledname(hd^.mangledname);}
+                       end
+                     else
+                       begin
+                       { If mangled names are equal, therefore    }
+                       { they have the same number of parameters  }
+                       { Therefore we can check the name of these }
+                       { parameters...                      }
+                         if hd^.forwarddef and aktprocsym^.definition^.forwarddef then
+                           begin
+                             Message1(parser_e_function_already_declared_public_forward,aktprocsym^.demangledName);
+                             Check_identical:=true;
+                           { Remove other forward from the list to reduce errors }
+                             pd^.nextoverloaded:=pd^.nextoverloaded^.nextoverloaded;
+                             exit;
+                           end;
+                         ad:=psym(hd^.parast^.symindex^.first);
+                         fd:=psym(aktprocsym^.definition^.parast^.symindex^.first);
+                         if assigned(ad) and assigned(fd) then
+                           begin
+                             while assigned(ad) and assigned(fd) do
+                               begin
+                                 s:=ad^.name;
+                                 if s<>fd^.name then
+                                   begin
+                                     Message3(parser_e_header_different_var_names,
+                                       aktprocsym^.name,s,fd^.name);
+                                     break;
+                                   end;
+                               { it is impossible to have a nil pointer }
+                               { for only one parameter - since they    }
+                               { have the same number of parameters.    }
+                               { Left = next parameter.          }
+                                 ad:=psym(ad^.left);
+                                 fd:=psym(fd^.left);
+                               end;
+                           end;
+                       end;
+                    end;
+                 { also the call_offset }
+                   hd^.parast^.address_fixup:=aktprocsym^.definition^.parast^.address_fixup;
+                   hd^.count:=true;
+
+                 { remove pd^.nextoverloaded from the list }
+                 { and add aktprocsym^.definition }
+                   pd^.nextoverloaded:=pd^.nextoverloaded^.nextoverloaded;
+                   hd^.nextoverloaded:=aktprocsym^.definition^.nextoverloaded;
+                 { Alert! All fields of aktprocsym^.definition that are modified
+                   by the procdir handlers must be copied here!.}
+                   hd^.forwarddef:=false;
+                   hd^.options:=hd^.options or aktprocsym^.definition^.options;
+                   if aktprocsym^.definition^.extnumber=-1 then
+                     aktprocsym^.definition^.extnumber:=hd^.extnumber
+                   else
+                     if hd^.extnumber=-1 then
+                       hd^.extnumber:=aktprocsym^.definition^.extnumber;
+                   { switch parast for warning in implementation  PM }
+                   if (m_repeat_forward in aktmodeswitches) or
+                      aktprocsym^.definition^.haspara then
+                     begin
+                        storeparast:=hd^.parast;
+                        hd^.parast:=aktprocsym^.definition^.parast;
+                        aktprocsym^.definition^.parast:=storeparast;
+                     end;
+                   aktprocsym^.definition:=hd;
+                   check_identical:=true;
+                 end
+               else
+               { abstract methods aren't forward defined, but this }
+               { needs another error message                   }
+                 if (pd^.nextoverloaded^.options and poabstractmethod)=0 then
+                   Message(parser_e_overloaded_have_same_parameters)
+                 else
+                   Message(parser_e_abstract_no_definition);
+               break;
+             end;
+           pd:=pd^.nextoverloaded;
+         end;
+      end
+     else
+      begin
+      { there is no overloaded, so its always identical with itself }
+        check_identical:=true;
+      end;
+   end;
+{ insert opsym only in the right symtable }
+  if ((procinfo.flags and pi_operator)<>0) and not parse_only then
+    begin
+      if ret_in_param(aktprocsym^.definition^.retdef) then
+        begin
+          pprocdef(aktprocsym^.definition)^.parast^.insert(opsym);
+        { this increases the data size }
+        { correct this to get the right ret $value }
+          dec(pprocdef(aktprocsym^.definition)^.parast^.datasize,opsym^.getpushsize);
+          { this allows to read the funcretoffset }
+          opsym^.address:=-4;
+          opsym^.varspez:=vs_var;
+        end
+      else
+        pprocdef(aktprocsym^.definition)^.localst^.insert(opsym);
+    end;
+end;
+
+procedure compile_proc_body(const proc_names:Tstringcontainer;
+                            make_global,parent_has_class:boolean);
+{
+  Compile the body of a procedure
+}
+var
+   oldexitlabel,oldexit2label,oldquickexitlabel:Pasmlabel;
+   _class,hp:Pobjectdef;
+   { switches can change inside the procedure }
+   entryswitches, exitswitches : tlocalswitches;
+   { code for the subroutine as tree }
+   code:ptree;
+   { size of the local strackframe }
+   stackframe:longint;
+   { true when no stackframe is required }
+   nostackframe:boolean;
+   { number of bytes which have to be cleared by RET }
+   parasize:longint;
+   { filepositions }
+   entrypos,
+   savepos,
+   exitpos   : tfileposinfo;
+begin
+   { calculate the lexical level }
+   inc(lexlevel);
+   if lexlevel>32 then
+    Message(parser_e_too_much_lexlevel);
+
+   { static is also important for local procedures !! }
+   if ((aktprocsym^.definition^.options and postaticmethod)<>0) then
+     allow_only_static:=true
+   else if (lexlevel=normal_function_level) then
+     allow_only_static:=false;
+
+   { save old labels }
+   oldexitlabel:=aktexitlabel;
+   oldexit2label:=aktexit2label;
+   oldquickexitlabel:=quickexitlabel;
+   { get new labels }
+   getlabel(aktexitlabel);
+   getlabel(aktexit2label);
+   { exit for fail in constructors }
+   if (aktprocsym^.definition^.options and poconstructor)<>0 then
+     getlabel(quickexitlabel);
+   { reset break and continue labels }
+   in_except_block:=false;
+   aktbreaklabel:=nil;
+   aktcontinuelabel:=nil;
+
+   { insert symtables for the class, by only if it is no nested function }
+   if assigned(procinfo._class) and not(parent_has_class) then
+     begin
+       { insert them in the reverse order ! }
+       hp:=nil;
+       repeat
+         _class:=procinfo._class;
+         while _class^.childof<>hp do
+           _class:=_class^.childof;
+         hp:=_class;
+         _class^.publicsyms^.next:=symtablestack;
+         symtablestack:=_class^.publicsyms;
+       until hp=procinfo._class;
+     end;
+
+   { insert parasymtable in symtablestack}
+   { only if lexlevel > 1 !!! global symtable should be right after staticsymtazble
+     for checking of same names used in interface and implementation !! }
+   if lexlevel>=normal_function_level then
+     begin
+        aktprocsym^.definition^.parast^.next:=symtablestack;
+        symtablestack:=aktprocsym^.definition^.parast;
+        symtablestack^.symtablelevel:=lexlevel;
+     end;
+   { insert localsymtable in symtablestack}
+   aktprocsym^.definition^.localst^.next:=symtablestack;
+   symtablestack:=aktprocsym^.definition^.localst;
+   symtablestack^.symtablelevel:=lexlevel;
+   { constant symbols are inserted in this symboltable }
+   constsymtable:=symtablestack;
+
+   { reset the temporary memory }
+   cleartempgen;
+   { no registers are used }
+   usedinproc:=0;
+
+   { save entry info }
+   entrypos:=aktfilepos;
+   entryswitches:=aktlocalswitches;
+
+   { parse the code ... }
+   if (aktprocsym^.definition^.options and poassembler)<> 0 then
+     code:=assembler_block
+   else
+     code:=block(current_module^.islibrary);
+
+   { get a better entry point }
+   if assigned(code) then
+     entrypos:=code^.fileinfo;
+
+   { save exit info }
+   exitswitches:=aktlocalswitches;
+   exitpos:=last_endtoken_filepos;
+
+   { save current filepos }
+   savepos:=aktfilepos;
+
+   {When we are called to compile the body of a unit, aktprocsym should
+    point to the unit initialization. If the unit has no initialization,
+    aktprocsym=nil. But in that case code=nil. hus we should check for
+    code=nil, when we use aktprocsym.}
+
+   { set the framepointer to esp for assembler functions }
+   { but only if the are no local variables           }
+   { already done in assembler_block }
+   setfirsttemp(procinfo.firsttemp);
+
+   { ... and generate assembler }
+   { but set the right switches for entry !! }
+   aktlocalswitches:=entryswitches;
+{$ifndef NOPASS2}
+   if assigned(code) then
+     generatecode(code);
+   { set switches to status at end of procedure }
+   aktlocalswitches:=exitswitches;
+
+   if assigned(code) then
+     begin
+        aktprocsym^.definition^.code:=code;
+
+        { the procedure is now defined }
+        aktprocsym^.definition^.forwarddef:=false;
+        aktprocsym^.definition^.usedregisters:=usedinproc;
+     end;
+
+   stackframe:=gettempsize;
+
+   { first generate entry code with the correct position and switches }
+   aktfilepos:=entrypos;
+   aktlocalswitches:=entryswitches;
+   if assigned(code) then
+     genentrycode(procinfo.aktentrycode,proc_names,make_global,stackframe,parasize,nostackframe,false);
+
+   { now generate exit code with the correct position and switches }
+   aktfilepos:=exitpos;
+   aktlocalswitches:=exitswitches;
+   if assigned(code) then
+     begin
+       genexitcode(procinfo.aktexitcode,parasize,nostackframe,false);
+       procinfo.aktproccode^.insertlist(procinfo.aktentrycode);
+       procinfo.aktproccode^.concatlist(procinfo.aktexitcode);
+{$ifdef i386}
+ {$ifndef NoOpt}
+       if (cs_optimize in aktglobalswitches) and
+       { do not optimize pure assembler procedures }
+         ((procinfo.flags and pi_is_assembler)=0)  then
+           Optimize(procinfo.aktproccode);
+ {$endif NoOpt}
+{$endif}
+       { save local data (casetable) also in the same file }
+       if assigned(procinfo.aktlocaldata) and
+          (not procinfo.aktlocaldata^.empty) then
+         begin
+            procinfo.aktproccode^.concat(new(pai_section,init(sec_data)));
+            procinfo.aktproccode^.concatlist(procinfo.aktlocaldata);
+         end;
+       { now we can insert a cut }
+       if (cs_smartlink in aktmoduleswitches) then
+         codesegment^.concat(new(pai_cut,init));
+
+       { add the procedure to the codesegment }
+       codesegment^.concatlist(procinfo.aktproccode);
+     end;
+{$else}
+   if assigned(code) then
+    firstpass(code);
+{$endif NOPASS2}
+
+   { ... remove symbol tables, for the browser leave the static table }
+{    if (cs_browser in aktmoduleswitches) and (symtablestack^.symtabletype=staticsymtable) then
+    symtablestack^.next:=symtablestack^.next^.next
+   else }
+   if lexlevel>=normal_function_level then
+     symtablestack:=symtablestack^.next^.next
+   else
+     symtablestack:=symtablestack^.next;
+
+   { ... check for unused symbols      }
+   { but only if there is no asm block }
+   if assigned(code) then
+     begin
+       if (Errorcount=0) then
+         begin
+           aktprocsym^.definition^.localst^.check_forwards;
+           aktprocsym^.definition^.localst^.checklabels;
+         end;
+       if (procinfo.flags and pi_uses_asm)=0 then
+         begin
+            { not for unit init, becuase the var can be used in finalize,
+              it will be done in proc_unit }
+            if (aktprocsym^.definition^.options and (pounitinit or pounitfinalize))=0 then
+              aktprocsym^.definition^.localst^.allsymbolsused;
+            aktprocsym^.definition^.parast^.allsymbolsused;
+         end;
+     end;
+
+   { the local symtables can be deleted, but the parast   }
+   { doesn't, (checking definitons when calling a        }
+   { function                                        }
+   { not for a inline procedure !!               (PM)   }
+   { at lexlevel = 1 localst is the staticsymtable itself }
+   { so no dispose here !!                              }
+   if assigned(code) and
+      not(cs_browser in aktmoduleswitches) and
+      ((aktprocsym^.definition^.options and poinline)=0) then
+     begin
+       if lexlevel>=normal_function_level then
+         dispose(aktprocsym^.definition^.localst,done);
+       aktprocsym^.definition^.localst:=nil;
+     end;
+
+   { only now we can remove the temps }
+   resettempgen;
+
+   { remove code tree, if not inline procedure }
+   if assigned(code) and ((aktprocsym^.definition^.options and poinline)=0) then
+     disposetree(code);
+
+   { remove class member symbol tables }
+   while symtablestack^.symtabletype=objectsymtable do
+     symtablestack:=symtablestack^.next;
+
+   { restore filepos, the switches are already set }
+   aktfilepos:=savepos;
+   { free labels }
+   freelabel(aktexitlabel);
+   freelabel(aktexit2label);
+   if (aktprocsym^.definition^.options and poconstructor)<>0 then
+    freelabel(quickexitlabel);
+   { restore labels }
+   aktexitlabel:=oldexitlabel;
+   aktexit2label:=oldexit2label;
+   quickexitlabel:=oldquickexitlabel;
+
+   { reset to normal non static function }
+   if (lexlevel=normal_function_level) then
+     allow_only_static:=false;
+   { previous lexlevel }
+   dec(lexlevel);
+end;
+
+
+procedure parse_proc_directives(Anames:Pstringcontainer;var pdflags:word);
+{
+  Parse the procedure directives. It does not matter if procedure directives
+  are written using ;procdir; or ['procdir'] syntax.
+}
+var
+  res : boolean;
+begin
+  while token in [ID,LECKKLAMMER] do
+   begin
+     if try_to_consume(LECKKLAMMER) then
+      begin
+        repeat
+          parse_proc_direc(Anames^,pdflags);
+        until not try_to_consume(COMMA);
+        consume(RECKKLAMMER);
+        { we always expect at least '[];' }
+        res:=true;
+      end
+     else
+      res:=parse_proc_direc(Anames^,pdflags);
+   { A procedure directive is always followed by a semicolon }
+     if res then
+      consume(SEMICOLON)
+     else
+      break;
+   end;
+end;
+
+procedure parse_var_proc_directives(var sym : ptypesym);
+var
+  anames : pstringcontainer;
+  pdflags : word;
+  oldsym : pprocsym;
+begin
+  oldsym:=aktprocsym;
+  anames:=new(pstringcontainer,init);
+  pdflags:=pd_procvar;
+  { we create a temporary aktprocsym to read the directives }
+  aktprocsym:=new(pprocsym,init(sym^.name));
+  { aktprocsym^.definition:=pprocdef(sym^.definition);
+    this breaks the rule for TESTOBJEXT !! }
+  pabstractprocdef(aktprocsym^.definition):=pabstractprocdef(sym^.definition);
+  { names should never be used anyway }
+  inc(lexlevel);
+  parse_proc_directives(anames,pdflags);
+  dec(lexlevel);
+  aktprocsym^.definition:=nil;
+  dispose(aktprocsym,done);
+  dispose(anames,done);
+  aktprocsym:=oldsym;
+end;
+
+procedure parse_object_proc_directives(var sym : pprocsym);
+var
+  anames : pstringcontainer;
+  pdflags : word;
+begin
+  pdflags:=pd_object;
+  anames:=new(pstringcontainer,init);
+  inc(lexlevel);
+  parse_proc_directives(anames,pdflags);
+  dec(lexlevel);
+  dispose(anames,done);
+  if ((aktprocsym^.definition^.options and pocontainsself)<>0) and
+    ((aktprocsym^.definition^.options and pomsgstr)=0) then
+    message(parser_e_self_in_non_message_handler);
+end;
+
+procedure checkvaluepara(p:pnamedindexobject);{$ifndef FPC}far;{$endif}
+var
+  vs : pvarsym;
+  s  : string;
+begin
+  with pvarsym(p)^ do
+   begin
+     if copy(name,1,3)='val' then
+      begin
+        s:=Copy(name,4,255);
+        if ((aktprocsym^.definition^.options and poassembler)=0) then
+         begin
+           vs:=new(Pvarsym,init(s,definition));
+           vs^.fileinfo:=fileinfo;
+           vs^.varspez:=varspez;
+           aktprocsym^.definition^.localst^.insert(vs);
+           vs^.islocalcopy:=true;
+           vs^.is_valid:=1;
+           localvarsym:=vs;
+         end
+        else
+         begin
+           aktprocsym^.definition^.parast^.rename(name,s);
+         end;
+      end;
+   end;
+end;
+
+
+procedure read_proc;
+{
+  Parses the procedure directives, then parses the procedure body, then
+  generates the code for it
+}
+var
+  oldprefix     : string;
+  oldprocsym       : Pprocsym;
+  oldprocinfo      : tprocinfo;
+  oldconstsymtable : Psymtable;
+  oldfilepos       : tfileposinfo;
+  names     : Pstringcontainer;
+  pdflags         : word;
+begin
+{ save old state }
+   oldprocsym:=aktprocsym;
+   oldprefix:=procprefix;
+   oldconstsymtable:=constsymtable;
+   oldprocinfo:=procinfo;
+{ create a new procedure }
+   new(names,init);
+   codegen_newprocedure;
+   with procinfo do
+    begin
+      parent:=@oldprocinfo;
+    { clear flags }
+      flags:=0;
+    { standard frame pointer }
+      framepointer:=frame_pointer;
+      funcret_is_valid:=false;
+    { is this a nested function of a method ? }
+      _class:=oldprocinfo._class;
+    end;
+
+   parse_proc_dec;
+
+{ set the default function options }
+   if parse_only then
+    begin
+      aktprocsym^.properties:=aktprocsym^.properties or sp_forwarddef;
+      aktprocsym^.definition^.forwarddef:=true;
+      { set also the interface flag, for better error message when the
+        implementation doesn't much this header }
+      aktprocsym^.definition^.interfacedef:=true;
+      pdflags:=pd_interface;
+    end
+   else
+    begin
+      pdflags:=pd_body;
+      if current_module^.in_implementation then
+       pdflags:=pdflags or pd_implemen;
+      if (not current_module^.is_unit) or (cs_smartlink in aktmoduleswitches) then
+       pdflags:=pdflags or pd_global;
+      procinfo.exported:=false;
+      aktprocsym^.definition^.forwarddef:=false;
+    end;
+
+{ parse the directives that may follow }
+   inc(lexlevel);
+   parse_proc_directives(names,pdflags);
+   dec(lexlevel);
+
+{ set aktfilepos to the beginning of the function declaration }
+   oldfilepos:=aktfilepos;
+   aktfilepos:=aktprocsym^.definition^.fileinfo;
+
+{ search for forward declarations }
+   if not check_identical then
+     begin
+     { A method must be forward defined (in the object declaration) }
+       if assigned(procinfo._class) and (not assigned(oldprocinfo._class)) then
+         Message(parser_e_header_dont_match_any_member);
+     { Give a better error if there is a forward def in the interface and only
+       a single implementation }
+       if (not aktprocsym^.definition^.forwarddef) and
+          assigned(aktprocsym^.definition^.nextoverloaded) and
+          aktprocsym^.definition^.nextoverloaded^.forwarddef and
+          aktprocsym^.definition^.nextoverloaded^.interfacedef and
+          not(assigned(aktprocsym^.definition^.nextoverloaded^.nextoverloaded)) then
+         Message1(parser_e_header_dont_match_forward,aktprocsym^.demangledName)
+       else
+        begin
+        { check the global flag }
+          if (procinfo.flags and pi_is_global)<>0 then
+            Message(parser_e_overloaded_must_be_all_global);
+        end
+     end;
+
+{ set return type here, becuase the aktprocsym^.definition can be
+  changed by check_identical (PFV) }
+   procinfo.retdef:=aktprocsym^.definition^.retdef;
+
+   { pointer to the return value ? }
+   if ret_in_param(procinfo.retdef) then
+    begin
+      procinfo.retoffset:=procinfo.call_offset;
+      inc(procinfo.call_offset,target_os.size_of_pointer);
+    end;
+   { allows to access the parameters of main functions in nested functions }
+   aktprocsym^.definition^.parast^.address_fixup:=procinfo.call_offset;
+
+   { when it is a value para and it needs a local copy then rename
+     the parameter and insert a copy in the localst. This is not done
+     for assembler procedures }
+   if (not parse_only) and (not aktprocsym^.definition^.forwarddef) then
+     aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}checkvaluepara);
+
+{ restore file pos }
+   aktfilepos:=oldfilepos;
+
+{ compile procedure when a body is needed }
+   if (pdflags and pd_body)<>0 then
+     begin
+       Message1(parser_p_procedure_start,aktprocsym^.demangledname);
+       names^.insert(aktprocsym^.definition^.mangledname);
+      { set _FAIL as keyword if constructor }
+      if (aktprocsym^.definition^.options and poconstructor)<>0 then
+        tokeninfo[_FAIL].keyword:=m_all;
+      if assigned(aktprocsym^.definition^._class) then
+        tokeninfo[_SELF].keyword:=m_all;
+
+       compile_proc_body(names^,((pdflags and pd_global)<>0),assigned(oldprocinfo._class));
+
+      { reset _FAIL as normal }
+      if (aktprocsym^.definition^.options and poconstructor)<>0 then
+        tokeninfo[_FAIL].keyword:=m_none;
+      if assigned(aktprocsym^.definition^._class) and (lexlevel=main_program_level) then
+        tokeninfo[_SELF].keyword:=m_none;
+       consume(SEMICOLON);
+     end;
+{ close }
+   dispose(names,done);
+   codegen_doneprocedure;
+{ Restore old state }
+   constsymtable:=oldconstsymtable;
+   { from now on all refernece to mangledname means
+     that the function is already used }
+   aktprocsym^.definition^.count:=true;
+   aktprocsym:=oldprocsym;
+   procprefix:=oldprefix;
+   procinfo:=oldprocinfo;
+   opsym:=nil;
+end;
+
+end.
+
+{
+  $Log$
+  Revision 1.1  1999-06-11 13:21:37  peter
+    * reinserted
+
+  Revision 1.153  1999/06/02 22:44:14  pierre
+   * previous wrong log corrected
+
+  Revision 1.152  1999/06/02 22:25:46  pierre
+  * changed $ifdef FPC @ into $ifndef TP
+
+  Revision 1.151  1999/06/01 22:47:06  pierre
+   * problem with static keyword solved
+
+  Revision 1.150  1999/06/01 14:45:53  peter
+    * @procvar is now always needed for FPC
+
+  Revision 1.149  1999/05/31 16:42:31  peter
+    * interfacedef flag for procdef if it's defined in the interface, to
+      make a difference with 'forward;' directive forwarddef. Fixes 253
+
+  Revision 1.148  1999/05/27 19:44:52  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.147  1999/05/24 08:55:27  florian
+    * non working safecall directiv implemented, I don't know if we
+      need it
+
+  Revision 1.146  1999/05/23 18:42:11  florian
+    * better error recovering in typed constants
+    * some problems with arrays of const fixed, some problems
+      due my previous
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.145  1999/05/21 13:55:09  peter
+    * NEWLAB for label as symbol
+
+  Revision 1.144  1999/05/18 14:15:55  peter
+    * containsself fixes
+    * checktypes()
+
+  Revision 1.143  1999/05/17 21:57:13  florian
+    * new temporary ansistring handling
+
+  Revision 1.142  1999/05/17 15:06:38  pierre
+   * fixes for object type check
+
+  Revision 1.141  1999/05/13 21:59:39  peter
+    * removed oldppu code
+    * warning if objpas is loaded from uses
+    * first things for new deref writing
+
+  Revision 1.140  1999/05/12 22:36:12  florian
+    * override isn't allowed in objects!
+
+  Revision 1.139  1999/05/10 09:01:41  peter
+    * small message fixes
+
+  Revision 1.138  1999/05/09 12:46:24  peter
+    + hint where a duplicate sym is already defined
+
+  Revision 1.137  1999/05/08 19:48:45  peter
+    * better error message if declaration doesn't match forward
+
+  Revision 1.136  1999/05/08 15:26:15  peter
+    * print also manglednames when changed
+
+  Revision 1.135  1999/05/06 10:12:10  peter
+    * fixed operator result offset which destroyed parast^.datasize
+
+  Revision 1.134  1999/05/01 13:24:36  peter
+    * merged nasm compiler
+    * old asm moved to oldasm/
+
+  Revision 1.133  1999/04/28 11:12:03  peter
+    * fixed crash with self pointer
+
+  Revision 1.132  1999/04/28 06:02:09  florian
+    * changes of Bruessel:
+       + message handler can now take an explicit self
+       * typinfo fixed: sometimes the type names weren't written
+       * the type checking for pointer comparisations and subtraction
+         and are now more strict (was also buggy)
+       * small bug fix to link.pas to support compiling on another
+         drive
+       * probable bug in popt386 fixed: call/jmp => push/jmp
+         transformation didn't count correctly the jmp references
+       + threadvar support
+       * warning if ln/sqrt gets an invalid constant argument
+
+  Revision 1.131  1999/04/26 13:31:44  peter
+    * release storenumber,double_checksum
+
+  Revision 1.130  1999/04/21 09:43:49  peter
+    * storenumber works
+    * fixed some typos in double_checksum
+    + incompatible types type1 and type2 message (with storenumber)
+
+  Revision 1.129  1999/04/20 14:39:07  daniel
+  *** empty log message ***
+
+  Revision 1.125  1999/04/14 09:14:55  peter
+    * first things to store the symbol/def number in the ppu
+
+  Revision 1.124  1999/04/07 15:31:13  pierre
+    * all formaldefs are now a sinlge definition
+      cformaldef (this was necessary for double_checksum)
+    + small part of double_checksum code
+
+  Revision 1.123  1999/04/06 11:21:58  peter
+    * more use of ttoken
+
+  Revision 1.122  1999/03/31 13:55:16  peter
+    * assembler inlining working for ag386bin
+
+  Revision 1.121  1999/03/26 00:05:39  peter
+    * released valintern
+    + deffile is now removed when compiling is finished
+    * ^( compiles now correct
+    + static directive
+    * shrd fixed
+
+  Revision 1.120  1999/03/24 23:17:18  peter
+    * fixed bugs 212,222,225,227,229,231,233
+
+  Revision 1.119  1999/03/05 09:46:18  pierre
+   * public problem for methods
+
+  Revision 1.118  1999/03/05 01:14:24  pierre
+    * bug0198 : call conventions for methods
+      not yet implemented is the control of same calling convention
+      for virtual and child's virtual
+    * msgstr and msgint only created if message was found
+      who implemented this by the way ?
+      it leaks lots of plabels !!!! (check with heaptrc !)
+
+  Revision 1.117  1999/03/04 13:55:47  pierre
+    * some m68k fixes (still not compilable !)
+    * new(tobj) does not give warning if tobj has no VMT !
+
+  Revision 1.116  1999/03/01 15:40:52  peter
+    * external name <str> didn't concatexternal()
+
+  Revision 1.115  1999/03/01 13:31:58  pierre
+   * external used before implemented problem fixed
+
+  Revision 1.114  1999/02/24 00:59:15  peter
+    * small updates for ag386bin
+
+  Revision 1.113  1999/02/23 18:29:21  pierre
+    * win32 compilation error fix
+    + some work for local browser (not cl=omplete yet)
+
+  Revision 1.112  1999/02/22 13:07:03  pierre
+    + -b and -bl options work !
+    + cs_local_browser ($L+) is disabled if cs_browser ($Y+)
+      is not enabled when quitting global section
+    * local vars and procedures are not yet stored into PPU
+
+  Revision 1.111  1999/02/22 02:15:33  peter
+    * updates for ag386bin
+
+  Revision 1.110  1999/02/16 12:23:19  pierre
+   * nested forward procedure bug solved
+
+  Revision 1.109  1999/02/15 10:07:06  pierre
+   * memory leaks due to last commit solved
+
+  Revision 1.108  1999/02/11 09:46:27  pierre
+    * fix for normal method calls inside static methods :
+      WARNING there were both parser and codegen errors !!
+      added static_call boolean to calln tree
+
+  Revision 1.107  1999/02/10 11:27:39  pierre
+   * overloaded function locals problem bug0213
+
+  Revision 1.106  1999/02/08 11:29:05  pierre
+   * fix for bug0214
+     several problems where combined
+     search_class_member did not set srsymtable
+     => in do_member_read the call node got a wrong symtable
+     in cg386cal the vmt was pushed twice without chacking if it exists
+     now %esi is set to zero and pushed if not vmt
+     (not very efficient but should work !)
+
+  Revision 1.105  1999/02/05 12:51:20  florian
+    + openstring id is now supported
+
+  Revision 1.104  1999/02/03 09:26:44  pierre
+   + better reference for args of procs
+
+  Revision 1.103  1999/02/02 11:04:37  florian
+    * class destructors fixed, class instances weren't disposed correctly
+
+  Revision 1.102  1999/01/21 22:10:46  peter
+    * fixed array of const
+    * generic platform independent high() support
+
+  Revision 1.101  1999/01/20 14:18:38  pierre
+    * bugs related to mangledname solved
+      - linux external without name
+      -external procs already used
+      (added count and is_used boolean fiels in tprocvar)
+
+  Revision 1.100  1999/01/20 10:20:19  peter
+    * don't make localvar copies for assembler procedures
+
+  Revision 1.99  1999/01/19 15:59:40  pierre
+   * fix for function a;
+
+  Revision 1.98  1999/01/19 12:16:07  peter
+    * NOPASS2 now calls firstpass
+
+  Revision 1.97  1999/01/14 11:35:30  daniel
+  * Fixed manglednames
+
+  Revision 1.96  1998/12/30 13:41:10  peter
+    * released valuepara
+
+  Revision 1.95  1998/12/30 10:36:39  michael
+  + Delphi also allows external in interface section
+
+  Revision 1.94  1998/12/29 18:48:26  jonas
+    + optimize pascal code surrounding assembler blocks
+
+  Revision 1.93  1998/12/28 15:44:49  peter
+    + NOPASS2 define
+
+  Revision 1.92  1998/12/11 00:03:39  peter
+    + globtype,tokens,version unit splitted from globals
+
+  Revision 1.91  1998/11/27 14:50:42  peter
+    + open strings, $P switch support
+
+  Revision 1.90  1998/11/18 17:45:27  peter
+    * fixes for VALUEPARA
+
+  Revision 1.89  1998/11/18 15:44:15  peter
+    * VALUEPARA for tp7 compatible value parameters
+
+  Revision 1.88  1998/11/16 15:40:30  pierre
+   * mangling name and -So bugs solved
+
+  Revision 1.87  1998/11/16 11:29:02  pierre
+    * stackcheck removed for i386_win32
+    * exportlist does not crash at least !!
+      (was need for tests dir !)z
+
+  Revision 1.86  1998/11/16 10:13:54  peter
+    * label defines are checked at the end of the proc
+
+  Revision 1.85  1998/11/13 15:40:26  pierre
+    + added -Se in Makefile cvstest target
+    + lexlevel cleanup
+      normal_function_level main_program_level and unit_init_level defined
+    * tins_cache grown to A_EMMS (gave range check error in asm readers)
+      (test added in code !)
+    * -Un option was wrong
+    * _FAIL and _SELF only keyword inside
+      constructors and methods respectively
+
+  Revision 1.84  1998/11/10 10:09:13  peter
+    * va_list -> array of const
+
+  Revision 1.83  1998/11/09 11:44:34  peter
+    + va_list for printf support
+
+  Revision 1.82  1998/10/29 11:35:53  florian
+    * some dll support for win32
+    * fixed assembler writing for PalmOS
+
+  Revision 1.81  1998/10/28 18:26:16  pierre
+   * removed some erros after other errors (introduced by useexcept)
+   * stabs works again correctly (for how long !)
+
+  Revision 1.80  1998/10/27 13:45:37  pierre
+    * classes get a vmt allways
+    * better error info (tried to remove
+      several error strings introduced by the tpexcept handling)
+
+  Revision 1.79  1998/10/23 00:09:43  peter
+    * fixed message for forward declaration
+
+  Revision 1.78  1998/10/20 13:10:37  peter
+    * fixed crash when aktprocsym<>procsym
+
+  Revision 1.77  1998/10/20 08:06:55  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.76  1998/10/19 08:55:02  pierre
+    * wrong stabs info corrected once again !!
+    + variable vmt offset with vmt field only if required
+      implemented now !!!
+
+  Revision 1.75  1998/10/16 08:51:48  peter
+    + target_os.stackalignment
+    + stack can be aligned at 2 or 4 byte boundaries
+
+  Revision 1.74  1998/10/14 20:39:21  florian
+    * syscall for PalmOs fixed
+
+  Revision 1.73  1998/10/12 12:20:56  pierre
+    + added tai_const_symbol_offset
+      for r : pointer = @var.field;
+    * better message for different arg names on implementation
+      of function
+
+  Revision 1.72  1998/10/08 23:29:03  peter
+    * -vu shows unit info, -vt shows tried/used files
+
+  Revision 1.71  1998/10/08 17:17:28  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.70  1998/10/08 13:48:49  peter
+    * fixed memory leaks for do nothing source
+    * fixed unit interdependency
+
+  Revision 1.69  1998/10/05 21:33:27  peter
+    * fixed 161,165,166,167,168
+
+  Revision 1.68  1998/09/29 11:31:30  florian
+    * better error recovering when the object type of procedure tobject.method
+      isn't found
+
+  Revision 1.67  1998/09/26 17:45:39  peter
+    + idtoken and only one token table
+
+  Revision 1.66  1998/09/24 23:49:16  peter
+    + aktmodeswitches
+
+  Revision 1.65  1998/09/24 11:08:14  florian
+    * small problem in _proc_header with array of const fixed:
+      getsymonlyin doesn't set srsym to nil
+
+  Revision 1.64  1998/09/23 15:39:12  pierre
+    * browser bugfixes
+      was adding a reference when looking for the symbol
+      if -bSYM_NAME was used
+
+  Revision 1.63  1998/09/22 17:13:50  pierre
+    + browsing updated and developed
+      records and objects fields are also stored
+
+  Revision 1.62  1998/09/22 15:37:21  peter
+    + array of const start
+
+  Revision 1.61  1998/09/21 08:45:20  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.60  1998/09/17 09:42:42  peter
+    + pass_2 for cg386
+    * Message() -> CGMessage() for pass_1/pass_2
+
+  Revision 1.59  1998/09/15 14:05:25  jonas
+    * fixed optimizer incompatibilities with freelabel code in psub
+
+  Revision 1.58  1998/09/14 21:27:41  peter
+    - freelabel calls, becuase they are instable with -O2
+
+  Revision 1.57  1998/09/14 10:38:27  peter
+    * pd_alias now uses get_stringconst
+
+  Revision 1.56  1998/09/14 10:29:38  daniel
+  * Fixed memory leaks.
+
+  Revision 1.55  1998/09/09 11:50:56  pierre
+    * forward def are not put in record or objects
+    + added check for forwards also in record and objects
+    * dummy parasymtable for unit initialization removed from
+    symtable stack
+
+  Revision 1.54  1998/09/04 08:42:05  peter
+    * updated some error messages
+
+  Revision 1.53  1998/09/01 17:39:51  peter
+    + internal constant functions
+
+  Revision 1.52  1998/09/01 09:07:12  peter
+    * m68k fixes, splitted cg68k like cgi386
+
+  Revision 1.51  1998/09/01 07:54:21  pierre
+    * UseBrowser a little updated (might still be buggy !!)
+    * bug in psub.pas in function specifier removed
+    * stdcall allowed in interface and in implementation
+      (FPC will not yet complain if it is missing in either part
+      because stdcall is only a dummy !!)
+
+  Revision 1.50  1998/08/31 12:26:31  peter
+    * m68k and palmos updates from surebugfixes
+
+  Revision 1.49  1998/08/25 12:42:43  pierre
+    * CDECL changed to CVAR for variables
+      specifications are read in structures also
+    + started adding GPC compatibility mode ( option  -Sp)
+    * names changed to lowercase
+
+  Revision 1.48  1998/08/21 08:43:30  pierre
+    * pocdecl and poclearstack are now different
+      external must but written as last specification
+
+  Revision 1.47  1998/08/20 09:26:44  pierre
+    + funcret setting in underproc testing
+      compile with _dTEST_FUNCRET
+
+  Revision 1.46  1998/08/19 18:04:55  peter
+    * fixed current_module^.in_implementation flag
+
+  Revision 1.45  1998/08/13 10:58:38  peter
+    * fixed function reading for -So which was not correct after my previous
+      fix for bug 147
+
+  Revision 1.44  1998/08/10 14:50:18  peter
+    + localswitches, moduleswitches, globalswitches splitting
+
+  Revision 1.43  1998/08/10 09:58:33  peter
+    * Fixed function b; in -So mode
+
+  Revision 1.42  1998/07/30 16:07:11  florian
+    * try ... expect <statement> end; works now
+
+  Revision 1.41  1998/07/23 19:31:19  jonas
+    * split the optimizer
+
+  Revision 1.40  1998/07/21 11:16:24  florian
+    * bug0147 fixed
+
+  Revision 1.39  1998/07/14 21:46:54  peter
+    * updated messages file
+
+  Revision 1.38  1998/07/14 14:46:57  peter
+    * released NEWINPUT
+
+  Revision 1.37  1998/07/10 13:12:53  peter
+    * carls patch
+
+  Revision 1.36  1998/07/10 13:06:53  michael
+  + Carls patch. Checked make cycle.
+
+  Revision 1.35  1998/07/10 00:00:01  peter
+    * fixed ttypesym bug finally
+    * fileinfo in the symtable and better using for unused vars
+
+  Revision 1.34  1998/07/07 11:20:05  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.33  1998/06/15 15:38:08  pierre
+    * small bug in systems.pas corrected
+    + operators in different units better hanlded
+
+  Revision 1.32  1998/06/13 00:10:13  peter
+    * working browser and newppu
+    * some small fixes against crashes which occured in bp7 (but not in
+      fpc?!)
+
+  Revision 1.31  1998/06/10 17:04:05  michael
+  + Fix for reading untyped const parameters
+
+  Revision 1.30  1998/06/09 16:01:50  pierre
+    + added procedure directive parsing for procvars
+      (accepted are popstack cdecl and pascal)
+    + added C vars with the following syntax
+      var C calias 'true_c_name';(can be followed by external)
+      reason is that you must add the Cprefix
+
+      which is target dependent
+
+  Revision 1.29  1998/06/08 22:59:51  peter
+    * smartlinking works for win32
+    * some defines to exclude some compiler parts
+
+  Revision 1.28  1998/06/08 13:13:45  pierre
+    + temporary variables now in temp_gen.pas unit
+      because it is processor independent
+    * mppc68k.bat modified to undefine i386 and support_mmx
+      (which are defaults for i386)
+
+  Revision 1.27  1998/06/05 17:47:30  peter
+    * some better uses clauses
+
+  Revision 1.26  1998/06/05 14:37:36  pierre
+    * fixes for inline for operators
+    * inline procedure more correctly restricted
+
+  Revision 1.25  1998/06/04 23:51:54  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.24  1998/06/04 09:55:44  pierre
+    * demangled name of procsym reworked to become independant of the mangling scheme
+
+  Revision 1.23  1998/05/28 17:26:51  peter
+    * fixed -R switch, it didn't work after my previous akt/init patch
+    * fixed bugs 110,130,136
+
+  Revision 1.22  1998/05/28 14:40:27  peter
+    * fixes for newppu, remake3 works now with it
+
+  Revision 1.21  1998/05/23 01:21:25  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.20  1998/05/21 19:33:34  peter
+    + better procedure directive handling and only one table
+
+  Revision 1.19  1998/05/20 09:42:36  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.18  1998/05/11 13:07:56  peter
+    + $ifdef NEWPPU for the new ppuformat
+    + $define GDB not longer required
+    * removed all warnings and stripped some log comments
+    * no findfirst/findnext anymore to remove smartlink *.o files
+
+  Revision 1.17  1998/05/06 18:36:54  peter
+    * tai_section extended with code,data,bss sections and enumerated type
+    * ident 'compiled by FPC' moved to pmodules
+    * small fix for smartlink
+
+  Revision 1.16  1998/05/06 08:38:47  pierre
+    * better position info with UseTokenInfo
+      UseTokenInfo greatly simplified
+    + added check for changed tree after first time firstpass
+      (if we could remove all the cases were it happen
+      we could skip all firstpass if firstpasscount > 1)
+      Only with ExtDebug
+
+  Revision 1.15  1998/05/04 17:54:28  peter
+    + smartlinking works (only case jumptable left todo)
+    * redesign of systems.pas to support assemblers and linkers
+    + Unitname is now also in the PPU-file, increased version to 14
+
+  Revision 1.14  1998/05/01 09:01:24  florian
+    + correct semantics of private and protected
+    * small fix in variable scope:
+       a id can be used in a parameter list of a method, even it is used in
+       an anchestor class as field id
+
+  Revision 1.13  1998/04/30 15:59:42  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + UseTokenInfo for better source position
+    * fixed one remaining bug in scanner for line counts
+    * several little fixes
+
+  Revision 1.12  1998/04/29 10:34:00  pierre
+    + added some code for ansistring (not complete nor working yet)
+    * corrected operator overloading
+    * corrected nasm output
+    + started inline procedures
+    + added starstarn : use ** for exponentiation (^ gave problems)
+    + started UseTokenInfo cond to get accurate positions
+
+  Revision 1.11  1998/04/27 23:10:28  peter
+    + new scanner
+    * $makelib -> if smartlink
+    * small filename fixes pmodule.setfilename
+    * moved import from files.pas -> import.pas
+
+  Revision 1.10  1998/04/21 10:16:48  peter
+    * patches from strasbourg
+    * objects is not used anymore in the fpc compiled version
+
+  Revision 1.9  1998/04/13 22:20:36  florian
+    + stricter checking for duplicate id, solves also bug0097
+
+  Revision 1.8  1998/04/13 21:15:42  florian
+    * error handling of pass_1 and cgi386 fixed
+    * the following bugs fixed: 0117, 0118, 0119 and 0129, 0122 was already
+      fixed, verified
+
+  Revision 1.7  1998/04/13 08:42:52  florian
+    * call by reference and call by value open arrays fixed
+
+  Revision 1.6  1998/04/10 15:39:48  florian
+    * more fixes to get classes.pas compiled
+
+  Revision 1.5  1998/04/10 14:41:43  peter
+    * removed some Hints
+    * small speed optimization for AsmLn
+
+  Revision 1.4  1998/04/08 16:58:05  pierre
+    * several bugfixes
+      ADD ADC and AND are also sign extended
+      nasm output OK (program still crashes at end
+      and creates wrong assembler files !!)
+      procsym types sym in tdef removed !!
+}