Implémentation des machines Z en PASCAL                    Retour au sommaire

 

Vecteurs

Structures

Listes linéaires chaînées

Listes bidirectionnelles  

Piles            

Files d'attente

Arbres de recherche binaire

Arbres de recherche m-aire

Fichiers       

 

Passage de Z en Pascal

 

 

Implémentation des vecteurs en PASCAL 

 

soit Tab un TABLEAU (5, 10);

 

{ Tableaux }

  TYPE

    Typeelem_V5_10I = INTEGER;

     Typetab_V5_10I = ARRAY[1..5,1..10] OF Typeelem_V5_10I;

    Typevect_V5_10I = ^ Typetab_V5_10I;

 

  FUNCTION Element_V5_10I ( V:Typevect_V5_10I; I1 , I2 : INTEGER ) : Typeelem_V5_10I ;

    BEGIN

      Element_V5_10I :=  V^[I1  ,I2];

    END;

 

  PROCEDURE Aff_element_V5_10I ( V :Typevect_V5_10I; I1 , I2 :INTEGER; Val : Typeelem_V5_10I );

    BEGIN

      V^[I1  ,I2] := Val;

    END;

 

  

   {Partie déclaration de variables }

   VAR

      Tab : Typevect_V5_10I;

 

 

   {Corps du programme principal }

   BEGIN

      NEW(Tab);

    

   END.

 

Implémentation des structures en PASCAL 

 

soit S une structure (chaine, entier);

 

TYPE Typestring = STRING[255];

 

  { Structures }

  TYPE

   Type1_TSI  =  Typestring;

   Type2_TSI  =  INTEGER;

   Typestr_TSI  = ^ Type_TSI ;

   Type_TSI = record

      Champ1 : Type1_TSI ;

      Champ2 : Type2_TSI ;

    END;

 

  FUNCTION STRUCT1_TSI ( S: Typestr_TSI) : Type1_TSI;

    BEGIN

      STRUCT1_TSI :=  S^.champ1;

    END;

 

  FUNCTION STRUCT2_TSI ( S: Typestr_TSI) : Type2_TSI;

    BEGIN

      STRUCT2_TSI :=  S^.champ2;

    END;

 

  PROCEDURE AFF_STRUCT1_TSI ( S: Typestr_TSI; Val :Type1_TSI  );

    BEGIN

      S^.champ1 := Val;

    END;

 

  PROCEDURE AFF_STRUCT2_TSI ( S: Typestr_TSI; Val :Type2_TSI  );

    BEGIN

      S^.champ2 := Val;

    END;

 

  

   {Partie déclaration de variables }

   VAR

      S : Typestr_TSI;

 

 

   {Corps du programme principal }

   BEGIN

      NEW(S);

    

   END.

 

Implémentation des listes linéaires chaînées en PASCAL 

   

SOIT L UNE LISTE ;

 

  { Listes linéaires chaînées }

  TYPE

    Typeelem_LI = INTEGER;

    Pointeur_LI = ^Maillon_LI; { type du champ 'Adresse' }

    Maillon_LI = RECORD

        Val : Typeelem_LI;

        Suiv : Pointeur_LI

    END;

 

  PROCEDURE Allouer_LI ( VAR P : Pointeur_LI ) ;

    BEGIN  NEW(P)  END;

 

  PROCEDURE Liberer_LI ( P : Pointeur_LI ) ;

    BEGIN  DISPOSE(P)  END;

 

  PROCEDURE Aff_val_LI(P : Pointeur_LI; Val : Typeelem_LI );

    BEGIN P^.Val := Val  END;

 

  FUNCTION Valeur_LI (P : Pointeur_LI) : Typeelem_LI;

    BEGIN   Valeur_LI := P^.Val  END;

 

  FUNCTION Suivant_LI( P : Pointeur_LI) : Pointeur_LI;

    BEGIN  Suivant_LI := P^.Suiv END;

 

  PROCEDURE Aff_adr_LI( P, Q : Pointeur_LI ) ;

    BEGIN P^.Suiv := Q    END;

 

  

   {Partie déclaration de variables }

   VAR

      L : Pointeur_LI;

