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.