TP3/Resources/DESASS/IOBJET.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 charge_objet;
    var l_choix: char;

    procedure charge_les_blocs;
      var l_fichier_objet: file;
          l_bloc_debut, l_bloc_fin, l_nombre_blocs: integer;
      begin
        assign(l_fichier_objet, nom_fichier_objet);
        (*$i-*)
        reset(l_fichier_objet, $0100);
        (*$i+*)
        if ioresult<> 0
          then begin
              writeln('pas de fichier ', nom_fichier_objet, '. exit');
              close(l_fichier_objet);
              exit;
            end;

        l_nombre_blocs:= filesize(l_fichier_objet);
        if l_nombre_blocs> $80
          then begin
              if (adresse_debut- $0100<>0) or (adresse_fin- $0100<> 0)
                then begin
                    l_bloc_debut:= (adresse_debut- $0100) shr 8;
                    l_bloc_fin:= (adresse_fin- $0100) shr 8;
                    if adresse_fin and $00FF<> 0
                      then l_bloc_fin:= l_bloc_fin+ 1;

                    l_nombre_blocs:= l_bloc_fin- l_bloc_debut;
                    if l_nombre_blocs> $80
                      then begin
                          writeln('ne peut pas charger tout l''objet');
                          writeln('utilisez une plus petite plage d‚but/fin');
                          close(l_fichier_objet);
                          exit;
                        end
                      else
                        if l_bloc_debut<> 0
                          then seek(l_fichier_objet, l_bloc_debut);
                  end 
                else begin
                    writeln('ne peut pas charger tout l''objet');
                    writeln('pr‚cisez l''adresse de d‚but et de fin');
                    close(l_fichier_objet);
                    exit;
                  end;
            end; 

        fillchar(tampon, sizeof(tampon), 0);

        blockread(l_fichier_objet, tampon, l_nombre_blocs);
        close(l_fichier_objet);

        adresse_debut_tampon:= adresse_debut and $FF00;
        adresse_fin_tampon:= adresse_debut_tampon+ l_nombre_blocs shl 8- 1;
        while tampon[adresse_fin_tampon- adresse_debut_tampon]= 0 do
          adresse_fin_tampon:= adresse_fin_tampon- 1;

        if adresse_fin- $8000> adresse_fin_tampon- $8000
          then adresse_fin:= adresse_fin_tampon;

        a_charge_objet:= true;
      end; 

    begin 
      repeat
        writeln;
        write('de $', f_entier_hexadecimal(adresse_debut));
        writeln(' … $', f_entier_hexadecimal(adresse_fin));
        write('Minimum, mAximum, Charge, Quitte ? ');
        l_choix:= f_lis_commande(['C', 'M', 'A', 'Q', ' ', k_return]);

        case l_choix of
         'A' : begin
                 writeln; write('maximum: ? $');
                 lis_entier_hexadecimal(13, wherey, adresse_fin);
               end;
         'C' : charge_les_blocs;
         'M' : begin
                 writeln; write('minimum: ? $');
                 lis_entier_hexadecimal(13, wherey, adresse_debut);
               end;
        end; 
      until l_choix in ['Q', 'C'];
    end; 

  procedure lis_octet_suivant(var pv_octet: byte);
    begin
      pv_octet:= tampon[adresse- adresse_debut_tampon];
      adresse:= adresse+ 1;

      if b_avec_octets_hexadecimaux
        then write(sortie, f_octet_hexadecimal(pv_octet));
    end; 

  procedure lis_entier_suivant(var pv_entier: integer);
    var l_octet1, l_octet2: byte;
    begin
      lis_octet_suivant(l_octet1);
      lis_octet_suivant(l_octet2);

      pv_entier:= l_octet2 shl 8+ l_octet1;
    end; 

  procedure liste_objet;
    var l_indice, l_fin: integer;
    begin
      write('d‚but ? '); lis_entier(l_indice);
      write('fin   ? '); lis_entier(l_fin);

      for l_indice:= l_indice to l_fin do
      begin
        write(sortie, f_octet_hexadecimal(tampon[l_indice]));
        if l_indice and $000F= 0
          then writeln(sortie);
      end;
    end;