TP3/Resources/DESASS/ICOMMENT.PAS

(* programme comment‚ et expliqu‚ dans le livre *)
(* LE DESASSEMBLEUR 8086 COLIBRI, publi‚ par    *)
(*           L'INSTITUT PASCAL:                 *)
(*      26 Rue Lamartine, 75009 PARIS           *)
(*           Tel: (1) 42.85.10.82               *)


  procedure ouvre_fichier_commentaires;
    begin
      b_fichier_commentaires_ouvert:= true;
      (*$i-*)
      assign(fichier_commentaires, nom_fichier_commentaires);
      reset(fichier_commentaires);
      (*$i+*)
      if ioresult<> 0
        then begin
            write('pas de fichier ', nom_fichier_commentaires, ' Cr‚er, Quitter ? ');
            choix1:= f_lis_commande(['C', 'Q']);
            if choix1= 'C'
              then begin
                  assign(fichier_commentaires, nom_fichier_commentaires);
                  rewrite(fichier_commentaires);
                end
              else b_fichier_commentaires_ouvert:= false;
          end
        else writeln('a ouvert le fichier ', nom_fichier_commentaires);
    end; 

  procedure charge_fichier_commentaires;
    var l_adresse_debut, l_adresse_fin: integer;

    procedure charge_les_commentaires;
      var l_numero_fiche: integer;

      procedure ajoute(var p: t_pt_commentaire);
        begin
          if p= nil
            then begin
                new(p);
                p^.adresse:= fiche_commentaire.adresse;
                p^.position_commentaire:= fiche_commentaire.position_commentaire;
                p^.numero_fiche:= l_numero_fiche;

                p^.pt_inferieurs:= nil; p^.pt_superieurs:= nil;
              end
            else
              if fiche_commentaire.adresse- $8000< p^.adresse- $8000
                then ajoute(p^.pt_inferieurs)
                else ajoute(p^.pt_superieurs);
        end; 

      begin 
        racine_commentaire:= nil;

        reset(fichier_commentaires);
        l_numero_fiche:= 0;

        while not eof(fichier_commentaires) do
        begin
          read(fichier_commentaires, fiche_commentaire);

          with fiche_commentaire do
            if (adresse- $8000>= l_adresse_debut- $8000)
                and (adresse- $8000<= l_adresse_fin- $8000)
              then ajoute(racine_commentaire);

          l_numero_fiche:= l_numero_fiche+ 1;
        end;

      end; 

    begin 
      if not b_fichier_commentaires_ouvert
        then exit;

      l_adresse_debut:= $0; l_adresse_fin:= $FFFF;
      repeat
        writeln;
        write('de $', f_entier_hexadecimal(l_adresse_debut));
        writeln(' … $', f_entier_hexadecimal(l_adresse_fin));
        write('Minimum, mAximum, charge commenTaires, Quitte ? ');
        choix1:= f_lis_commande(['T', 'M', 'A', 'Q', ' ', k_return]);

        case choix1 of
         'A' : begin
                 writeln; write('adresse maximum: <$1234> ? $');
                 lis_entier_hexadecimal(29, wherey, l_adresse_fin);
               end;
         'T' : charge_les_commentaires;
         'M' : begin
                 writeln; write('adresse minimum: <$5678> ? $');
                 lis_entier_hexadecimal(29, wherey, l_adresse_debut);
               end;
        end; 
      until choix1 in ['Q', 'T'];
      writeln;
    end; 

  procedure cherche_commentaire(p_adresse: integer;
                                  p_position_commentaire: char;
                                  var pv_pt_commentaire: t_pt_commentaire;
                                  var pv_commentaire: string127);
    var l_trouve: boolean;
    begin
      pv_commentaire:= '';

      l_trouve:= false;
      while not l_trouve and (pv_pt_commentaire<> nil) do
        if p_adresse< pv_pt_commentaire^.adresse
          then pv_pt_commentaire:= pv_pt_commentaire^.pt_inferieurs
          else
            if p_adresse> pv_pt_commentaire^.adresse
              then pv_pt_commentaire:= pv_pt_commentaire^.pt_superieurs
              else
                if p_position_commentaire<> pv_pt_commentaire^.position_commentaire
                  then pv_pt_commentaire:= pv_pt_commentaire^.pt_superieurs
                  else begin
                      seek(fichier_commentaires, pv_pt_commentaire^.numero_fiche);
                      read(fichier_commentaires, fiche_commentaire);
                      pv_commentaire:= fiche_commentaire.commentaire;

                      l_trouve:= true;

                      pv_pt_commentaire:= pv_pt_commentaire^.pt_superieurs;
                    end; 
    end; 

  procedure liste_arbre_commentaires(p_pointeur: t_pt_commentaire);
    begin
      if p_pointeur<> nil
        then begin
            liste_arbre_commentaires(p_pointeur^.pt_inferieurs);

            with p_pointeur^ do
            begin
              write(sortie, numero_fiche: 4, ' $', f_entier_hexadecimal(adresse),
                    position_commentaire:2, ' ');
              seek(fichier_commentaires, numero_fiche);
              read(fichier_commentaires, fiche_commentaire);
              writeln(sortie, fiche_commentaire.commentaire);
            end;

            liste_arbre_commentaires(p_pointeur^.pt_superieurs);
          end
    end;