(* 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               *)


(*$r+*)
program affiche;
  type string2= string[2];
       string4= string[4];
       string64= string[64];
  var choix: char;

      nom_fichier_objet: string64;
      adresse_debut, adresse_fin: integer;
      a_charge_objet: boolean;

      tampon: array[$0..$7FFF] of byte;

      sortie: text;
      nom_sortie: string64;

  function f_octet_hexadecimal(p_octet: byte): string2;
    const kt_hexa: array[0..15] of char= '0123456789ABCDEF';
    begin
      f_octet_hexadecimal:= concat(kt_hexa[p_octet div 16],
                                      kt_hexa[p_octet mod 16]);
    end; 

  function f_entier_hexadecimal(p_entier: integer): string4;
    begin
      f_entier_hexadecimal:= concat(f_octet_hexadecimal(hi(p_entier)),
                                    f_octet_hexadecimal(lo(p_entier)));
    end; 

  procedure choisis_sortie;
    begin
      write('nom sortie <a:essai.txt> ? '); readln(nom_sortie);

      writeln(sortie); close(sortie);

      assign(sortie, nom_sortie); rewrite(sortie);
      writeln(sortie);
    end; 

  procedure charge_objet;
    var l_fichier_objet: file;
        l_bloc_debut, l_bloc_fin, l_nombre_blocs: integer;
        l_fin: 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);

      l_fin:= adresse_debut and $FF00+ l_nombre_blocs* $0100- 1;
      if l_fin- $8000> adresse_fin
        then adresse_fin:= l_fin;

      while tampon[adresse_fin- adresse_debut]= 0 do
        adresse_fin:= adresse_fin- 1;

      a_charge_objet:= true;
    end; 

  procedure affiche_tampon;
    var l_colonne: integer;
        l_indice_debut, l_indice_tampon, l_alignement: integer;
        l_quantite: integer;
        l_octet: byte;
    begin 
      if not a_charge_objet
        then charge_objet;

      l_indice_debut:= adresse_debut and $FF00;
      l_alignement:= adresse_debut and $0007;
      l_indice_tampon:= adresse_debut and $00F8;
      l_quantite:= adresse_fin- (adresse_debut and $FF00)+ 1;

      while l_quantite> 0 do
      begin
        write(sortie, '$', f_entier_hexadecimal(l_indice_tampon+ l_indice_debut), ' ');

        if l_alignement> 0
          then begin
              write(sortie, '': 4*l_alignement);
              l_colonne:= l_alignement;
            end
          else l_colonne:= 0;
        while (l_colonne<= 7) and (l_quantite- l_colonne> 0) do
        begin
          l_octet:= tampon[l_indice_tampon+ l_colonne];
          write(sortie, '$', f_octet_hexadecimal(l_octet), ' ');
          l_colonne:= l_colonne+ 1;
        end;

        write(sortie, '': 4* (8- l_colonne), ':');

        if l_alignement> 0
          then begin
              write(sortie, '': l_alignement);
              l_colonne:= l_alignement;
              l_alignement:= 0;
            end
          else l_colonne:= 0;
        while (l_colonne<= 7) and (l_quantite- l_colonne> 0) do
        begin
          l_octet:= tampon[l_indice_tampon+ l_colonne];
          if l_octet in [32..127]
            then write(sortie, chr(l_octet))
            else write(sortie, '.');
          l_colonne:= l_colonne+ 1;
        end;
        writeln(sortie);

        l_quantite:= l_quantite- 8;
        l_indice_tampon:= l_indice_tampon+ 8;
      end; 
    end; 

  procedure initialise;
    begin
      nom_sortie:= 'con:';
      assign(sortie, nom_sortie);
      reset(sortie);

      nom_fichier_objet:= 'mystere.com';
      a_charge_objet:= false;

      adresse_debut:= $0100;
      adresse_fin:= $80FF;
    end; 

  begin 
    initialise;
    repeat
      writeln;
      write(nom_fichier_objet, ' $', f_entier_hexadecimal(adresse_debut));
      write('-$', f_entier_hexadecimal(adresse_fin));
      writeln(' -> ', nom_sortie);

      write('Nom, D‚but, Fin, Charge, Affiche, Sortie, Quitte ? ');
      read(kbd, choix); writeln(choix);
      choix:= upcase(choix);

      case choix of
       'A' : affiche_tampon;
       'C' : charge_objet;
       'D' : begin
               write('adresse d‚but <$1234> ? '); readln(adresse_debut);
             end;
       'F' : begin
               write('adresse fin   <$2345> ? '); readln(adresse_fin);
             end;
       'N' : begin
               write('nom fichier <a:essai.com> ? ');
               readln(nom_fichier_objet);
             end;
       'S' : choisis_sortie;
      end; 
    until choix= 'Q';
    close(sortie);
  end.