(* 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 gestion_labels_de_desassemblage;
  type string2= string[2];
       string4= string[4];
       string15= string[15];
       string21= string[41];
       string64= string[64];
       string80= string[80];
       string127= string[127];

       set_of_char= set of char;

       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_label= ^t_cellule_label;
       t_cellule_label= record
                          adresse: integer;

                          nom: string15;
                          type_label: t_type_label;

                          numero_fiche: integer;
                          pt_inferieurs, pt_superieurs: t_pointeur_label;
                        end;

       t_pointeur_alphabetique= ^t_cellule_alphabetique;
       t_cellule_alphabetique= record
                                 nom: string15;

                                 adresse: integer;
                                 type_label: t_type_label;

                                 numero_fiche: integer;
                                 pt_inferieurs, pt_superieurs: t_pointeur_alphabetique;
                               end;

  var choix, choix1: char;

      fichier_label: file of t_fiche_label;
      nom_fichier_label: string64;
      fiche_label: t_fiche_label;
      resultat_entree_sortie: byte;

      racine_labels_code, racine_labels_donnees: t_pointeur_label;
      racine_alphabetique: t_pointeur_alphabetique;
      sommet_tas: ^integer;

      sortie: text;
      nom_sortie: string64;

  procedure stop;
    var l_stop: char;
    begin
      read(kbd, l_stop);
    end; 

  procedure affiche_erreur(p_message: string80);
    begin
      writeln;
      write('erreur: ', p_message);
      readln;
    end; 

  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; 

  function f_lis_commande(p_ensemble_ok: set_of_char): char;
    var l_touche: char;
    begin
      repeat
        read(kbd, l_touche);
        l_touche:= upcase(l_touche); write(l_touche);
      until l_touche in p_ensemble_ok;
      f_lis_commande:= l_touche;
    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 change_nom_fichier;
    begin
      write('nom <a:zones.dta> ? '); readln(nom_fichier_label);
    end; 

  function f_fichier_existe(p_nom_fichier_label: string64): boolean;
    begin
      assign(fichier_label, p_nom_fichier_label);
      (*$i-*)
      reset(fichier_label);
      (*$i+*)
      f_fichier_existe:= ioresult= 0;
      close(fichier_label);
    end; 

  procedure cree_fichier;
    begin
      if f_fichier_existe(nom_fichier_label)
        then begin
            writeln;
            write('le fichier existe d‚j…. D‚truire, Quitter ? ');
            if f_lis_commande(['D', 'Q'])<> 'D'
              then exit;
            writeln;
          end;

      assign(fichier_label, nom_fichier_label);
      rewrite(fichier_label);
      close(fichier_label);
    end; 

  procedure ouvre_fichier;
    begin
      assign(fichier_label, nom_fichier_label);
      (*$i-*)
      reset(fichier_label);
      (*$i+*)
      resultat_entree_sortie:= ioresult;
      if resultat_entree_sortie<> 0
        then writeln('le fichier ', nom_fichier_label, ' n''a pas ‚t‚ ouvert');
    end; 

  procedure affiche_fiche(p_numero: integer; p_nom: string15; p_adresse: integer;
                          p_type_label: t_type_label);
    begin
      write(sortie, p_numero: 5);
      write(sortie, ' ', p_nom, '':16- length(p_nom));
      write(sortie, ' $', f_entier_hexadecimal(p_adresse), ' ');

      case p_type_label of
        call_valide_instruction : write(sortie, 'call valid‚ instruction');
        call_valide :             write(sortie, 'call valid‚');
        call_instruction :        write(sortie, 'call instruction');
        call :                    write(sortie, 'call');
        relatif_instruction :     write(sortie, 'relatif instruction');
        relatif :                 write(sortie, 'relatif');

        utilisateur_code :        write(sortie, 'utilisateur code');
        utilisateur_donnee :      write(sortie, 'utilisateur donn‚e');

        deja :                    write(sortie, 'd‚j…');
        efface :                  write(sortie, 'effac‚');
      end; 
    end; 

  procedure gere_par_numero_de_fiche;
    var l_choix: char;

    procedure liste_fichier;
      var l_numero_fiche: integer;
          l_dernier_numero: integer;
      begin
        ouvre_fichier;
        if resultat_entree_sortie<> 0
          then exit;

        repeat
          write('num‚ro d‚but <0> ? '); readln(l_numero_fiche);
        until (l_numero_fiche>= 0) and (l_numero_fiche< filesize(fichier_label));
        write('num‚ro fin  <', filesize(fichier_label)- 1, '> ? '); readln(l_dernier_numero);

        seek(fichier_label, l_numero_fiche);

        while not eof(fichier_label) and (l_numero_fiche<= l_dernier_numero) do
        begin
          read(fichier_label, fiche_label);

          with fiche_label do
            affiche_fiche(l_numero_fiche, nom, adresse, type_label);
          writeln(sortie);

          l_numero_fiche:= l_numero_fiche+ 1;
        end;

        close(fichier_label);
      end; 

    procedure ajoute_fichier;
      var l_type_label: char;
      begin
        ouvre_fichier;
        if resultat_entree_sortie<> 0
          then exit;

        seek(fichier_label, filesize(fichier_label));

        repeat
          writeln;
          writeln('ajoute la fiche: ', filepos(fichier_label));

          write('nom      <TRI>    ? '); readln(fiche_label.nom);
          write('adresse  <$1234>  ? '); readln(fiche_label.adresse);

          write('type Code, Donn‚e ? ');
          l_type_label:= f_lis_commande(['C', 'D']); writeln;
          if l_type_label= 'D'
            then fiche_label.type_label:= utilisateur_donnee
            else fiche_label.type_label:= utilisateur_code;

          write(fichier_label, fiche_label);

          write('Continuer, Quitter ? ');
          read(kbd, choix1); writeln(choix1);
        until upcase(choix1)= 'Q';

        close(fichier_label);
      end; 

    procedure modifie_fichier;
      var l_numero_fiche: integer;
          l_type_label: char;
      begin
        ouvre_fichier;
        if resultat_entree_sortie<> 0
          then exit;

        repeat
          writeln;
          repeat
            write('modifie la fiche num‚ro <0..', filesize(fichier_label)- 1, '> ? ');
            readln(l_numero_fiche);
          until (l_numero_fiche>= 0) and (l_numero_fiche< filesize(fichier_label));

          seek(fichier_label, l_numero_fiche); read(fichier_label, fiche_label);

          with fiche_label do
            affiche_fiche(l_numero_fiche, nom, adresse, type_label);
          writeln;

          write('nom     <TRI>    ? '); readln(fiche_label.nom);
          write('adresse <$1234>  ? '); readln(fiche_label.adresse);
          write('type Code, Donn‚e ? ');
          l_type_label:= f_lis_commande(['C', 'D']); writeln;
          if l_type_label= 'D'
            then fiche_label.type_label:= utilisateur_code
            else fiche_label.type_label:= utilisateur_code;

          seek(fichier_label, l_numero_fiche); write(fichier_label, fiche_label);

          write('Continuer, Quitter ? ');
          read(kbd, choix1); writeln(choix1);
        until upcase(choix1)= 'Q';

        close(fichier_label);
      end; 

    procedure supprime_fiche;
      var l_numero_fiche: integer;
      begin
        ouvre_fichier;
        if resultat_entree_sortie<> 0
          then exit;

        repeat
          writeln;
          repeat
            write('supprimer la fiche num‚ro <0..', filesize(fichier_label)- 1, '> ? ');
            readln(l_numero_fiche);
          until (l_numero_fiche>= 0) and (l_numero_fiche< filesize(fichier_label));

          seek(fichier_label, l_numero_fiche); read(fichier_label, fiche_label);

          with fiche_label do
            affiche_fiche(l_numero_fiche, nom, adresse, type_label);

          write('. Supprime ? '); read(kbd, choix1); writeln(choix1);
          if upcase(choix1)= 'S'
            then begin
                fiche_label.type_label:= efface;
                seek(fichier_label, l_numero_fiche);
                write(fichier_label, fiche_label);
              end;

          write('Continuer, Quitter ? ');
          read(kbd, choix1); writeln(choix1);
        until upcase(choix1)= 'Q';

        close(fichier_label);
      end; 

    procedure filtre_plage_labels;
      var l_numero_fiche: integer;

          l_nouveau_fichier_label: file of t_fiche_label;
          l_nouveau_nom: string64;
          l_nouveau_numero: integer;

          l_minimum, l_maximum: integer;
      begin 
        writeln('place dans nouveau fichier que certaines adresses');
        write('r‚‚crit sous le nom <LABELS2.DTA> ? '); readln(l_nouveau_nom);
        if f_fichier_existe(l_nouveau_nom)
          then begin
              writeln;
              write('le fichier ', l_nouveau_nom, ' existe d‚j…. D‚truire, Quitter ? ');
              if f_lis_commande(['D', 'Q'])<> 'D'
                then exit;
              writeln;
            end;

        assign(l_nouveau_fichier_label, l_nouveau_nom);
        rewrite(l_nouveau_fichier_label);
        l_nouveau_numero:= 0;

        ouvre_fichier;
        if resultat_entree_sortie<> 0
          then exit;
        l_numero_fiche:= 0;

        writeln(filesize(fichier_label));

        write('adresse minimale <$1234> ? '); readln(l_minimum);
        write('adresse maximale <$5678> ? '); readln(l_maximum);

        while not eof(fichier_label) do
        begin
          read(fichier_label, fiche_label);
          write(l_numero_fiche:4);
          with fiche_label do
            affiche_fiche(l_numero_fiche, nom, adresse, type_label);

          if (fiche_label.adresse- $8000>= l_minimum- $8000)
              and (fiche_label.adresse- $8000<= l_maximum- $8000)
            then begin
                if fiche_label.type_label in [call_valide_instruction..utilisateur_donnee]
                  then begin
                      writeln(' ajoute');
                      write(l_nouveau_fichier_label, fiche_label);
                      l_nouveau_numero:= l_nouveau_numero+ 1;
                    end
                  else writeln(' pas ajout‚');
              end
            else writeln(' en dehors');

          l_numero_fiche:= l_numero_fiche+ 1;
        end;

        close(l_nouveau_fichier_label);
        close(fichier_label);
      end; 

    begin 
      writeln;
      write('Ajoute, Liste, Modifie, Supprime, Filtre, Quitte ? ');
      l_choix:= f_lis_commande(['A', 'L', 'M', 'S', 'F', 'Q']); writeln;
      case l_choix of
        'A' : ajoute_fichier;
        'F' : filtre_plage_labels;
        'L' : liste_fichier;
        'M' : modifie_fichier;
        'S' : supprime_fiche;
      end; 
    end; 

  procedure ajoute_un_label(var pv_pointeur: t_pointeur_label;
                            p_numero_fiche: integer;
                            p_signale_si_deja: boolean);

    procedure ajoute_label(var pv_pointeur: t_pointeur_label);
      begin
        if pv_pointeur= nil
          then begin
              new(pv_pointeur);
              with pv_pointeur^ do
              begin
                adresse:= fiche_label.adresse;
                numero_fiche:= p_numero_fiche;

                nom:= fiche_label.nom;
                type_label:= fiche_label.type_label;

                pt_inferieurs:= nil; pt_superieurs:= nil;
              end; 
            end 
          else
            if fiche_label.adresse- $8000< pv_pointeur^.adresse- $8000
              then ajoute_label(pv_pointeur^.pt_inferieurs)
              else
                if fiche_label.adresse- $8000> pv_pointeur^.adresse- $8000
                  then ajoute_label(pv_pointeur^.pt_superieurs)
                  else
                    if p_signale_si_deja
                        and not (fiche_label.type_label in [deja, efface])
                      then begin
                          write(pv_pointeur^.numero_fiche,
                                ' a la mˆme adresse !'); stop;
                        end;
      end; 

    begin 
      ajoute_label(pv_pointeur);
    end; 

  procedure construis_index;
    const k_signale_si_deja= true;
    var l_numero_fiche, l_derniere_fiche: integer;

    begin 
      ouvre_fichier;
      if resultat_entree_sortie<> 0
        then exit;

      l_derniere_fiche:= filesize(fichier_label);
      write('num‚ro d‚but <0> ? '); readln(l_numero_fiche);
      write('num‚ro fin   <', l_derniere_fiche- 1, '> ? '); readln(l_derniere_fiche);

      seek(fichier_label, l_numero_fiche);

      release(sommet_tas);
      racine_labels_code:= nil;
      racine_labels_donnees:= nil;

      while not eof(fichier_label) and (l_numero_fiche< l_derniere_fiche) do
      begin
        read(fichier_label, fiche_label);

        with fiche_label do
          affiche_fiche(l_numero_fiche, nom, adresse, type_label);

        if fiche_label.type_label= utilisateur_donnee
          then ajoute_un_label(racine_labels_donnees, l_numero_fiche,
                               k_signale_si_deja)
          else
            if fiche_label.type_label in [call_valide_instruction..utilisateur_code]
              then ajoute_un_label(racine_labels_code, l_numero_fiche,
                                   k_signale_si_deja);
        writeln;

        l_numero_fiche:= l_numero_fiche+ 1;
      end;

      close(fichier_label);
    end; 

  procedure liste_index;
    var l_type_liste: char;
        l_arbre_code_ou_donnees: char;

    procedure affiche(p_pointeur: t_pointeur_label);
      begin
        if p_pointeur<> nil
          then begin
              affiche(p_pointeur^.pt_inferieurs);

              with p_pointeur^ do
                case l_type_liste of
                  'C' : 
                          affiche_fiche(numero_fiche, nom, adresse, type_label);
                  'E' : 
                        if nom<> ''
                          then begin
                              write(sortie, nom, '': 16- length(nom));
                              write(sortie, 'EQU $', f_entier_hexadecimal(adresse));
                            end;
                end; 
              writeln(sortie);

              affiche(p_pointeur^.pt_superieurs);
            end;
      end; 

    begin 
      write('labels de Code ou de Donn‚es ? ');
      l_arbre_code_ou_donnees:=f_lis_commande(['C', 'D']); writeln;

      write('format Complet ou Equates ? ');
      l_type_liste:=f_lis_commande(['C', 'E']); writeln;

      if l_arbre_code_ou_donnees= 'C'
        then affiche(racine_labels_code)
        else affiche(racine_labels_donnees);
    end; 

  procedure ajoute_ou_modifie_labels;

    var l_entree: text;
        l_nom_entree: string64;

        l_arbre_code_ou_donnees: char;
        l_ajoute_ou_modifie: char;

        l_ligne_entree: string127;
        l_erreur_entree: boolean;

    procedure entre_type_de_traitement;
      var l_confirme: char;
      begin
        repeat
          writeln;
          write('nom du fichier d''entr‚e <con:> ou <b:labels.txt> ? ');
          readln(l_nom_entree);

          write('labels de Code ou de Donn‚es ? ');
          l_arbre_code_ou_donnees:=f_lis_commande(['C', 'D']);
          writeln;

          write('Ajoute ou Modifie des noms ? ');
          l_ajoute_ou_modifie:=f_lis_commande(['A', 'M']);
          writeln;

          writeln;
          write('Vous confirmez ce choix: Ok, Modifier ? ');
          l_confirme:= f_lis_commande(['O', 'M']); writeln;
        until upcase(l_confirme)= 'O';

        if (l_nom_entree= 'con:') or (l_nom_entree= 'CON:')
          then begin
              writeln;
              writeln('entre les lignes: le_label EQU $1234 <RETURN>');
              writeln('CTRL-Z pour finir ');
            end;
      end; 

    procedure traite_la_ligne;
      var l_indice: integer;
          l_taille_ligne: integer;

          l_nom: string127;
          l_adresse: integer;

          l_pt_courant: t_pointeur_label;

      procedure analyse_ligne;
        var l_erreur_numerique: boolean;

        procedure calcule_adresse;
          var l_caractere: char;
          begin
            l_erreur_numerique:= false;
            l_adresse:= 0;
            repeat
              l_caractere:= upcase(l_ligne_entree[l_indice]);
              if l_caractere in ['0'..'9']
                then l_adresse:= l_adresse* 16+ ord(l_caractere)- 48
                else
                  if l_caractere in ['A'..'F']
                    then l_adresse:= l_adresse* 16+ ord(l_caractere)- 55
                    else
                      if l_caractere<> ' '
                        then l_erreur_numerique:= true;
              l_indice:= l_indice+ 1;
            until l_erreur_numerique or (l_indice> length(l_ligne_entree));
          end; 

        begin 
          l_taille_ligne:= length(l_ligne_entree);

          l_indice:= 1;
          if not (l_ligne_entree[l_indice] in ['A'..'Z', 'a'..'z', '_', '‚'..'—', '.'])
            then begin
                writeln; write('^': l_indice);
                affiche_erreur('ne commence pas A..Z, a..z, ‚..—, _ . ');
                l_erreur_entree:= true;
                exit;
              end;
          l_indice:= l_indice+ 1;

          while (l_indice<= l_taille_ligne)
              and (l_ligne_entree[l_indice] in ['0'..'9', 'A'..'B', 'a'..'z',
                                                '_', '‚'..'—']) do
            l_indice:= l_indice+ 1;

          if (l_indice> l_taille_ligne) or (l_ligne_entree[l_indice]<> ' ')
            then begin
                writeln; write('^': l_indice);
                affiche_erreur('nom label incorrect');
                l_erreur_entree:= true;
                exit;
              end;

          move(l_ligne_entree[1], l_nom[1], l_indice- 1);
          l_nom[0]:= chr(l_indice- 1);

          while (l_indice<= l_taille_ligne)
              and (l_ligne_entree[l_indice]= ' ') do
            l_indice:= l_indice+ 1;

          while (l_indice<= l_taille_ligne)
              and (l_ligne_entree[l_indice]<> ' ') do
            l_indice:= l_indice+ 1;

          while (l_indice<= l_taille_ligne)
              and (l_ligne_entree[l_indice]= ' ') do
            l_indice:= l_indice+ 1;

          if (l_indice> l_taille_ligne) or (l_ligne_entree[l_indice]<> '$')
            then begin
                writeln; write('^': l_indice);
                affiche_erreur('attend ESPACE EQU ESPACE $');
                l_erreur_entree:= true;
                exit;
              end;

          l_indice:= l_indice+ 1;
          calcule_adresse;
          if l_erreur_numerique
            then begin
                writeln; write('^': l_indice);
                affiche_erreur('erreur dans l''adresse');
                l_erreur_entree:= true;
              end;
        end; 

      procedure ajoute_nom;
        const k_pas_signaler_doubles= false;
        var l_numero_fiche: integer;
            l_confirme: char;
        begin
          if l_arbre_code_ou_donnees= 'C'
            then l_pt_courant:= racine_labels_code
            else l_pt_courant:= racine_labels_donnees;

          while (l_pt_courant<> nil) and (l_pt_courant^.adresse<> l_adresse) do
            if l_adresse< l_pt_courant^.adresse
              then l_pt_courant:= l_pt_courant^.pt_inferieurs
              else l_pt_courant:= l_pt_courant^.pt_superieurs;

          if l_pt_courant= nil
            then begin
                if l_ajoute_ou_modifie= 'M'
                  then begin
                      write('pas trouv‚ l''adresse. ',
                             'Ajouter nouveau label, Quitter ? ');
                      l_confirme:= f_lis_commande(['A', 'Q']); writeln;
                      if l_confirme= 'Q'
                        then exit;
                    end;

                fiche_label.adresse:= l_adresse;
                if l_arbre_code_ou_donnees= 'C'
                  then fiche_label.type_label:= utilisateur_code
                  else fiche_label.type_label:= utilisateur_donnee;
                fiche_label.nom:= l_nom;

                l_numero_fiche:= filesize(fichier_label);
                seek(fichier_label, l_numero_fiche);
                write(fichier_label, fiche_label);

                if l_arbre_code_ou_donnees= 'C'
                  then ajoute_un_label(racine_labels_code, l_numero_fiche, k_pas_signaler_doubles)
                  else ajoute_un_label(racine_labels_donnees, l_numero_fiche, k_pas_signaler_doubles);
              end
            else begin

                if l_pt_courant^.nom<> l_nom
                  then begin
                      if l_ajoute_ou_modifie= 'A'
                        then begin
                            write(l_pt_courant^.nom, ' -> ', l_nom, ' Ok ajouter, Quitter ? ');
                            l_confirme:= f_lis_commande(['O', 'Q']); writeln;
                            if l_confirme= 'Q'
                              then exit;
                          end;

                      fiche_label.adresse:= l_adresse;
                      fiche_label.nom:= l_nom;
                      if l_pt_courant^.type_label< utilisateur_code
                        then fiche_label.type_label:= l_pt_courant^.type_label
                        else
                          if l_arbre_code_ou_donnees= 'C'
                            then fiche_label.type_label:= utilisateur_code
                            else fiche_label.type_label:= utilisateur_donnee;

                      seek(fichier_label, l_pt_courant^.numero_fiche);
                      write(fichier_label, fiche_label);

                      l_pt_courant^.nom:= l_nom;
                    end; 
              end; 
        end; 

      begin 
        l_erreur_entree:= false;
         analyse_ligne;
         if not l_erreur_entree
           then ajoute_nom;
      end; 

    begin 
      ouvre_fichier;
      if resultat_entree_sortie<> 0
        then exit;

      entre_type_de_traitement;

      assign(l_entree, l_nom_entree);
      (*$i-*)
      reset(l_entree);
      (*$i+*)
      if ioresult<> 0
        then begin
            write('erreur ouverture ', l_nom_entree);
            close(l_entree);
            close(fichier_label);
            exit;
          end;

      while not eof(l_entree) do
      begin
        readln(l_entree, l_ligne_entree);
        write(l_ligne_entree);

        if length(l_ligne_entree)> 0
          then traite_la_ligne;
        writeln;
      end;

      close(fichier_label);
      close(l_entree);
    end; 

  procedure construis_index_alphabetique;
    var l_numero_fiche, l_derniere_fiche: integer;

    procedure ajoute_label(var pv_pointeur: t_pointeur_alphabetique);
      begin
        if pv_pointeur= nil
          then begin
              write('.');
              new(pv_pointeur);
              with pv_pointeur^ do
              begin
                nom:= fiche_label.nom;
                adresse:= fiche_label.adresse;
                type_label:= fiche_label.type_label;
                numero_fiche:= l_numero_fiche;
                pt_inferieurs:= nil; pt_superieurs:= nil;
              end 
            end 
          else
            if fiche_label.nom< pv_pointeur^.nom
              then ajoute_label(pv_pointeur^.pt_inferieurs)
              else ajoute_label(pv_pointeur^.pt_superieurs);
      end; 

    begin 
      ouvre_fichier;
      if resultat_entree_sortie<> 0
        then exit;

      l_derniere_fiche:= filesize(fichier_label);
      write('num‚ro d‚but <0> ? '); readln(l_numero_fiche);
      write('num‚ro fin   <', l_derniere_fiche, '> ? '); readln(l_derniere_fiche);

      seek(fichier_label, l_numero_fiche);

      release(sommet_tas);
      racine_labels_code:= nil;
      racine_labels_donnees:= nil;
      racine_alphabetique:= nil;

      while not eof(fichier_label) and (l_numero_fiche< l_derniere_fiche) do
      begin
        read(fichier_label, fiche_label);

        with fiche_label do
          affiche_fiche(l_numero_fiche, nom, adresse, type_label);

        ajoute_label(racine_alphabetique);
        writeln;

        l_numero_fiche:= l_numero_fiche+ 1;
      end;

      close(fichier_label);
    end; 

  procedure liste_alphabetique;
    var l_premiere_fiche: boolean;
        l_pointeur_precedent: t_pointeur_alphabetique;

    procedure liste_arbre(p_pointeur: t_pointeur_alphabetique);
      begin
        if p_pointeur<> nil
          then begin
              liste_arbre(p_pointeur^.pt_inferieurs);

              if p_pointeur^.type_label<= utilisateur_donnee
                then
                  with p_pointeur^ do
                  begin
                    affiche_fiche(numero_fiche, nom, adresse, type_label);

                    if l_premiere_fiche
                      then l_premiere_fiche:= false
                      else
                        if (l_pointeur_precedent^.nom= nom)
                          and (nom<> '')
                          and (nom[1]= ' ')
                          and not (
                                    (
                                       (l_pointeur_precedent^.type_label in [call_valide_instruction..utilisateur_code])
                                        and (type_label= utilisateur_donnee)
                                     )
                                    or
                                    (
                                       (l_pointeur_precedent^.type_label= utilisateur_donnee)
                                        and (type_label in [call_valide_instruction..utilisateur_code])
                                     )
                                    )
                         then begin
                             write(sortie, ' d‚j… !');
                             stop;
                           end;
                    writeln(sortie);

                    l_pointeur_precedent:= p_pointeur;
                  end;

              liste_arbre(p_pointeur^.pt_superieurs);
            end;
      end; 

    begin 
       l_premiere_fiche:= false;
       liste_arbre(racine_alphabetique);
    end; 

  procedure initialise;
    begin
      nom_fichier_label:= 'labels.dta';

      mark(sommet_tas);
      racine_labels_code:= nil;
      racine_labels_donnees:= nil;
      racine_alphabetique:= nil;

      nom_sortie:= 'CON:';
      assign(sortie, nom_sortie);
      rewrite(sortie);
    end; 

  begin 
    initialise;
    repeat
      writeln;
      writeln(nom_fichier_label, ', sortie: ', nom_sortie);
      writeln('Cr‚e, Nom, Sortie');
      writeln('GŠre par num‚ro de fiche');
      writeln('Tri index, Liste index, Ajoute ou modifie index‚');
      write  ('tRi alphab‚tique, listE alphab‚tique, Quitte ? ');

      read(kbd, choix); writeln(choix); choix:= upcase(choix);

      case choix of
       'A' : ajoute_ou_modifie_labels;
       'C' : cree_fichier;
       'E' : liste_alphabetique;
       'G' : gere_par_numero_de_fiche;
       'L' : liste_index;
       'N' : change_nom_fichier;
       'R' : construis_index_alphabetique;
       'S' : choisis_sortie;
       'T' : construis_index;
      end;
    until choix= 'Q';

    close(sortie);
  end.