Implémentation des listes bilatérales en PASCAL 

 

  soit Lb une listebi;

 

  { Listes bidirectionnelles  }

  TYPE

    Typeelem_RI = INTEGER;

    Pointeur_RI = ^Maillon_RI; { type du champ 'Adresse' }

    Maillon_RI = RECORD

        Val : Typeelem_RI;

        Suiv : Pointeur_RI;

        Prec : Pointeur_RI

    END;

 

  PROCEDURE Allouer_RI ( VAR P : Pointeur_RI ) ;

    BEGIN  NEW(P)  END;

 

  PROCEDURE Liberer_RI ( P : Pointeur_RI ) ;

    BEGIN  DISPOSE(P)  END;

 

  PROCEDURE Aff_val_RI (P : Pointeur_RI; Val : Typeelem_RI );

    BEGIN P^.Val := Val  END;

 

  FUNCTION Valeur_RI (P : Pointeur_RI) : Typeelem_RI;

    BEGIN   Valeur_RI := P^.Val  END;

 

  FUNCTION Suivant_RI( P : Pointeur_RI) : Pointeur_RI;

    BEGIN  Suivant_RI := P^.Suiv END;

 

  FUNCTION Precedent_RI( P : Pointeur_RI) : Pointeur_RI;

    BEGIN  Precedent_RI := P^.Prec END;

 

  PROCEDURE Aff_adrd_RI( P, Q : Pointeur_RI ) ;

    BEGIN P^.Suiv := Q    END;

 

  PROCEDURE Aff_adrg_RI( P, Q : Pointeur_RI ) ;

    BEGIN P^.Prec := Q    END;

 

  

   {Partie déclaration de variables }

   VAR

      Lb : Pointeur_RI;

 

Implémentation des arbres de recherche binaire en PASCAL 

 

 soit A un arb;

 

  { Arbres de recherche binaire }

  TYPE

    Typeelem_AI = INTEGER;

    Pointeur_AI = ^Noeud;

    Noeud = RECORD

      Element : Typeelem_AI;

      Fg, Fd, Pere  : Pointeur_AI ;

    END;

 

  FUNCTION Info_AI(P : Pointeur_AI) : Typeelem_AI;

    BEGIN  Info_AI := P^.Element   END;

 

  FUNCTION Fg_AI( P : Pointeur_AI) : Pointeur_AI;

    BEGIN  Fg_AI := P^.Fg  END;

 

  FUNCTION Fd_AI( P : Pointeur_AI) : Pointeur_AI;

    BEGIN  Fd_AI := P^.Fd  END;

 

  FUNCTION Pere_AI( P : Pointeur_AI) : Pointeur_AI;

    BEGIN  Pere_AI := P^.Pere  END;

 

  PROCEDURE Aff_info_AI ( VAR P : Pointeur_AI; Val : Typeelem_AI);

    BEGIN   P^.Element := Val  END;

 

  PROCEDURE Aff_fg_AI( VAR P : Pointeur_AI; Q : Pointeur_AI);

    BEGIN   P^.Fg :=  Q  END;

 

  PROCEDURE Aff_fd_AI( VAR P : Pointeur_AI; Q : Pointeur_AI);

    BEGIN   P^.Fd :=  Q  END;

 

  PROCEDURE Aff_pere_AI( VAR P : Pointeur_AI; Q : Pointeur_AI);

    BEGIN   P^.pere :=  Q  END;

 

  PROCEDURE Creernoeud_AI( VAR P : Pointeur_AI) ;

    BEGIN

      NEW ( P ) ;

      P^.Fg := Nil;

      P^.fd := Nil

    END;

 

  PROCEDURE Liberernoeud_AI( P : Pointeur_AI);

    BEGIN

      DISPOSE ( P )

    END;

 

  

   {Partie déclaration de variables }

   VAR

      A : Pointeur_AI;

 

 

