ليكن ج : جدول ( 5 ، 10 ) ؛
LET Tab : ARRAY ( 5 , 10 ) ;
{ -Implementation-
: ARRAY OF INTEGERS}
{ Arrays }
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 Ass_element_V5_10I ( V :Typevect_V5_10I; I1 , I2 :INTEGER; Val :
Typeelem_V5_10I );
BEGIN
V^[I1 ,I2] := Val;
END;
{ Declaration part of variables }
VAR
Tab : Typevect_V5_10I;
{ Body of main program }
BEGIN
NEW(Tab);
END.
ليكن س : بنية ( سلسلة ، صحيح ) ؛
LET S : STRUCTURE ( STRING , INTEGER ) ;
TYPE Typestring = STRING[255];
{ Structures }
TYPE
Type1_TSI = Typestring;
Type2_TSI = INTEGER;
Typestr_TSI = ^ Type_TSI ;
Type_TSI = record
Field1 : Type1_TSI ;
Field2 : Type2_TSI ;
END;
FUNCTION Struct1_TSI ( S: Typestr_TSI) : Type1_TSI;
BEGIN
STRUCT1_TSI := S^.Field1;
END;
FUNCTION Struct2_TSI ( S: Typestr_TSI) : Type2_TSI;
BEGIN
STRUCT2_TSI := S^.Field2;
END;
PROCEDURE Ass_struct1_TSI ( S: Typestr_TSI; Val :Type1_TSI );
BEGIN
S^.Field1 := Val;
END;
PROCEDURE Ass_struct2_TSI ( S: Typestr_TSI; Val :Type2_TSI );
BEGIN
S^.Field2 := Val;
END;
{ Declaration part of variables }
VAR
S : Typestr_TSI;
{ Body of main program }
BEGIN
NEW(S);
END.
ليكن ق : قائمة ؛
LET L : LIST ;
{ -Implementation- :
LIST Of INTEGERS}
{ Linked lists }
TYPE
Typeelem_LI = INTEGER;
Pointer_LI = ^Maillon_LI; { type du champ 'Adresse' }
Maillon_LI = RECORD
Val : Typeelem_LI;
Next : Pointer_LI
END;
PROCEDURE Allocate_cell_LI ( VAR P : Pointer_LI ) ;
BEGIN NEW(P) END;
PROCEDURE Free_LI ( P : Pointer_LI ) ;
BEGIN DISPOSE(P) END;
PROCEDURE Ass_val_LI(P : Pointer_LI; Val : Typeelem_LI );
BEGIN P^.Val := Val END;
FUNCTION Cell_value_LI (P : Pointer_LI) : Typeelem_LI;
BEGIN Cell_value_LI := P^.Val END;
FUNCTION Next_LI( P : Pointer_LI) : Pointer_LI;
BEGIN Next_LI := P^.Next END;
PROCEDURE Ass_adr_LI( P, Q : Pointer_LI ) ;
BEGIN P^.Next := Q END;
{ Declaration part of variables }
VAR
L : Pointeur_LI;
{ Body of main program }
BEGIN
END.
تطبيق القوائم مزدوجة
في PASCAL
ليكن ق : قائمة_مزدوجة ؛
LET L : BILIST ;
{
-Implementation- : BIDIRECTIONAL LIST OF INTEGERS}
{ Bidirectional linked lists }
TYPE
Typeelem_RI = INTEGER;
Pointer_RI = ^Maillon_RI; { type du champ 'Adresse' }
Maillon_RI = RECORD
Val : Typeelem_RI;
Next : Pointer_RI;
Prev : Pointer_RI
END;
PROCEDURE Allocate_cell_RI ( VAR P : Pointer_RI ) ;
BEGIN NEW(P) END;
PROCEDURE Free_RI ( P : Pointer_RI ) ;
BEGIN DISPOSE(P) END;
PROCEDURE Ass_val_RI (P : Pointer_RI; Val : Typeelem_RI );
BEGIN P^.Val := Val END;
FUNCTION Cell_value_RI (P : Pointer_RI) : Typeelem_RI;
BEGIN Cell_value_RI := P^.Val END;
FUNCTION Next_RI( P : Pointer_RI) : Pointer_RI;
BEGIN Next_RI := P^.Next END;
FUNCTION Previous_RI( P : Pointer_RI) : Pointer_RI;
BEGIN Previous_RI := P^.Prev END;
PROCEDURE Ass_r_adr_RI( P, Q : Pointer_RI ) ;
BEGIN P^.Next := Q END;
PROCEDURE Ass_l_adr_RI( P, Q : Pointer_RI ) ;
BEGIN P^.Prev := Q END;
{
Declaration part of variables }
VAR
Lb : Pointeur_RI;
{ Body of main program }
BEGIN
END.
تطبيق الأشجار البحث الثنائية
في PASCAL
ليكن ا : شجرة_بحث_ثنائية ؛
LET A : BST ;
{ -Implementation- :
BINARY SERACH TREE OF INTEGERS}
{ Binary search trees }
TYPE
Typeelem_AI = INTEGER;
Pointer_AI = ^Noeud_AI;
Noeud_AI = RECORD
Element : Typeelem_AI;
Lc, Rc, Parent : Pointer_AI ;
END;
FUNCTION Node_value_AI(P : Pointer_AI) : Typeelem_AI;
BEGIN Node_value_AI := P^.Element END;
FUNCTION Lc_AI( P : Pointer_AI) : Pointer_AI;
BEGIN Lc_AI := P^.Lc END;
FUNCTION Rc_AI( P : Pointer_AI) : Pointer_AI;
BEGIN Rc_AI := P^.Rc END;
FUNCTION Parent_AI( P : Pointer_AI) : Pointer_AI;
BEGIN Parent_AI := P^.Parent END;
PROCEDURE Ass_node_val_AI ( P : Pointer_AI; Val : Typeelem_AI);
BEGIN P^.Element := Val END;
PROCEDURE Ass_lc_AI( P : Pointer_AI; Q : Pointer_AI);
BEGIN P^.Lc := Q END;
PROCEDURE Ass_rc_AI( P : Pointer_AI; Q : Pointer_AI);
BEGIN P^.Rc := Q END;
PROCEDURE Ass_parent_AI( P : Pointer_AI; Q : Pointer_AI);
BEGIN P^.Parent := Q END;
PROCEDURE Allocate_node_AI( VAR P : Pointer_AI) ;
BEGIN
NEW ( P ) ;
P^.Lc := Nil;
P^.Rc := Nil;
P^.Parent := Nil;
END;
PROCEDURE Free_node_AI( P : Pointer_AI);
BEGIN
DISPOSE ( P )
END;
{ Declaration part of variables }
VAR
A : Pointeur_AI;
{ Body of main program }
BEGIN
END.
تطبيق الأشجار البحث المتعددة
في PASCAL
ليكن ش : شجرة_بحث_متعددة ( 4 ) ؛
LET M : MST ( 4 ) ;
{ -Implementation- : M-ARY SEARCH TREE OF INTEGERS}
{ M-ary search trees }
TYPE
Typeelem_M4I = INTEGER;
Pointer_M4I = ^Noeud_M4I;
Noeud_M4I = RECORD
Infor : ARRAY[1..4] of Typeelem_M4I;
Child : ARRAY[1..4] of Pointer_M4I;
Degree : Byte ;
Parent : Pointer_M4I
END;
FUNCTION Node_value_mst_M4I(P : Pointer_M4I; I: INTEGER) : Typeelem_M4I;
BEGIN Node_value_mst_M4I := P^.Infor[I] END;
FUNCTION Child_M4I( P : Pointer_M4I; I : INTEGER) : Pointer_M4I;
BEGIN Child_M4I := P^.Child[I] END;
FUNCTION Parent_M4I( P : Pointer_M4I) : Pointer_M4I;
BEGIN Parent_M4I := P^.Parent END;
PROCEDURE Ass_node_val_mst_M4I ( P : Pointer_M4I; I:INTEGER; Val :
Typeelem_M4I);
BEGIN P^.Infor[I] := Val END;
PROCEDURE Ass_child_M4I( P : Pointer_M4I; I:INTEGER; Q : Pointer_M4I);
BEGIN P^.Child[I] := Q END;
PROCEDURE Aff_parent_M4I( P : Pointer_M4I; Q : Pointer_M4I);
BEGIN P^.Parent := Q END;
PROCEDURE Allocate_node_M4I( VAR P : Pointer_M4I ) ;
VAR
I : BYTE;
BEGIN
NEW ( P ) ;
For I:=1 TO 4 Do P^.Child[I] := NIL;
P^.degree := 0
END;
FUNCTION Degree_M4I ( P : Pointer_M4I ) : BYTE;
BEGIN
Degree_M4I := P^.Degree
END;
PROCEDURE Aff_Degree_M4I ( VAR P : Pointer_M4I; N : BYTE);
BEGIN
P^.Degree := N
END;
PROCEDURE Free_node_M4I( P : Pointer_M4I);
BEGIN
DISPOSE ( P )
END;
{ Declaration part of variables }
VAR
M : Pointeur_M4I;
{ Body of main program }
BEGIN
END.
ليكن ك : كومة ؛
LET P : STACK ;
{
-Implementation- : STACK OF INTEGERS}
{ Stacks }
TYPE
Typeelem_PI = INTEGER; { Any type }
Pointer_PI = ^Maillon_PI ;
Maillon_PI = RECORD
Valeur : Typeelem_PI;
Next : Pointer_PI
END;
PROCEDURE Createstack_PI( VAR P : Pointer_PI );
BEGIN
P := NIL;
END;
FUNCTION Empty_stack_PI ( P : Pointer_PI ) : BOOLEAN;
BEGIN
Empty_stack_PI := ( P = NIL )
END;
PROCEDURE Push_PI ( VAR P : Pointer_PI; Val : Typeelem_PI );
VAR
Q : Pointer_PI;
BEGIN
NEW(Q);
Q^.Valeur := Val;
Q^.Next := P;
P := Q;
END;
PROCEDURE Pop_PI ( VAR P : Pointer_PI; VAR V :Typeelem_PI );
VAR Save : Pointer_PI;
BEGIN
IF NOT Empty_stack_PI (P)
THEN
BEGIN
V := P^.Valeur;
Save := P;
P := P^.Next;
DISPOSE(Save);
END
ELSE WRITELN('Pile Vide');
END;
{ Declaration part of variables }
VAR
P : Pointeur_PI;
{ Body of main program }
BEGIN
END.
ليكن ص : صف ؛
LET F : QUEUE ;
{ -Implementation- :
QUEUE OF INTEGERS}
{ Queues }
TYPE
Typeelem_FI = INTEGER;
Ptliste_FI = ^Maillon_FI;
Maillon_FI = RECORD
Val : Typeelem_FI;
Next : Ptliste_FI
END;
Pointer_FI = ^ Filedattente_FI;
Filedattente_FI = RECORD
Tete, Queue : Ptliste_FI
END;
PROCEDURE Createqueue_FI (VAR Fil : Pointer_FI );
BEGIN
New (Fil);
Fil^.Tete := NIL ;
Fil^.Queue := Nil
END;
FUNCTION Empty_queue_FI (Fil : Pointer_FI) : BOOLEAN;
BEGIN Empty_queue_FI := Fil^.Tete = NIL END;
PROCEDURE Enqueue_FI (VAR Fil : Pointer_FI; Val : Typeelem_FI );
VAR
P : Ptliste_FI;
BEGIN
NEW(P);
P^.Val := Val;
P^.Next := NIL;
IF NOT Empty_queue_FI(Fil)
THEN Fil^.Queue^.Next := P
ELSE Fil^.Tete := P;
Fil^.Queue := P;
END;
PROCEDURE Dequeue_FI (VAR Fil : Pointer_FI ; VAR Val : Typeelem_FI );
BEGIN
IF NOT Empty_queue_FI(Fil)
THEN
BEGIN
Val := Fil^.Tete^.Val;
Fil^.Tete := Fil^.Tete^.Next;
END
ELSE WRITELN(' File Vide ');
END;
{ Declaration part of variables }
VAR
F : Pointeur_FI;
{ Body of main program }
BEGIN
END.
ليكن م : ملف من ( سلاسل ، صحيح ) صدر_ملف ( صحيح ، صحيح ) مخزن ب1 ؛
LET F : FILE OF ( STRINGS , INTEGER ) HEADER ( INTEGER , INTEGER ) BUFFER B1 ;
{ -Implementation- : FILE }
{ Managing open files }
TYPE
_Ptr_Noeud = ^_Noeud;
_Noeud = RECORD
Var_fich : Thandle;
Nom_fich : string;
Save_pos : Longint;
Next : _Ptr_Noeud
END;
VAR
_Stack_ouverts : _Ptr_Noeud = NIL;
FUNCTION _Ouvert (Fp : String) : _Ptr_Noeud;
VAR
P : _Ptr_Noeud;
Found : boolean;
BEGIN
P := _Stack_Open; Found := False ;
WHILE (P <> NIL) AND NOT Found DO
IF P^.Nom_Fich = Fp
THEN Found := True
ELSE P := P^.Next;
_Ouvert := P;
END;
PROCEDURE _Push_ouvert ( Fp : string; VAR Fl: Thandle);
VAR
P : _Ptr_Noeud ;
BEGIN
New(P);
P^.Nom_fich := Fp;
P^.Var_fich := Fl;
P^.Next := _Stack_Open;
_Stack_Open := P
END ;
FUNCTION _Pop_ouvert ( Fl : Thandle) : String;
VAR
P, Prev : _Ptr_Noeud ;
BEGIN
P:= _Stack_Open;
Prev := Nil;
WHILE P^.Var_fich <> Fl DO
BEGIN Prev := P ; P := P^.Next END;
_Pop_ouvert := P^.Nom_fich ;
IF Prev <> NIL
THEN Prev^.Next := P^.Next
ELSE _Stack_Open := P^.Next;
Dispose (P);
END;
{ Files }
TYPE
{ Types of block fields }
Typefield1_SIEII = Typestring;
Typefield2_SIEII = INTEGER;
{ Type of file block structure }
Typestruct_SIEII = ^ Typestruct_SIEII_ ;
Typestruct_SIEII_ = RECORD
Field1 : Typefield1_SIEII ;
Field2 : Typefield2_SIEII ;
END;
{ Type of File data block }
Typestruct_SIEII_Buf = RECORD
Field1 : Typefield1_SIEII ;
Field2 : Typefield2_SIEII ;
END;
{ Types of header fields }
Typeentete1_SIEII = INTEGER;
Typeentete2_SIEII = INTEGER;
{ Type of file feature block }
Typestruct_SIEII_entete = RECORD
Entete1 : Typeentete1_SIEII ;
Entete2 : Typeentete2_SIEII ;
END;
{ Declaration of header block }
VAR
Buf_caract_SIEII : Typestruct_SIEII_entete ;
{ Operations on files }
PROCEDURE Open_SIEII (VAR Fl : Thandle ; Fp, Mode : STRING );
VAR
P : _Ptr_Noeud;
BEGIN
P := _Open (Fp);
IF P <> NIL
THEN
BEGIN
{ Save the current position of the file and close it }
P^.Save_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;
{ Open or re open the file }
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 ;
_Push_Open(Fp, Fl);
END;
PROCEDURE Close_SIEII ( VAR Fl : Thandle);
VAR
P : _Ptr_Noeud;
Fp : String;
BEGIN
Fp := _Pop_Open(Fl);
FILESEEK(Fl,0, 0);
FILEWRITE(Fl, Buf_caract_SIEII, sizeof(Buf_caract_SIEII) );
FILECLOSE(Fl);
{ Is there a file open with the same name? }
{ If yes, open it again at the saved position }
P := _Open (Fp);
IF P <> NIL
THEN
BEGIN
Fl:=FILEOPEN(P^.Nom_fich,fmOpenReadWrite);
FILEREAD(Fl, Buf_caract_SIEII, sizeof(Buf_caract_SIEII) );
FILESEEK(Fl, P^.Save_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 Writeseq_SIEII ( VAR Fl: Thandle; Buf : Typestruct_SIEII );
VAR
Buffer : Typestruct_SIEII_Buf ;
I : Integer;
BEGIN
Buffer.Field1:= Buf^.Field1;
Buffer.Field2:= Buf^.Field2;
FILEWRITE(Fl, Buffer, Sizeof(Buffer))
END;
PROCEDURE Writedir_SIEII ( VAR Fl: Thandle; Buf : Typestruct_SIEII; N:
INTEGER );
VAR
Buffer : Typestruct_SIEII_Buf ;
I : Integer;
BEGIN
Buffer.Field1:= Buf^.Field1;
Buffer.Field2:= Buf^.Field2;
FILESEEK(Fl, Sizeof(Buf_caract_SIEII) + (N-1)*Sizeof(Buffer ), 0);
FILEWRITE(Fl, Buffer, Sizeof(Buffer))
END;
PROCEDURE Readseq_SIEII ( VAR Fl: Thandle; VAR Buf : Typestruct_SIEII );
VAR
Buffer : Typestruct_SIEII_Buf ;
I : Integer ;
BEGIN
FILEREAD(Fl, Buffer, Sizeof(Buffer));
Buf^.Field1:= Buffer.Field1;
Buf^.Field2:= Buffer.Field2;
END;
PROCEDURE Readdir_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^.Field1:= Buffer.Field1;
Buf^.Field2:= Buffer.Field2;
END;
PROCEDURE Add_SIEII ( VAR Fl: Thandle; Buf : Typestruct_SIEII);
VAR
Buffer : Typestruct_SIEII_Buf ;
I : Integer;
BEGIN
Buffer.Field1:= Buf^.Field1;
Buffer.Field2:= Buf^.Field2;
FILESEEK(Fl, 0, 2);
FILEWRITE(Fl, Buffer, Sizeof(Buffer))
END;
FUNCTION Endfile_SIEII ( VAR Fl : Thandle): BOOLEAN;
VAR
K, K2 : Longint;
BEGIN
K := FILESEEK(Fl, 0, 1); { Current position }
K2 :=FILESEEK(Fl, 0, 2); { Last position }
IF K = K2
THEN
Endfile_SIEII := true
ELSE
BEGIN
FILESEEK(Fl, K, 0);
Endfile_SIEII := False
END;
END;
FUNCTION Alloc_block_SIEII ( VAR Fl : Thandle) : INTEGER;
VAR
K : Longint;
BEGIN
K := FILESEEK(Fl, 0, 2); { End of file }
K := K - Sizeof( Typestruct_SIEII_entete); { Ignore the header }
K := K DIV Sizeof (Typestruct_SIEII_Buf);
K := K + 1;
Alloc_block_SIEII := K;
END;
{ Declaration part of variables }
VAR
F : Thandle;
B1 : Typestruct_SIEII ;
{ Body of main program }
BEGIN
NEW(B1);
END.