examples/process/sort.bak

   1  program QMsort;\r
   2  \r
   3 (*_____________________________________________________*)\r
   4  \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
  10  \r
  11   unit NewPage : procedure;\r
  12   begin\r
  13     write( chr(27), "[2J")\r
  14   end NewPage;\r
  15  \r
  16   unit  SetCursor : procedure(row, column : integer);\r
  17     var c,d,e,f  : char,\r
  18         i,j : integer;\r
  19   begin\r
  20     i := row div 10;\r
  21     j := row mod 10;\r
  22     c := chr(48+i);\r
  23     d := chr(48+j);\r
  24     i := column div 10;\r
  25     j := column mod 10;\r
  26     e := chr(48+i);\r
  27     f := chr(48+j);\r
  28     write( chr(27), "[", c, d, ";", e, f, "H")\r
  29   end SetCursor;\r
  30  \r
  31   unit Initialization : procedure(output max , min : integer);\r
  32   begin\r
  33     call NewPage;\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
  48   end Initialization;\r
  49  \r
  50 (*------------------------------------------------------------------------*)\r
  51  \r
  52    unit ekran:IIUWGRAPH process(nr:integer,skip:integer);\r
  53  \r
  54    unit print:procedure(begin_line,index,val,kolor :integer);\r
  55       begin\r
  56       call color(kolor);\r
  57       call move(1+index*skip,begin_line);\r
  58       call draw(1+index*skip,begin_line-val);\r
  59       call color(0);\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
  66    end print;\r
  67  \r
  68    unit lightprint:procedure(begin_line,index,val,kolor:integer);\r
  69    begin\r
  70       call color(kolor);\r
  71       for i := 0 to 2 do\r
  72           call move(i+index*skip,begin_line);\r
  73           call draw(i+index*skip,begin_line-val);\r
  74       od;\r
  75       call color(0);\r
  76       for i :=0 to 1 do\r
  77           call move(i+index*skip,begin_line-val-1);\r
  78           call draw(i+index*skip,begin_line-150);\r
  79       od;\r
  80    end lightprint;\r
  81  \r
  82  \r
  83    unit printchr:procedure(x,y:integer,s:string);\r
  84    var A : arrayof char,i : integer;\r
  85    begin\r
  86        A := unpack(s);\r
  87        call move(x,y);\r
  88        call color(14);\r
  89       for i := lower(A) to upper(A)\r
  90       do\r
  91        call HASCII(0);\r
  92        call hascii(ord(A(i)));\r
  93      od;\r
  94    end printchr;\r
  95  \r
  96    begin\r
  97    call gron(0);\r
  98    call cls;\r
  99    return;\r
 100    do\r
 101       accept print,lightprint,printchr;\r
 102    od;\r
 103 end ekran;\r
 104  \r
 105 (*-------------------------------------------------------------------*)\r
 106  \r
 107  \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
 112  \r
 113    var tab:arrayof integer;\r
 114  \r
 115    unit take:function(i:integer):integer;\r
 116       begin\r
 117       result:=tab(i);\r
 118    end take;\r
 119  \r
 120    unit put_tab:procedure(i,val:integer);\r
 121       begin\r
 122       tab(i):=val;\r
 123       call E.print(begin_line,i,val,kolor);\r
 124    end put_tab;\r
 125  \r
 126    unit light:procedure(i:integer);\r
 127       begin\r
 128       call E.lightprint(begin_line,i,tab(i),kolor);\r
 129    end light;\r
 130  \r
 131    unit normal:procedure(i:integer);\r
 132       begin\r
 133       call E.print(begin_line,i,tab(i),kolor);\r
 134    end normal;\r
 135  \r
 136    unit swap:procedure(i,j:integer);\r
 137    var aux:integer;\r
 138    begin\r
 139       aux:=tab(i);\r
 140       tab(i):=tab(j);\r
 141       tab(j):=aux;\r
 142       call E.print(begin_line,i,tab(i),kolor);\r
 143       call E.print(begin_line,j,tab(j),kolor);\r
 144    end swap;\r
 145  \r
 146    unit comp:function(i,j:integer):integer;\r
 147       begin\r
 148       if tab(i)<tab(j)\r
 149         then result:=-1;\r
 150         else\r
 151          if tab(i)>tab(j)\r
 152            then result:=1;\r
 153            else result:=0;\r
 154          fi;\r
 155       fi;\r
 156    end comp;\r
 157  \r
 158    unit printchr:procedure(x,y:integer,s:string);\r
 159    begin\r
 160          call E.printchr(x,begin_line-y,s);\r
 161    end printchr;\r
 162  \r
 163    handlers\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
 178    end handlers;\r
 179  \r
 180    begin\r
 181         array tab dim(1:ile);\r
 182         return;\r
 183         do\r
 184            accept take,put_tab,swap,comp,light,normal,printchr;\r
 185         od;\r
 186     end A;\r
 187  \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
 192       begin\r
 193       accept sunlock;\r
 194    end slock;\r
 195  \r
 196    unit sunlock:procedure;\r
 197       begin\r
 198    end sunlock;\r
 199  \r
 200    begin\r
 201    return;\r
 202    do\r
 203       accept slock;\r
 204    od;\r
 205 end sync;\r
 206  \r
 207 (*--------------------------------------------------------------------*)\r
 208  \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
 212  \r
 213    var left:integer, l:boolean;\r
 214    begin\r
 215    return;\r
 216    do\r
 217       l:=true;\r
 218       left:=from;\r
 219       do\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
 223             l:=false;\r
 224          fi;\r
 225          if left=from then call T.light(left); fi;\r
 226          left:=left+1;\r
 227          if left >= until then exit; fi;\r
 228          call T.normal(left);(*bylo reverse*)\r
 229       od;\r
 230       call T.normal(from);\r
 231       if l then exit; fi;\r
 232    od;\r
 233    call father.sync;\r
 234 end BS;\r
 235 (*---------------------------------------------------------------*)\r
 236  \r
 237 unit P: process(nr, from,until,min:integer, T:A, father:P,\r
 238                                         b:boolean,S:sync);\r
 239 (* Process- prefix for both Quick and Merge sort *)\r
 240    var kolega:P, bubble:BS, left,right:integer;\r
 241  \r
 242    unit sync:procedure;\r
 243    end sync;\r
 244  \r
 245 handlers\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
 253 end handlers;\r
 254  \r
 255 end P;\r
 256  \r
 257 unit PMS:P process;\r
 258 (* Algorithm MERGE-SORT. *)\r
 259    var ll,rr:integer;\r
 260    var tab:arrayof integer;\r
 261    var l,r:boolean;\r
 262  \r
 263    begin\r
 264    return;\r
 265    call T.light(from);\r
 266    left:=from+(until-from)div 2;\r
 267    right:=left+1;\r
 268    l:=false;\r
 269    r:=true;\r
 270    if left > from\r
 271      then\r
 272       l:=true;\r
 273       if right-from+1 > min\r
 274         then\r
 275          kolega:=new PMS(0,from,left,min,T,this PMS,false,S);\r
 276          resume(kolega);\r
 277         else\r
 278          bubble:=new BS(0,from,left,T,this PMS);\r
 279          resume(bubble);\r
 280       fi;\r
 281    fi;\r
 282    if until > right\r
 283      then\r
 284       r:=true;\r
 285       if until-right+1 > min\r
 286         then\r
 287          kolega:=new PMS(0,right,until,min,T,this PMS,false,S);\r
 288          resume(kolega);\r
 289         else\r
 290          bubble:=new BS(0,right,until,T,this PMS);\r
 291          resume(bubble);\r
 292       fi;\r
 293    fi;\r
 294    if l then accept sync; fi;\r
 295    if r then accept sync; fi;\r
 296    array tab dim(from:until);\r
 297    left:=from;\r
 298    ll:=from;\r
 299    rr:=right;\r
 300    do\r
 301       if left>=rr\r
 302        then\r
 303          tab(ll):=T.take(right);\r
 304          right:=right+1;\r
 305        else\r
 306          if right>until\r
 307           then\r
 308             tab(ll):=T.take(left);\r
 309             left:=left+1;\r
 310           else\r
 311             if T.comp(left,right)<0\r
 312              then\r
 313                tab(ll):=T.take(left);\r
 314                left:=left+1;\r
 315              else\r
 316                tab(ll):=T.take(right);\r
 317                right:=right+1;\r
 318             fi;\r
 319          fi;\r
 320       fi;\r
 321       ll:=ll+1;\r
 322       if ll>until then exit; fi;\r
 323    od;\r
 324    left:=from;\r
 325    do\r
 326       call T.put_tab(left,tab(left));\r
 327       left:=left+1;\r
 328       if left>until then exit; fi;\r
 329    od;\r
 330    if not b\r
 331     then call father.sync;\r
 332     else\r
 333       call T.printchr(50,60,"MERGE - SORT" );\r
 334       call S.sunlock;\r
 335    fi;\r
 336 end PMS;\r
 337  \r
 338 unit PQS:P process;\r
 339  \r
 340    var counter:integer;\r
 341  \r
 342    unit shuffle:procedure;\r
 343       begin\r
 344       call T.light(from);\r
 345       left:=from+1;\r
 346       right:=until;\r
 347       do\r
 348          while T.comp(from,left) >=0 do\r
 349             call T.normal(left);\r
 350             left:=left+1;\r
 351             if left < right then call T.normal(left); fi;\r
 352             if left > right then exit; fi;\r
 353          od;\r
 354          while T.comp(from,right)<=0 do\r
 355             call T.normal(right);\r
 356             right:=right-1;\r
 357             if left < right then call T.normal(right); fi;\r
 358             if left > right then exit; fi;\r
 359          od;\r
 360          if left<right then\r
 361             call T.swap(left,right);\r
 362             call T.normal(left);\r
 363             call T.normal(right);\r
 364          fi;\r
 365          if left >= right then exit; fi;\r
 366       od;\r
 367       call T.swap(from,right);\r
 368    end shuffle;\r
 369  \r
 370    unit gen:procedure(from,until:integer; inout c:integer);\r
 371       begin\r
 372       if from < until\r
 373        then\r
 374          c:=c+1;\r
 375          if until-right > min\r
 376            then\r
 377             kolega:=new PQS(0,from,until,min,T,this PQS,false,S);\r
 378             resume(kolega);\r
 379            else\r
 380             bubble:=new BS(0,from,until,T,this PQS);\r
 381             resume(bubble);\r
 382          fi;\r
 383       fi;\r
 384    end gen;\r
 385  \r
 386    begin\r
 387    counter:=0;\r
 388    return;\r
 389    call shuffle;\r
 390    while imax(right-from,until-right) > min+1 do\r
 391       if until-right < right-from\r
 392        then\r
 393          call gen(right+1,until,counter);\r
 394          until:=right-1;\r
 395        else\r
 396          call gen(from,right-1,counter);\r
 397          from:=right+1;\r
 398       fi;\r
 399       call shuffle;\r
 400    od;\r
 401    call gen(right+1,until,counter);\r
 402    call gen(from,right-1,counter);\r
 403    while counter > 0 do\r
 404       accept sync;\r
 405       counter:=counter-1;\r
 406    od;\r
 407    if not b\r
 408     then call father.sync;\r
 409     else\r
 410       call T.printchr(50,60,"QUICK - SORT");\r
 411       call S.sunlock;\r
 412    fi;\r
 413 end PQS;\r
 414 (*--------------------------------------------------------------------*)\r
 415  \r
 416  \r
 417 var   E:ekran,T0,T1:A, S:sync, P1:PMS, P2:PQS,\r
 418       i,x,max,min:integer;\r
 419  \r
 420 begin\r
 421     call Initialization(max,min);\r
 422  \r
 423     E:=new ekran(0,600/max);\r
 424     resume(E);\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
 428     resume(T0);\r
 429     resume(T1);\r
 430  \r
 431     i:=1;\r
 432     while i <= max do\r
 433           x := random*150;\r
 434           call T0.put_tab(i,x);\r
 435           call T1.put_tab(i,x);\r
 436           i:=i+1;\r
 437     od;\r
 438  \r
 439      S:=new sync(0);\r
 440      resume(S);\r
 441  \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
 444      resume(P1);\r
 445      resume(P2);\r
 446      call S.slock;(* main wait for all other processes *)\r
 447      call S.slock;\r
 448  \r
 449      call E.printchr(450,325,"press CR"); readln;\r
 450      call E.groff;\r
 451      call endrun;\r
 452 end qsort.\r