Implémentation des arbres de recherche m-aire en PASCAL

 

  soit M un arm(4);

 

  { Arbres de recherche m-aire }

  TYPE

    Typeelem_M4I = INTEGER;

    Pointeur_M4I = ^Noeud;

    Noeud = RECORD

      Infor : ARRAY[1..4] of Typeelem_M4I;

      Fils  : ARRAY[1..4] of Pointeur_M4I;

      Degre : Byte ;

      Parent : Pointeur_M4I

    END;

 

  FUNCTION Infor_M4I(P : Pointeur_M4I; I: INTEGER) : Typeelem_M4I;

    BEGIN  Infor_M4I := P^.Infor[I]   END;

 

  FUNCTION Fils_M4I( P : Pointeur_M4I; I : INTEGER) : Pointeur_M4I;

    BEGIN  Fils_M4I := P^.Fils[I]  END;

 

  FUNCTION Parent_M4I( P : Pointeur_M4I) : Pointeur_M4I;

    BEGIN  Parent_M4I := P^.Parent  END;

 

  PROCEDURE Aff_infor_M4I ( P : Pointeur_M4I; I:INTEGER; Val : Typeelem_M4I);

    BEGIN   P^.Infor[I] := Val  END;

 

 

  PROCEDURE Aff_fils_M4I( P : Pointeur_M4I; I:INTEGER; Q : Pointeur_M4I);

    BEGIN   P^.Fils[I] :=  Q  END;

 

  PROCEDURE Aff_parent_M4I( P : Pointeur_M4I; Q : Pointeur_M4I);

    BEGIN   P^.parent :=  Q  END;

 

  PROCEDURE Creernoeud_M4I(  VAR P : Pointeur_M4I ) ;

    VAR

      I : BYTE;

    BEGIN

      NEW ( P ) ;

      For I:=1 TO 4 Do P^.Fils[I] := NIL;

      P.degre := 0

    END;

 

  FUNCTION Degre_M4I ( P : Pointeur_M4I ) : BYTE;

    BEGIN

      Degre_M4I := P^.Degre

    END;

 

  PROCEDURE Aff_Degre_M4I ( VAR P : Pointeur_M4I; N : BYTE);

    BEGIN

      P^.Degre := N

    END;

 

  PROCEDURE Liberernoeud_M4I( P : Pointeur_M4I);

    BEGIN

      DISPOSE ( P )

    END;

 

  

   {Partie déclaration de variables }

   VAR

      M : Pointeur_M4I;

Implémentation des piles en PASCAL  

 

  Soit P une pile ;

     { Piles }

  TYPE

    Typeelem_PI = INTEGER;  { type quelconque }

    Pointeur_PI = ^Maillon_PI ;

    Maillon_PI = RECORD

      Valeur : Typeelem_PI;

      Suivant : Pointeur_PI

    END;

 

  PROCEDURE Creerpile_PI( VAR P : Pointeur_PI );

    BEGIN

      P := NIL;

    END;

 

  FUNCTION Pilevide_PI ( P : Pointeur_PI ) : BOOLEAN;

    BEGIN

      Pilevide_PI := ( P = NIL )

    END;

 

  PROCEDURE Empiler_PI ( VAR P : Pointeur_PI; Val : Typeelem_PI );

    VAR

      Q : Pointeur_PI;

    BEGIN

      NEW(Q);

      Q^.Valeur := Val;

      Q^.Suivant := P;

      P := Q;

    END;

 

  PROCEDURE Depiler_PI ( VAR P : Pointeur_PI; VAR V :Typeelem_PI );

    VAR Sauv : Pointeur_PI;

    BEGIN

     IF NOT Pilevide_PI (P)

     THEN

       BEGIN

         V := P^.Valeur;

         Sauv := P;

         P := P^.Suivant;

         DISPOSE(Sauv);

       END

     ELSE WRITELN('Pile Vide');

    END;

 

  

   {Partie déclaration de variables }

   VAR

      P : Pointeur_PI;

