(* 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+*)
(*$b-*)
program desassemble;
  const k_return= #13;
  type string2= string[2];
       string4= string[4];
       string15= string[15];
       string21= string[41];
       string64= string[64];
       string80= string[80];
       string127= string[127];
       t_set_of_char= set of char;

       t_fiche_zones= record
                        debut: integer;
                        type_zone: char;
                      end;

       t_pt_zone= ^t_cellule_zone;
       t_cellule_zone= record
                         debut: integer;
                         type_zone: char;
                         pt_superieurs, pt_inferieurs: t_pt_zone;
                       end;

       t_type_label= (call_valide_instruction, call_valide,
                      call_instruction, call,
                      relatif_instruction, relatif,

                      utilisateur_code,
                      utilisateur_donnee,

                      deja, efface);

       t_fiche_label= record
                        adresse: integer;
                        type_label: t_type_label;
                        nom: string15;
                      end;

       t_pointeur_reference= ^t_cellule_reference;
       t_cellule_reference= record
                              adresse: integer;
                              suivante: t_pointeur_reference;
                            end;

       t_pointeur_nom= ^string15;
       t_pointeur_label= ^t_cellule_label;
       t_cellule_label= record
                          adresse: integer;
                          type_label: t_type_label;
                          nom: t_pointeur_nom;

                          numero_fiche: integer;
                          pt_labels_inferieurs, pt_labels_superieurs: t_pointeur_label;

                          pt_reference, pt_derniere_reference: t_pointeur_reference;
                        end;

       t_fiche_commentaire= record
                              adresse: integer;
                              position_commentaire: char;
                              commentaire: string127;
                            end;
       t_pt_commentaire= ^t_cellule_commentaire;
       t_cellule_commentaire= record
                                adresse: integer;
                                position_commentaire: char;
                                numero_fiche: integer;

                                pt_superieurs, pt_inferieurs: t_pt_commentaire;
                              end;

       t_octet_mot= (octet, mot);
  var choix, choix1: char;

      nom_fichier_objet: string64;
      a_charge_objet: boolean;

      adresse_debut, adresse_fin: integer;

      tampon: array[$0..$7FFF] of byte;
      adresse_debut_tampon, adresse_fin_tampon: integer;
      adresse: integer;
      numero_ligne: integer;

      fichier_zones: file of t_fiche_zones;
      nom_fichier_zones: string64;
      fiche_zone: t_fiche_zones;
      b_fichier_zones_ouvert: boolean;
      racine_zone: t_pt_zone;

      fichier_labels: file of t_fiche_label;
      nom_fichier_labels: string64;
      fiche_label: t_fiche_label;
      b_fichier_labels_ouvert: boolean;
      racine_label, racine_donnees, racine_immediat: t_pointeur_label;

      fichier_commentaires: file of t_fiche_commentaire;
      nom_fichier_commentaires: string64;
      fiche_commentaire: t_fiche_commentaire;
      b_fichier_commentaires_ouvert: boolean;
      racine_commentaire: t_pt_commentaire;

      adresse_debut_ligne: integer;
      nom_debut_ligne: string15;

      b_reference_label: boolean;
      b_reference_donnees: boolean;
      b_reference_immediat: boolean;

      b_stop_ecran: boolean;

      b_avec_octets_hexadecimaux: boolean;

      sortie: text;
      nom_sortie: string64;

  (*$i iutilita.pas *)

  (*$i iobjet.pas *)
  (*$i izones.pas *)
  (*$i ilabels.pas *)
  (*$i icomment.pas *)

  (*$i igenere.pas  *)

  (*$i icode1.pas  *)
  (*$i icode2.pas  *)
  (*$i icode3.pas  *)

  (*$i iasciihe.pas  *)

  procedure entre_options;
    begin
      writeln;
      writeln('liste de r‚f‚rences: Code, Donn‚es, Imm‚diats');
      writeln('Stoppe affichage toutes les 25 lignes');
      writeln('avec octets Hex, ');
      write  ('Quitte ? ');

      choix1:= f_lis_commande(['B', 'C', 'D', 'H', 'I', 'Q', 'S', 'Z']);

      case choix1 of
       'C' : lis_booleen('liste de r‚f‚rence des labels', b_reference_label);
       'D' : lis_booleen('liste de r‚f‚rence des donn‚es', b_reference_donnees);
       'H' : lis_booleen('avec affichage des octets ', b_avec_octets_hexadecimaux);
       'I' : lis_booleen('liste de r‚f‚rence des imm‚diats', b_reference_immediat);
       'S' : lis_booleen('stop ‚cran', b_stop_ecran);
      end; 
    end; 

  procedure entre_noms_fichiers;
    begin
      writeln;
      write('nom: Code objet, Labels, Zones, ommenTaires ? ');
      choix1:= f_lis_commande(['C', 'L', 'T', 'Q', 'Z']);

      case choix1 of
       'T' : begin
               write('nom fichier commentaires <commenta.dta> ? ');
               readln(nom_fichier_commentaires);
               close(fichier_commentaires);
               ouvre_fichier_commentaires;
             end;
       'L' : begin
               write('nom fichier labels <labels.dta> ? ');
               readln(nom_fichier_labels);
               close(fichier_labels);
               ouvre_fichier_labels;
             end;
       'C' : begin
               write('nom fichier objet <obj.com> ? ');
               readln(nom_fichier_objet);
             end;
       'Z' : begin
              write('nom fichier zones <zones.dta> ? ');
               readln(nom_fichier_zones);
               close(fichier_zones);
               ouvre_fichier_zones;
             end;
      end; 
    end; 

  procedure desassemblage_une_zone;
    var l_commande, l_commande_precedente: char;

    procedure ajoute_zone(p_type_zone: char);
      begin
        p_type_zone:= chr(ord(p_type_zone)+ 32);

        ajoute_fiche_zone(adresse_debut, p_type_zone);

        if filesize(fichier_zones)= 1
          then ajoute_fiche_zone(adresse_fin, p_type_zone);

        if adresse_fin+ 1<= adresse_fin_tampon
          then begin
              adresse_debut:= adresse_fin+ 1;
              adresse_fin:= adresse_fin+ 1;
            end;
      end; 

    begin 
      numero_ligne:= 0;
      if adresse_debut<> 0
        then begin
            writeln;
            writeln('entrer les adresses r‚elles <$876B> ');
            writeln;
          end;

      l_commande_precedente:= ' ';
      repeat
        entre_debut_fin('Code, Ascii, Hex, ajoute Zones, Quitte ');

        l_commande:= f_lis_commande(['C', 'A', 'H', 'Z', ' ', k_return, 'Q']);
        case l_commande of
         'A' : desassemble_ascii(adresse_debut, adresse_fin);
         'C' : desassemble_code(adresse_debut, adresse_fin);
         'Z' : if l_commande_precedente in ['C', 'A', 'H']
                 then ajoute_zone(l_commande_precedente);
         'H' : desassemble_hex(adresse_debut, adresse_fin);
        end; 

        if l_commande in ['A', 'C', 'H']
          then begin
              l_commande_precedente:= l_commande;
              write('Ajouter cette plage au fichier zones ? ');
              read(kbd, choix1); writeln(choix1);
              if upcase(choix1)= 'A'
                then ajoute_zone(l_commande);
            end;

        l_commande_precedente:= l_commande;
      until l_commande= 'Q';
    end; 

  procedure desassemblage_automatique;
    var l_stop_ecran: boolean;

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

      procedure desassemble_la_zone(p_adresse_debut, p_adresse_fin: integer;
                           p_type_zone: char);
        begin
          case p_type_zone of
           'a' : desassemble_ascii(p_adresse_debut, p_adresse_fin);
           'c' : desassemble_code(p_adresse_debut, p_adresse_fin);
           'h' : desassemble_hex(p_adresse_debut, p_adresse_fin);
          end; 
        end; 

      procedure cherche_et_desassemble(p_pt_zone: t_pt_zone);
        begin
          if p_pt_zone<> nil
            then begin
                cherche_et_desassemble(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 desassemble_la_zone(l_debut_precedent, debut- 1,
                                          l_type_zone_precedent);

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

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

      begin 
        l_premiere_adresse:= true;
        cherche_et_desassemble(racine_zone);

        if l_debut_precedent- 1- $8000<= adresse_fin- $8000
          then desassemble_la_zone(l_debut_precedent, adresse_fin,
                                     l_type_zone_precedent);
      end; 

    begin 
      if not b_fichier_zones_ouvert and (racine_zone= nil)
        then begin
            writeln('le fichier ', nom_fichier_zones, ' n''est pas ouvert ',
                     'ou pas charg‚');
            exit;
          end;

      numero_ligne:= 0;

      l_stop_ecran:= b_stop_ecran;
      b_stop_ecran:= false;

      entre_debut_fin('');

      desassemble_les_zones;

      b_stop_ecran:= l_stop_ecran;
    end; 

  procedure desassemble_manuel;
    var l_adresse_debut, l_adresse_fin: integer;
        l_instruction: string80;
        l_chaine2: string2;
        l_indice: integer;
    begin
      writeln('entez une suite hexad‚cimale <CD11C3>');
      write('? '); readln(l_instruction);

      if odd(length(l_instruction))
        then l_instruction:= concat(l_instruction, '0');

      l_chaine2:= '  ';
      for l_indice:= 0 to length(l_instruction) div 2- 1 do
      begin
        l_chaine2[1]:= l_instruction[1+ l_indice* 2];
        l_chaine2[2]:= l_instruction[1+ l_indice* 2+ 1];

        tampon[l_indice]:= f_hexadecimal_octet(l_chaine2);
      end;

      adresse_debut_tampon:= 0;
      l_adresse_debut:= 0;
      l_adresse_fin:= length(l_instruction) div 2;

      desassemble_code(l_adresse_debut, l_adresse_fin);
    end; 

  procedure listes_diverses;
    begin
      writeln;
      write('liste Code objet, laBels, Zones, commenTaires, Quitte ? ');

      choix1:= f_lis_commande(['B', 'C', 'T', 'Z', 'Q']); writeln;

      case choix1 of
        'B' : liste_labels;
        'C' : liste_objet;
        'T' : liste_arbre_commentaires(racine_commentaire);
        'Z' : liste_arbre_zones;
      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;

      adresse_debut_tampon:= $0100;
      adresse_fin_tampon:= $80FF;
      numero_ligne:= 0;

      nom_fichier_zones:= 'zones.dta';
      ouvre_fichier_zones;
      racine_zone:= nil;

      nom_fichier_commentaires:= 'commenta.dta';
      ouvre_fichier_commentaires;
      racine_commentaire:= nil;

      nom_fichier_labels:= 'labels.dta';
      ouvre_fichier_labels;

      racine_label:= nil;
      racine_donnees:= nil;
      racine_immediat:= nil;

      b_reference_donnees:= false;
      b_reference_immediat:= false;
      b_reference_label:= true;

      b_stop_ecran:= false;
      b_avec_octets_hexadecimaux:= true;
    end; 

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

      if b_fichier_labels_ouvert
        then write(nom_fichier_labels, ' [0 … ', filesize(fichier_labels)- 1, '], ');
      if b_fichier_zones_ouvert
        then write(nom_fichier_zones, ' [0 … ', filesize(fichier_zones)- 1, '] ');
      writeln;

      affiche_booleen('r‚f labels', b_reference_label); write(', ');
      affiche_booleen('r‚f donn‚es', b_reference_donnees); write(', ');
      affiche_booleen('r‚f op imm‚', b_reference_immediat); write(', ');
      affiche_booleen('octets hex', b_avec_octets_hexadecimaux);
      writeln; writeln;

      writeln('Charge objet, laBels, Zones, commenTaires, Noms, Options');
      writeln('D‚sassemble, Automatique, Manuel');
      write  ('Sortie, Listes, Quitte ? ');

      choix:= f_lis_commande(['A', 'B', 'C', 'D', 'L', 'M', 'N', 'O', 'Q', 'S', 'T', 'Z',
                              ' ', k_return]);

      case choix of
       'A' : if a_charge_objet
               then desassemblage_automatique
               else affiche_erreur('objet pas charg‚');
       'B' : charge_fichier_labels;
       'C' : charge_objet;
       'D' : if a_charge_objet
               then desassemblage_une_zone
               else affiche_erreur('objet pas charg‚');
       'L' : listes_diverses;
       'N' : entre_noms_fichiers;
       'M' : desassemble_manuel;
       'O' : entre_options;
       'S' : choisis_sortie;
       'T' : charge_fichier_commentaires;
       'Z' : charge_fichier_zones;
      end; 

    until choix= 'Q';

    close(fichier_zones);
    close(fichier_labels);
    close(sortie);
  end.