TP3/Resources/DESASS/IZONES.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_zones;
    begin
      b_fichier_zones_ouvert:= true;
      (*$i-*)
      assign(fichier_zones, nom_fichier_zones);
      reset(fichier_zones);
      (*$i+*)
      if ioresult<> 0
        then begin
            write('pas de fichier ', nom_fichier_zones, ' Cr‚er, Quitter ? ');
            choix1:= f_lis_commande(['C', 'Q']);
            if choix1= 'C'
              then begin
                  assign(fichier_zones, nom_fichier_zones);
                  rewrite(fichier_zones);
                end
              else b_fichier_zones_ouvert:= false;
          end
        else writeln('a ouvert le fichier ', nom_fichier_zones);
    end; 

  procedure ajoute_fiche_zone(p_debut: integer; p_type_zone: char);
    begin
      if not b_fichier_zones_ouvert
        then exit;

      fiche_zone.debut:= p_debut;
      fiche_zone.type_zone:= p_type_zone;

      seek(fichier_zones, filesize(fichier_zones));
      write(fichier_zones, fiche_zone);
    end; 

  procedure charge_fichier_zones;
    var l_adresse_debut, l_adresse_fin: integer;
        l_choix: char;

    procedure charge_les_zones;

      procedure ajoute(var p: t_pt_zone);
        begin
          if p= nil
            then begin
                write('.');
                new(p);
                p^.debut:= fiche_zone.debut;
                p^.type_zone:= fiche_zone.type_zone;
                p^.pt_inferieurs:= nil; p^.pt_superieurs:= nil;
              end
            else
              if fiche_zone.debut- $8000< p^.debut- $8000
                then ajoute(p^.pt_inferieurs)
                else
                  if fiche_zone.debut- $8000> p^.debut- $8000
                    then ajoute(p^.pt_superieurs);
        end; 

      begin 
        racine_zone:= nil; seek(fichier_zones, 0);

        while not eof(fichier_zones) do
        begin
          read(fichier_zones, fiche_zone);

          with fiche_zone do
          begin
            if (debut- $8000>= l_adresse_debut- $8000) and (debut- $8000<= l_adresse_fin- $8000)
              then begin
                  if fiche_zone.type_zone in ['a', 'h', 'c']
                    then ajoute(racine_zone);
                end
          end;
        end;
      end; 

    begin 
      if not b_fichier_zones_ouvert
        then exit;

      l_adresse_debut:= $0100; 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 Zones, Quitte ? ');
        l_choix:= f_lis_commande(['C', 'Z', 'M', 'A', 'Q', ' ', k_return]);

        case l_choix of
         'A' : begin
                 writeln; write('adresse maximum: <$1234> ? $');
                 lis_entier_hexadecimal(29, wherey, l_adresse_fin);
               end;
         'C', 'Z' : charge_les_zones;
         'M' : begin
                 writeln; write('adresse minimum: <$4567> ? $');
                 lis_entier_hexadecimal(29, wherey, l_adresse_debut);
               end;
        end; 
      until l_choix in ['Q', 'C', 'Z'];
      writeln;
    end; 

  procedure liste_arbre_zones;
    var l_premiere_adresse: boolean;
        l_debut_precedent: integer;
        l_type_zone_precedent: char;

      procedure liste_les_zones(p_pt_zone: t_pt_zone);
        begin
          if p_pt_zone<> nil
            then begin
                liste_les_zones(p_pt_zone^.pt_inferieurs);

                with p_pt_zone^ do
                begin
                  if (debut- $8000>= adresse_debut- $8000)
                       and (debut- 1- $8000<= adresse_fin- $8000)
                    then begin
                        if l_premiere_adresse
                          then l_premiere_adresse:= false
                          else writeln(sortie, '$',
                                        f_entier_hexadecimal(l_debut_precedent),
                                        '-$',
                                        f_entier_hexadecimal(debut- 1),
                                          l_type_zone_precedent: 2);

                        l_debut_precedent:= debut;
                        l_type_zone_precedent:= type_zone;
                      end; 
                end; 

                liste_les_zones(p_pt_zone^.pt_superieurs);
              end;
        end; 

    begin
      entre_debut_fin('');

      writeln(sortie);
      l_premiere_adresse:= true;
      liste_les_zones(racine_zone);

      if l_debut_precedent- 1- $8000<= adresse_fin- $8000
        then writeln(sortie, '$',
                           f_entier_hexadecimal(l_debut_precedent),
                           '-$',
                           f_entier_hexadecimal(adresse_fin),
                           l_type_zone_precedent: 2);

      writeln(sortie);
    end;