TP3/Resources/DESASS/ICODE1.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 desassemble_code(p_adresse_debut, p_adresse_fin: integer);
    var l_code_operation: byte;
        l_ligne: string80;

        l_al_precedent, l_ah_precedent, l_ax_precedent,
        l_bl_precedent, l_bh_precedent, l_bx_precedent,
        l_cl_precedent, l_ch_precedent, l_cx_precedent,
        l_dl_precedent, l_dh_precedent, l_dx_precedent: integer;

    procedure decode_instruction;
      var l_mode, l_registre, l_registre_memoire: byte;

          l_bit_mot, 
          l_bit_direction, 
          l_bits_registre, l_bit_registre_mot: byte;

          l_operande: byte;
          l_operande_precedent: integer;
          l_chaine, l_chaine2: string21;
          l_adresse: integer;

      procedure met(suite: string21);
        begin
          l_ligne:= concat(l_ligne, suite);
        end; 

      procedure met2(suite1, suite2: string21);
        begin
          l_ligne:= concat(l_ligne, suite1, suite2);
        end; 

      procedure met3(suite1, suite2, suite3: string21);
        begin
          l_ligne:= concat(l_ligne, suite1, suite2, suite3);
        end; 

      function f_deplacement_octet(oct: byte): string21;
        var l_nom_constante: string15;
        begin
          ajoute_label_donnees(oct, racine_donnees, b_reference_donnees, l_nom_constante, octet);
          f_deplacement_octet:= concat('[', l_nom_constante, ']');
        end; 

      function f_deplacement_mot(oct1, oct2: byte): string21;
        var l_nom_constante: string15;
            l_mot: integer;
        begin
          l_mot:= oct1*256+ oct2;
          ajoute_label_donnees(l_mot, racine_donnees, b_reference_donnees, l_nom_constante, mot);
          f_deplacement_mot:= concat('[', l_nom_constante, ']');
        end; 

      procedure met_operande_un_octet;
        var l_nom_constante: string15;
        begin
          lis_octet_suivant(l_operande);

          l_operande_precedent:= l_operande;

          ajoute_label_donnees(l_operande, racine_immediat, b_reference_immediat,
                               l_nom_constante, octet);

          ajoute_label_donnees(l_operande, racine_donnees, false, l_nom_constante, octet);
          met(l_nom_constante);
        end; 

      procedure met_operande_un_mot;
        var l_nom_constante: string15;
            l_mot: integer;
        begin
          lis_entier_suivant(l_mot);

          ajoute_label_donnees(l_mot, racine_immediat, b_reference_immediat, l_nom_constante, mot);

          ajoute_label_donnees(l_mot, racine_donnees, false, l_nom_constante, mot);

          l_operande_precedent:= l_mot;
          (*
          adresse_lib:= l_operande_precedent;
          *)

          met(l_nom_constante);
        end; 

      procedure met_operande(p_bit_mot: byte);
        begin
          if p_bit_mot= 0
            then met_operande_un_octet
            else met_operande_un_mot;
        end; 

      procedure met_operande_relatif_un_octet;
        var l_adresse: integer;
        begin
          lis_octet_suivant(l_operande);
          if l_operande< $80
            then l_adresse:= l_operande+ adresse
            else l_adresse:= l_operande+ adresse- $100;

          met(f_ajoute_label_relatif(l_adresse));
        end; 

      procedure met_operande_relatif_un_mot;
        var l_deplacement, l_adresse: integer;
        begin
          lis_entier_suivant(l_deplacement);
          met(f_ajoute_label_relatif(adresse+ l_deplacement));
        end; 

      procedure lis_octet_mode;
        begin
          lis_octet_suivant(l_operande);

          l_mode:= (l_operande and $C0) shr 6;
          l_registre:= (l_operande and $38) shr 3;
          l_registre_memoire:= l_operande and $07;
        end; 

      function f_lis_deplacement: string21;
        var l_deplacement1, l_deplacement2: byte;
        begin
          f_lis_deplacement:='';
          case l_mode of
           0 : if l_registre_memoire= 6
                 then begin
                     lis_octet_suivant(l_deplacement1);
                     lis_octet_suivant(l_deplacement2);
                     f_lis_deplacement:= f_deplacement_mot(l_deplacement2, l_deplacement1);
                   end;
           1 : begin
                 lis_octet_suivant(l_deplacement1);
                 f_lis_deplacement:= f_deplacement_octet(l_deplacement1);
               end;
           2 : begin
                 lis_octet_suivant(l_deplacement1);
                 lis_octet_suivant(l_deplacement2);
                 f_lis_deplacement:= f_deplacement_mot(l_deplacement2, l_deplacement1);
               end;
          end;
        end; 

      procedure decode_registre(p_bit_mot, p_bit_registre: byte;
                                var pv_chaine: string21);
        begin
          if p_bit_mot= 0
            then
               case p_bit_registre of
                0 : pv_chaine:= 'al';
                1 : pv_chaine:= 'cl';
                2 : pv_chaine:= 'dl';
                3 : pv_chaine:= 'bl';
                4 : pv_chaine:= 'ah';
                5 : pv_chaine:= 'ch';
                6 : pv_chaine:= 'dh';
                7 : pv_chaine:= 'bh';
               end
             else
               case p_bit_registre of
                0 : pv_chaine:= 'ax';
                1 : pv_chaine:= 'cx';
                2 : pv_chaine:= 'dx';
                3 : pv_chaine:= 'bx';
                4 : pv_chaine:= 'sp';
                5 : pv_chaine:= 'bp';
                6 : pv_chaine:= 'si';
                7 : pv_chaine:= 'di';
               end
          end; 

      procedure traite_registre(var pv_chaine: string21);
        var l_virgule, l_chaine3: string21;
            l_crochet: boolean;
        begin
          l_crochet:= true;
          case l_mode of
           0, 1, 2 : begin
                       case l_registre_memoire of
                        0 : pv_chaine:= 'bx+ si';
                        1 : pv_chaine:= 'bx+ di';
                        2 : pv_chaine:= 'bp+ si';
                        3 : pv_chaine:= 'bp+ di';
                        4 : pv_chaine:= 'si';
                        5 : pv_chaine:= 'di';
                        6 : if l_mode<> 0
                              then pv_chaine:= 'bp'
                              else pv_chaine:= '';
                        7 : pv_chaine:= 'bx';
                       end;
                     end;
           3 : begin
                 decode_registre(l_bit_mot, l_registre_memoire, pv_chaine);
                 l_crochet:= false;
               end;
          end;

          l_virgule:= '';
          l_chaine3:= f_lis_deplacement;
          if (pv_chaine<> '') and (l_chaine3<> '')
            then l_virgule:= '+ ';
          if l_crochet
            then begin
                if length(l_chaine3)> 1
                  then begin
                      (*$r-*)
                      move(l_chaine3[2], l_chaine3[1], length(l_chaine3)- 1);
                      l_chaine3[0]:= chr(length(l_chaine3)- 2);
                      (*$r+*)
                    end;
                pv_chaine:= concat('[', pv_chaine, l_virgule, l_chaine3, ']');
              end
            else pv_chaine:= concat(pv_chaine, l_virgule, l_chaine3);
        end; 

      procedure traite_mode;
        begin
          traite_registre(l_chaine);

          if (l_code_operation in [$80..$83])
             and (l_mode< 3)
            then begin
                if (l_bit_mot= 0)
                  then met('b ')
                  else met('w ');
              end;

          met(l_chaine);
        end; 

      procedure traite_bit_mot;
        begin
          traite_registre(l_chaine);

          if (l_code_operation in [$F6..$F7])
             and (l_registre in [0, 2, 3])
            then begin
                if (l_bit_mot= 0)
                  then met('b ')
                  else met('w ');
              end;

          met(l_chaine);
        end; 

      procedure traite_accumulateur_immediat;
        begin
          if l_bit_mot= 0
            then begin
                met('al, ');
                met_operande_un_octet;
              end
            else begin
                met('ax, ');
                met_operande_un_mot;
              end;
        end; 

      procedure traite_direction_mot;
        begin
          lis_octet_mode;
          traite_registre(l_chaine);
          decode_registre(l_bit_mot, l_registre, l_chaine2);

          if l_bit_direction= 0
            then begin
                met(l_chaine);
                if l_chaine2<> ''
                  then met2(', ', l_chaine2);
              end
            else begin
                 met(l_chaine2);
                 if l_chaine<> ''
                   then met2(', ', l_chaine)
              end;
        end; 

      procedure traite_fin_registre;
        begin
          decode_registre(1, l_bits_registre, l_chaine);
          met(l_chaine);
        end; 

      procedure traite_registre_registre_memoire;
        begin
          lis_octet_mode;
          traite_registre(l_chaine);
          decode_registre(l_bit_mot, l_registre, l_chaine2);
          if l_bit_direction= 0
            then met3(l_chaine, ', ', l_chaine2)
            else met3(l_chaine2, ', ', l_chaine);
        end;