3 (*_____________________________________________________*)
\r
5 (* Pawel Susicki 1988/89 *)
\r
6 (* Two sorting algorithms: quick-sort and merge-sort *)
\r
7 (* Warning : int /m8000 qsort *)
\r
8 (* The maximal number of elements < 46 *)
\r
9 (*_____________________________________________________*)
\r
11 unit NewPage : procedure;
\r
13 write( chr(27), "[2J")
\r
16 unit SetCursor : procedure(row, column : integer);
\r
28 write( chr(27), "[", c, d, ";", e, f, "H")
\r
31 unit Initialization : procedure(output max , min : integer);
\r
34 call SetCursor(5,20);
\r
35 writeln("TWO SORTING ALGORITHMES");
\r
36 call SetCursor(7, 20);
\r
37 write("by Pawel Susicki 1988/1989");
\r
38 call SetCursor(12,10);
\r
39 write("This program presents the parralel realisation of the ");
\r
40 call SetCursor(13,10);
\r
41 write("Merge-sort and Quick-sort Algoriths.");
\r
42 call SetCursor(14,10);
\r
43 writeln("The Elements of the sequence are chosen randomly.");
\r
44 Call SetCursor(20,5);
\r
45 write("Number of elements : ");readln(max);
\r
46 write(" min for a process :");readln(min);
\r
47 write(" press CR to start"); readln;
\r
50 (*------------------------------------------------------------------------*)
\r
52 unit ekran:IWGRAPH process(nr:integer,skip:integer);
\r
54 unit print:procedure(begin_line,index,val,kolor :integer);
\r
57 call move(1+index*skip,begin_line);
\r
58 call draw(1+index*skip,begin_line-val);
\r
60 call move(1+index*skip,begin_line-val-1);
\r
61 call draw(1+index*skip,begin_line-150);
\r
62 call move(index*skip,begin_line);
\r
63 call draw(index*skip,begin_line-150);
\r
64 call move(2+index*skip,begin_line);
\r
65 call draw(2+index*skip,begin_line-150);
\r
68 unit lightprint:procedure(begin_line,index,val,kolor:integer);
\r
72 call move(i+index*skip,begin_line);
\r
73 call draw(i+index*skip,begin_line-val);
\r
77 call move(i+index*skip,begin_line-val-1);
\r
78 call draw(i+index*skip,begin_line-150);
\r
83 unit printchr:procedure(x,y:integer,s:string);
\r
84 var A : arrayof char,i : integer;
\r
89 for i := lower(A) to upper(A)
\r
92 call hascii(ord(A(i)));
\r
101 accept print,lightprint,printchr;
\r
105 (*-------------------------------------------------------------------*)
\r
108 unit A: process(nr:integer,begin_line:integer,ile:integer,
\r
109 E:ekran,kolor:integer);
\r
110 (* This process is used to keep the given sequence of elements *)
\r
111 (* and to do all necessary manipulations on it. *)
\r
113 var tab:arrayof integer;
\r
115 unit take:function(i:integer):integer;
\r
120 unit put_tab:procedure(i,val:integer);
\r
123 call E.print(begin_line,i,val,kolor);
\r
126 unit light:procedure(i:integer);
\r
128 call E.lightprint(begin_line,i,tab(i),kolor);
\r
131 unit normal:procedure(i:integer);
\r
133 call E.print(begin_line,i,tab(i),kolor);
\r
136 unit swap:procedure(i,j:integer);
\r
142 call E.print(begin_line,i,tab(i),kolor);
\r
143 call E.print(begin_line,j,tab(j),kolor);
\r
146 unit comp:function(i,j:integer):integer;
\r
158 unit printchr:procedure(x,y:integer,s:string);
\r
160 call E.printchr(x,begin_line-y,s);
\r
164 when ACCERROR:call E.printchr(325,325,"ACCERROR");
\r
165 call E.groff;call endrun;
\r
166 when CONERROR:call E.printchr(325,325,"CONERROR");
\r
167 call E.groff;call endrun;
\r
168 when LOGERROR:call E.printchr(325,325,"LOGERROR");
\r
169 call E.groff;call endrun;
\r
170 when MEMERROR:call E.printchr(325,325,"MEMERROR");
\r
171 call E.groff;call endrun;
\r
172 when NUMERROR:call E.printchr(325,325,"NUMERROR");
\r
173 call E.groff;call endrun;
\r
174 when TYPERROR:call E.printchr(325,325,"TYPERROR");
\r
175 call E.groff;call endrun;
\r
176 when SYSERROR:call E.printchr(325,325,"SYSERROR");
\r
177 call E.groff;call endrun;
\r
181 array tab dim(1:ile);
\r
184 accept take,put_tab,swap,comp,light,normal,printchr;
\r
188 (*----------------------------------------------------------------*)
\r
189 unit sync:process(nr:integer);
\r
190 (*This process is used uniquely for the sake of synchronization*)
\r
191 unit slock:procedure;
\r
196 unit sunlock:procedure;
\r
207 (*--------------------------------------------------------------------*)
\r
209 unit BS:process(nr:integer,from,until:integer,T:A,father:P);
\r
210 (* Bubbel-sort algorithm. Both main-processes PMS and PQS use *)
\r
211 (* this algorithm in the case the longeur of the table is<min *)
\r
213 var left:integer, l:boolean;
\r
220 call T.normal(left);
\r
221 if T.comp(left,left+1)>0 then
\r
222 call T.swap(left,left+1);
\r
225 if left=from then call T.light(left); fi;
\r
227 if left >= until then exit; fi;
\r
228 call T.normal(left);(*bylo reverse*)
\r
230 call T.normal(from);
\r
231 if l then exit; fi;
\r
235 (*---------------------------------------------------------------*)
\r
237 unit P: process(nr, from,until,min:integer, T:A, father:P,
\r
239 (* Process- prefix for both Quick and Merge sort *)
\r
240 var kolega:P, bubble:BS, left,right:integer;
\r
242 unit sync:procedure;
\r
246 when ACCERROR:call T.E.GROFF;writeln("ACCERROR");call endrun;
\r
247 when CONERROR:call T.E.GROFF;writeln("CONERROR");call endrun;
\r
248 when LOGERROR:call T.E.GROFF;writeln("LOGERROR");call endrun;
\r
249 when MEMERROR:call T.E.GROFF;writeln("MEMERROR");call endrun;
\r
250 when NUMERROR:call T.E.GROFF;writeln("NUMERROR");call endrun;
\r
251 when TYPERROR:call T.E.GROFF;writeln("TYPERROR");call endrun;
\r
252 when SYSERROR:call T.E.GROFF;writeln("SYSERROR");call endrun;
\r
257 unit PMS:P process;
\r
258 (* Algorithm MERGE-SORT. *)
\r
260 var tab:arrayof integer;
\r
265 call T.light(from);
\r
266 left:=from+(until-from)div 2;
\r
273 if right-from+1 > min
\r
275 kolega:=new PMS(0,from,left,min,T,this PMS,false,S);
\r
278 bubble:=new BS(0,from,left,T,this PMS);
\r
285 if until-right+1 > min
\r
287 kolega:=new PMS(0,right,until,min,T,this PMS,false,S);
\r
290 bubble:=new BS(0,right,until,T,this PMS);
\r
294 if l then accept sync; fi;
\r
295 if r then accept sync; fi;
\r
296 array tab dim(from:until);
\r
303 tab(ll):=T.take(right);
\r
308 tab(ll):=T.take(left);
\r
311 if T.comp(left,right)<0
\r
313 tab(ll):=T.take(left);
\r
316 tab(ll):=T.take(right);
\r
322 if ll>until then exit; fi;
\r
326 call T.put_tab(left,tab(left));
\r
328 if left>until then exit; fi;
\r
331 then call father.sync;
\r
333 call T.printchr(50,60,"MERGE - SORT" );
\r
338 unit PQS:P process;
\r
340 var counter:integer;
\r
342 unit shuffle:procedure;
\r
344 call T.light(from);
\r
348 while T.comp(from,left) >=0 do
\r
349 call T.normal(left);
\r
351 if left < right then call T.normal(left); fi;
\r
352 if left > right then exit; fi;
\r
354 while T.comp(from,right)<=0 do
\r
355 call T.normal(right);
\r
357 if left < right then call T.normal(right); fi;
\r
358 if left > right then exit; fi;
\r
361 call T.swap(left,right);
\r
362 call T.normal(left);
\r
363 call T.normal(right);
\r
365 if left >= right then exit; fi;
\r
367 call T.swap(from,right);
\r
370 unit gen:procedure(from,until:integer; inout c:integer);
\r
375 if until-right > min
\r
377 kolega:=new PQS(0,from,until,min,T,this PQS,false,S);
\r
380 bubble:=new BS(0,from,until,T,this PQS);
\r
390 while imax(right-from,until-right) > min+1 do
\r
391 if until-right < right-from
\r
393 call gen(right+1,until,counter);
\r
396 call gen(from,right-1,counter);
\r
401 call gen(right+1,until,counter);
\r
402 call gen(from,right-1,counter);
\r
403 while counter > 0 do
\r
405 counter:=counter-1;
\r
408 then call father.sync;
\r
410 call T.printchr(50,60,"QUICK - SORT");
\r
414 (*--------------------------------------------------------------------*)
\r
417 var E:ekran,T0,T1:A, S:sync, P1:PMS, P2:PQS,
\r
418 i,x,max,min:integer;
\r
421 call Initialization(max,min);
\r
423 E:=new ekran(0,600/max);
\r
425 (* the processes TO and T1 are used to operate on the given sequence*)
\r
426 T0:=new A(0,160,max,E,10);
\r
427 T1:=new A(0,320,max,E,11);
\r
434 call T0.put_tab(i,x);
\r
435 call T1.put_tab(i,x);
\r
442 P1:=new PMS(0,1,max,min,T0,none,true,S);
\r
443 P2:=new PQS(0,1,max,min,T1,none,true,S);
\r
446 call S.slock;(* main wait for all other processes *)
\r
449 call E.printchr(450,325,"press CR"); readln;
\r