{****************************************************************************

                       Copyright (c) 1996 by Florian Klämpfl

 ****************************************************************************}

unit hcodegen;

  interface

     uses
        cobjects,systems,globals,tree,asmgen,symtable,tempad,types,strings,
        i386;

    type
       tprocinfo = record
          { aktuelle Klasse }
          _class : pclassdef;
          { Returntyp }
          retdef : pdef;
          { true, falls Eceptions behandelt werden sollen }
          exceptions : boolean;
          { true, falls das Unterprogramm exportiert werden soll (OS/2) }
          exported : boolean;
          { Framepointeroffset }
          framepointer : longint;
          { Self-Pointer rel. zu EBP }
          ESI_offset : longint;
          { Resultatwertoffset }
          retoffset : longint;
          { Parameteroffset }
          call_offset : longint;
          { Adresse für die einzutragende VMT }
          { (Verwendung nur in Kon- und Destrktoren) }
          vmt_table : longint;

          { it's true, if the procedure uses asm }
          uses_asm : boolean;

          { true, if the procedure is exported by an unit }
          globalsymbol : boolean;
       end;

    var
       { Info über das momentan geparste Unterprogramm }
       procinfo : tprocinfo;

       { Die Nummer der Label die bei BREAK bzw CONTINUE }
       { angesprungen werden sollen }
       aktbreaklabel,aktcontinuelabel : longint;

       { truelabel wird angesprungen, wenn ein Ausdruck true ist, falselabel }
       { entsprechend                                                        }
       truelabel,falselabel : longint;

       { Nr des Labels welches zum Verlassen eines Unterprogramm }
       { angesprungen wird                                       }
       aktexitlabel : longint;

       { Exitlabel, welches angesprungen werden muß, um nur den  }
       { Stack aufzuräumen                                       }
       aktexit2label : longint;

       { Nummer des Labels zu dem bei einer Exception zurück gekehrt }
       { werden soll                                                 }
       aktexceptlabel : longint;

       { Der Code der beim Eintritt in ein Unterprogramm abgearbeitet }
       { wird                                                         }
       aktentrycode : tasmlist;

       { Der Code der beim Austritt aus einem Unterprogramm }
       { abgearbeitet wird                                  }
       aktexitcode : tasmlist;

       { Der Code der beim Austritt aus einem Unterprogramm }
       { mit einer Exception abgearbeitet wird              }
       aktexceptcode : tasmlist;

       { Der Code der aktuellen Procedure }
       aktproccode : tasmlist;

       { die asmlist für das Datensegment ist in asmgen deklariert, }
       { da sie von symtable gebraucht wird                         }

       { Assemblerliste in der der Code fuer den aktuellen Ausdruck eingefuegt wird }
       exprasmlist : tasmlist;

       { Assemblerliste mit Debuggerinfos }
       debuginfos : tasmlist;

       { Boolean, wenn eine loadn kein Assembler erzeugt hat }
       simple_loadn : boolean;

       { enthält die geschätzte Durchlaufanzahl*100 für den }
       { momentan bearbeiteten Baum                         }
       t_times : longint;

       { true, if an error while code generation occurs }
       codegenerror : boolean;

    { some support routines for the case instruction }

    { counts the labels }
    function case_count_labels(wurzel : pcaserecord) : longint;

    { searches the highest label }
    function case_get_max(wurzel : pcaserecord) : longint;

    { searches the lowest label }
    function case_get_min(wurzel : pcaserecord) : longint;

  implementation

    function case_count_labels(wurzel : pcaserecord) : longint;

      var
         _l : longint;

      procedure count(p : pcaserecord);

        begin
           inc(_l);
           if assigned(p^.less) then
             count(p^.less);
           if assigned(p^.greater) then
             count(p^.greater);
        end;

      begin
         _l:=0;
         count(wurzel);
         case_count_labels:=_l;
      end;

    function case_get_max(wurzel : pcaserecord) : longint;

      var
         hp : pcaserecord;

      begin
         hp:=wurzel;
         while assigned(hp^.greater) do
           hp:=hp^.greater;
         case_get_max:=hp^.high;
      end;

    function case_get_min(wurzel : pcaserecord) : longint;

      var
         hp : pcaserecord;

      begin
         hp:=wurzel;
         while assigned(hp^.less) do
           hp:=hp^.less;
         case_get_min:=hp^.low;
      end;

end.