Implémentation des files d'attente en PASCAL  

 

 Soit F une File ;

 

    { Files d'attente }

  TYPE

    Typeelem_FI = INTEGER;

    Ptliste_FI = ^Maillon_FI;

    Maillon_FI = RECORD

      Val  : Typeelem_FI;

      Suiv : Ptliste_FI

    END;

 

    Pointeur_FI = ^ Filedattente_FI;

    Filedattente_FI = RECORD

      Tete, Queue : Ptliste_FI

    END;

 

  PROCEDURE Creerfile_FI (VAR Fil : Pointeur_FI );

    BEGIN

      New (Fil);

      Fil^.Tete := NIL ;

      Fil^.Queue := Nil

    END;

 

  FUNCTION Filevide_FI (Fil : Pointeur_FI) : BOOLEAN;

    BEGIN  Filevide_FI := Fil^.Tete = NIL  END;

 

  PROCEDURE Enfiler_FI (VAR Fil : Pointeur_FI; Val : Typeelem_FI );

    VAR

      P : Ptliste_FI;

    BEGIN

      NEW(P);

      P^.Val := Val;

      P^.Suiv := NIL;

      IF NOT Filevide_FI(Fil)

      THEN Fil^.Queue^.Suiv := P

      ELSE Fil^.Tete := P;

      Fil^.Queue := P;

    END;

 

  PROCEDURE Defiler_FI (VAR Fil : Pointeur_FI ; VAR Val : Typeelem_FI );

    BEGIN

      IF NOT Filevide_FI(Fil)

      THEN

        BEGIN

          Val := Fil^.Tete^.Val;

          Fil^.Tete := Fil^.Tete^.Suiv;

        END

      ELSE WRITELN(' File Vide ');

    END;

 

  {Partie déclaration de variables }

   VAR

      F : Pointeur_FI;

 

Implémentation des fichiers en PASCAL 

 

soit F un fichier de (chaines, entier) entete (ENTIER, entier)  buffer B1;

 

 

  PROGRAM Mon_programme;

  Uses Sysutils;

  TYPE Typestring = STRING[255];

 

  { Implémentation : FICHIER }

  { Traitement des fichiers ouverts }

 

  TYPE

    _Ptr_Noeud = ^_Noeud;

    _Noeud = RECORD

       Var_fich : Thandle;

       Nom_fich : string;

       Sauv_pos : Longint;

       Suiv : _Ptr_Noeud

    END;

 

  VAR

    _Pile_ouverts : _Ptr_Noeud = NIL;

 

  FUNCTION _Ouvert (Fp : String) : _Ptr_Noeud;

    VAR

      P : _Ptr_Noeud;

      Trouv : boolean;

    BEGIN

      P := _Pile_ouverts; Trouv := False ;

      WHILE (P <> NIL) AND NOT Trouv DO

        IF P^.Nom_Fich = Fp

        THEN Trouv := True

        ELSE P := P^.Suiv;

      _Ouvert := P;

    END;

 

  PROCEDURE _Empiler_ouvert ( Fp : string; VAR Fl: Thandle);

    VAR

      P : _Ptr_Noeud ;

    BEGIN

      New(P);

      P^.Nom_fich := Fp;

      P^.Var_fich := Fl;

      P^.Suiv := _Pile_ouverts;

      _Pile_ouverts := P

    END ;

 

  FUNCTION _Depiler_ouvert ( Fl : Thandle) : String;

    VAR

      P, Prec : _Ptr_Noeud  ;

    BEGIN

      P:= _Pile_ouverts;

      Prec := Nil;

      WHILE P^.Var_fich <> Fl DO

        BEGIN Prec := P ; P := P^.Suiv END;

      _Depiler_ouvert := P^.Nom_fich ;

      IF Prec <> NIL

      THEN Prec^.Suiv := P^.Suiv

      ELSE _Pile_ouverts := P^.Suiv;

      Dispose (P);

    END;

 

 

  { Fichiers }

  TYPE

    { Types des champs du bloc}

    Typechamp1_SIEII =  Typestring;

    Typechamp2_SIEII =  INTEGER;

 

    { Définition de la structure du bloc du fichier }

    Typestruct_SIEII = ^ Typestruct_SIEII_ ;

    Typestruct_SIEII_ = RECORD

      Champ1 : Typechamp1_SIEII ;

      Champ2 : Typechamp2_SIEII ;

    END;

 

    { Définition du bloc du fichier }

    Typestruct_SIEII_Buf = RECORD

      Champ1 : Typechamp1_SIEII ;

      Champ2 : Typechamp2_SIEII ;

    END;

 

    { Types des champs de l'en-tête}

    Typeentete1_SIEII =  INTEGER;

    Typeentete2_SIEII =  INTEGER;

 

    { Définition du bloc d'entete }

    Typestruct_SIEII_entete = RECORD

      Entete1 : Typeentete1_SIEII ;

      Entete2 : Typeentete2_SIEII ;

    END;

 

    Typestr_TSI = Typestruct_SIEII;

    Type_TSI = Typestruct_SIEII_;    { Utilisation probable }

 

 

  { Manipulation de la structure (Buffer) }

  FUNCTION STRUCT1_TSI ( Buf : Typestruct_SIEII) : Typechamp1_SIEII;

    BEGIN

      STRUCT1_TSI :=  Buf^.champ1;

    END;

 

  FUNCTION STRUCT2_TSI ( Buf : Typestruct_SIEII) : Typechamp2_SIEII;

    BEGIN

      STRUCT2_TSI :=  Buf^.champ2;

    END;

 

  PROCEDURE AFF_STRUCT1_TSI ( Buf : Typestruct_SIEII; Val :Typechamp1_SIEII );

    BEGIN

      Buf^.champ1 := Val;

    END;

 

  PROCEDURE AFF_STRUCT2_TSI ( Buf : Typestruct_SIEII; Val :Typechamp2_SIEII );

    BEGIN

      Buf^.champ2 := Val;

    END;

 

  { Déclaration du buffer de l'en-tête }

 

  VAR

     Buf_caract_SIEII :  Typestruct_SIEII_entete ;

 

  { Opérations sur les fichiers }

 

  PROCEDURE Ouvrir_SIEII (VAR Fl : Thandle ; Fp, Mode : STRING );

    VAR

      P : _Ptr_Noeud;

    BEGIN

      P :=  _Ouvert (Fp);

      IF P <> NIL

      THEN

        BEGIN

          { Sauvegarder la position courante du fichier ouvert et le fermer }

          P^.Sauv_pos :=FILESEEK(P^.Var_fich, 0, 1);

          FILESEEK(P^.Var_fich,0,0);

          FILEWRITE(P^.Var_fich, Buf_caract_SIEII, sizeof(Buf_caract_SIEII) );

          FILECLOSE (P^.Var_fich);

        END;

 

      { Ouvrir ou Ré ouvrir le fichier }

      IF Mode = 'A'

      THEN

        BEGIN

          Fl:=FILEOPEN(Fp,fmOpenReadWrite);

          FILEREAD(Fl, Buf_caract_SIEII, sizeof(Buf_caract_SIEII) )

        END

      ELSE

        BEGIN

          Fl:=FILECREATE(Fp);

          FILEWRITE(Fl, Buf_caract_SIEII, sizeof(Buf_caract_SIEII) )

        END ;

      _Empiler_ouvert(Fp, Fl);

    END;

 

  PROCEDURE Fermer_SIEII ( VAR Fl : Thandle);

    VAR

      P : _Ptr_Noeud;

      Fp : String;

    BEGIN

      Fp := _Depiler_ouvert(Fl);

 

      FILESEEK(Fl,0, 0);

      FILEWRITE(Fl, Buf_caract_SIEII, sizeof(Buf_caract_SIEII) );

      FILECLOSE(Fl);

 

      { Ya-til un fichier ouvert avec le même nom ? }

      { Si Oui, le Réouvrir à la position sauvegardée }

      P :=  _Ouvert (Fp);

      IF P <> NIL

      THEN

        BEGIN

          Fl:=FILEOPEN(P^.Nom_fich,fmOpenReadWrite);

          FILEREAD(Fl, Buf_caract_SIEII, sizeof(Buf_caract_SIEII) );

          FILESEEK(Fl, P^.Sauv_pos, 0)

        END;

    END;

 

  FUNCTION Entete1_SIEII(  VAR Fl : Thandle): Typeentete1_SIEII;

    BEGIN

      Entete1_SIEII := Buf_caract_SIEII.Entete1;

    END;

 

  FUNCTION Entete2_SIEII(  VAR Fl : Thandle): Typeentete2_SIEII;

    BEGIN

      Entete2_SIEII := Buf_caract_SIEII.Entete2;

    END;

 

  PROCEDURE Aff_entete1_SIEII ( VAR Fl: Thandle; VAL : Typeentete1_SIEII);

    BEGIN

      Buf_caract_SIEII.Entete1 := VAL

    END;

 

  PROCEDURE Aff_entete2_SIEII ( VAR Fl: Thandle; VAL : Typeentete2_SIEII);

    BEGIN

      Buf_caract_SIEII.Entete2 := VAL

    END;

 

  PROCEDURE Ecrireseq_SIEII ( VAR Fl: Thandle;  Buf : Typestruct_SIEII );

    VAR

      Buffer : Typestruct_SIEII_Buf ;

      I : Integer;

    BEGIN

      Buffer.Champ1:= Buf^.Champ1;

      Buffer.Champ2:= Buf^.Champ2;

      FILEWRITE(Fl, Buffer, Sizeof(Buffer))

    END;

 

  PROCEDURE Ecriredir_SIEII ( VAR Fl: Thandle;  Buf : Typestruct_SIEII;  N: INTEGER );

    VAR

      Buffer : Typestruct_SIEII_Buf ;

      I : Integer;

    BEGIN

      Buffer.Champ1:= Buf^.Champ1;

      Buffer.Champ2:= Buf^.Champ2;

      FILESEEK(Fl, Sizeof(Buf_caract_SIEII) + (N-1)*Sizeof(Buffer ), 0);

      FILEWRITE(Fl, Buffer, Sizeof(Buffer))

    END;

 

  PROCEDURE Lireseq_SIEII ( VAR Fl: Thandle; VAR Buf : Typestruct_SIEII );

    VAR

      Buffer : Typestruct_SIEII_Buf ;

      I : Integer ;

    BEGIN

      FILEREAD(Fl, Buffer, Sizeof(Buffer));

      Buf^.Champ1:= Buffer.Champ1;

      Buf^.Champ2:= Buffer.Champ2;

    END;

 

  PROCEDURE Liredir_SIEII ( VAR Fl: Thandle; VAR Buf : Typestruct_SIEII;  N: INTEGER );

    VAR

      Buffer : Typestruct_SIEII_Buf ;

      I : Integer ;

    BEGIN

      FILESEEK(Fl, Sizeof(Buf_caract_SIEII) + (N-1)*Sizeof(Buffer ), 0);

      FILEREAD(Fl, Buffer, Sizeof(Buffer));

      Buf^.Champ1:= Buffer.Champ1;

      Buf^.Champ2:= Buffer.Champ2;

    END;

 

  PROCEDURE Rajouter_SIEII ( VAR Fl: Thandle;  Buf : Typestruct_SIEII);

    VAR

      Buffer : Typestruct_SIEII_Buf ;

      I : Integer;

    BEGIN

      Buffer.Champ1:= Buf^.Champ1;

      Buffer.Champ2:= Buf^.Champ2;

      FILESEEK(Fl, 0, 2);

      FILEWRITE(Fl, Buffer, Sizeof(Buffer))

    END;

 

  FUNCTION Finfich_SIEII ( VAR Fl : Thandle): BOOLEAN;

    VAR

      K, K2 : Longint;

    BEGIN

      K := FILESEEK(Fl, 0, 1);  { Position courante }

      K2 :=FILESEEK(Fl, 0, 2);  { Dernière position }

      IF K = K2

      THEN

        Finfich_SIEII := true

      ELSE

        BEGIN

          FILESEEK(Fl, K, 0);

          Finfich_SIEII := False

        END;

    END;

 

  FUNCTION Alloc_bloc_SIEII ( VAR Fl : Thandle) : INTEGER;

    VAR

      K : Longint;

    BEGIN

      K := FILESEEK(Fl, 0, 2); { Fin du fichier }

      K := K - Sizeof( Typestruct_SIEII_entete); { Ignorer l'en_tête }

      K := K DIV Sizeof (Typestruct_SIEII_Buf);

      K := K + 1;

      Alloc_bloc_SIEII := K;

    END;

 

  {Partie déclaration de variables }

  VAR

    F :  Thandle;

    B1 : Typestruct_SIEII ;

 

 

   {Corps du programme principal }

   BEGIN

     NEW(B1);

   

     ;READLN;

   END.