examples/pataud/proc2.log

   1  \r
   2  program processus4;\r
   3  \r
   4 (* czytelnicy pisarze *)\r
   5    unit elem : class;\r
   6    var ile , nr : integer,qui:pi;\r
   7    (*nr procesu ktory zostawil informacje lub ostatni FreePl w buforze*)\r
   8    end elem;\r
   9  \r
  10    unit ecran :IIUWGRAPH process(node:integer);\r
  11  \r
  12       unit outtext : procedure(x,y:integer, s:string);\r
  13       var A: arrayof char, i: integer;\r
  14       begin\r
  15           call move(x,y);\r
  16           call color(14);   (* yellow *)\r
  17           A := unpack(s);\r
  18           for i := lower(A) to upper(A) do\r
  19                           (*  call HASCII(0);  *)\r
  20              call HASCII(ord(A(i)));\r
  21           od;\r
  22       end outtext;\r
  23       \r
  24       unit outmessage: procedure(x,y:integer, s: string);\r
  25          var A: arrayof char, i: integer;\r
  26       begin\r
  27         call move(x,y);\r
  28         call color(12);  (* rouge clair *)\r
  29         A := unpack(s);\r
  30         for i := lower(A) to upper(A) do\r
  31            call HASCII(ord(A(i)))\r
  32         od\r
  33       end outmessage;\r
  34 \r
  35       unit circle: procedure(col,x,y,r : integer);\r
  36          var i: integer;\r
  37       begin\r
  38            call color(col);\r
  39            call rectangle(x,y,r,r);  \r
  40            for i := 1 to r-1 do\r
  41               call line(col,x,y+i,r,true)\r
  42            od\r
  43       end circle;\r
  44  \r
  45       unit line : procedure(col,x,y,dlugosc:integer,poziomo:boolean);\r
  46       begin\r
  47            call color(col);\r
  48            call move(x,y); (* pozycja linii *)\r
  49            if poziomo\r
  50            then\r
  51               call draw(x+dlugosc,y);\r
  52            else (* linia pionowa *)\r
  53               call draw(x, y+dlugosc);\r
  54            fi;\r
  55       end line;\r
  56  \r
  57  \r
  58       unit Fin:procedure;\r
  59       begin\r
  60          call GrOFF; call endRun\r
  61       end fin;\r
  62  \r
  63       unit pisarz: procedure(nr:integer);\r
  64       begin\r
  65           call color(2*nr+1);\r
  66           call circle(2*nr+1,(nr-1)*150+20,8,10);\r
  67         (*  call rectangle((nr-1)*150+20,10,10,10);*)  \r
  68           call rectangle((Nr-1)*150+10,20,80,200);\r
  69       end pisarz;\r
  70  \r
  71       unit rectangle:procedure(x,y,dl,wys:integer);\r
  72       var i: integer;\r
  73       begin\r
  74           call move(x,y);\r
  75           call draw(x+dl,y);\r
  76           call draw(x+dl,y+wys);\r
  77           call draw(x,y+wys);\r
  78           call draw(x,y);\r
  79       end rectangle;\r
  80  \r
  81       unit magazyn : procedure;\r
  82       begin\r
  83           call color(1);\r
  84           call rectangle(10,250,600,50);\r
  85       end magazyn;\r
  86    begin\r
  87        call gron(1);\r
  88        return;\r
  89        enable magazyn,pisarz;\r
  90        do\r
  91             accept  Fin, line, circle, outtext, outmessage\r
  92        od;\r
  93  \r
  94    end ecran;\r
  95  \r
  96    unit pi : elem process(node,nr : integer, M : monitor,ek:ecran);\r
  97    (*  nr jest numerem pisarza *)\r
  98    const stala=62;(* dludosc linii rysowanej przez pisarza *)\r
  99    var posX, posY:integer; (* pozycja pisarza na ekranie *)\r
 100  \r
 101    unit tempo : procedure(n:integer);\r
 102    var i : integer;\r
 103    begin\r
 104        for i :=1 to n do i:=i od\r
 105    end tempo;\r
 106  \r
 107  \r
 108    unit wezwij_put : procedure(e:elem);\r
 109    var czekaj : boolean;\r
 110    begin\r
 111          (* najpierw wymazuje z obszaru pisarza *)\r
 112          call ek.outtext((nr-1)*150+20,200,"sends   ");\r
 113          for i := 1 to e.ile\r
 114          do\r
 115              call ek.line(0,(nr-1)*150+22,32+i,stala, true);\r
 116              call tempo(200);\r
 117          od;\r
 118          call ek.outtext((nr-1)*150+20,200,"waiting ");\r
 119          do\r
 120             call M.putt(e.nr, e.qui, e.ile, czekaj);\r
 121             if czekaj \r
 122             then\r
 123                call ek.outmessage((nr-1)*150+20,180,"stopped"); \r
 124                stop \r
 125             else \r
 126                exit \r
 127             fi;\r
 128          od;\r
 129     end wezwij_put;\r
 130  \r
 131     unit wezwij_get : procedure(inout e:elem);\r
 132        var czekaj : boolean, qui:pi,n,ch:integer ;\r
 133     begin\r
 134  \r
 135        do\r
 136            n := e.nr; qui := e.qui;\r
 137            call m.gett(n,qui,ch, czekaj);\r
 138            if czekaj then \r
 139              call ek.outmessage((nr-1)*150+20,180,"stopped");\r
 140              stop\r
 141            else\r
 142                e:=new elem; e.nr :=n;\r
 143                e.qui:=qui; e.ile :=ch;\r
 144                call ek.outtext((nr-1)*150+20,200,"receives");\r
 145                for i := 1 to ch\r
 146                do\r
 147                   call ek.line(2*n+1,(nr-1)*150+22,32+i,stala,true);\r
 148                   call tempo(200);\r
 149                od;\r
 150                call ek.outtext((nr-1)*150+20,200, "        ");\r
 151 (*           otrzymalem wiadomosc od pisarza nr        *)\r
 152                exit\r
 153            fi;\r
 154        od;\r
 155     end wezwij_get;\r
 156  \r
 157     unit fin : procedure;\r
 158     end;\r
 159  \r
 160 var el: elem, r : real;\r
 161 begin\r
 162    call ek.pisarz(nr);\r
 163    call ek.outtext((nr-1)*150+36,8,"Actor");\r
 164    return;\r
 165    do\r
 166        r := random*100;\r
 167        if r=0 then accept fin; exit fi;\r
 168        (* to niezbt dobre rozwiazanie ze wzgl na kolejnosc *)\r
 169        if r<50 then\r
 170             (*  pisarz cos produkuje i chce to wyslac *)\r
 171             el := new elem;\r
 172             el.qui := this pi;\r
 173             el.nr := nr;\r
 174             el.ile := random*175;\r
 175             call ek.outtext((nr-1)*150+20,200,"writes  ");\r
 176             for i := 1 to el.ile\r
 177             do\r
 178                call ek.line(2*nr+1,(nr-1)*150+22,26+i,stala,true);\r
 179                call tempo(250);\r
 180             od;\r
 181             call ek.outtext((nr-1)*150+20,200,"        ");\r
 182             call tempo(400);\r
 183             call wezwij_put(el)\r
 184        else\r
 185            (* pisarz zdecydowal sie cos przeczytac  *)\r
 186              el := new elem;\r
 187              el.nr := nr; el.qui := this pi;\r
 188             call ek.outtext((nr-1)*150+20,200,"demands ");\r
 189             call wezwij_get(el);\r
 190             call ek.outtext((nr-1)*150+20,200,"        ");\r
 191             call tempo(500);\r
 192             call ek.outtext((nr-1)*150+20,200,"reads   ");\r
 193             (* czytam przesylke *)\r
 194             for i := el.ile downto 1\r
 195             do\r
 196                call ek.line(0,(nr-1)*150+22,26+i,stala,true);\r
 197                call tempo(250);\r
 198             od;\r
 199              call ek.outtext((nr-1)*150+20,200,"        ");\r
 200  \r
 201        fi;\r
 202     od;\r
 203 end pi;\r
 204  \r
 205 unit monitor : elem  process(node,size,max_proc : integer, ek:ecran);\r
 206 const posX = 30,\r
 207       posY = 250;\r
 208    unit Belem : class(e:elem,posx:integer);\r
 209    end Belem;\r
 210  \r
 211 var buffer : arrayof Belem,\r
 212    queue_pour_lire,\r
 213    queue_pour_ecrire: queue,\r
 214    Qpos:integer,\r
 215    counter, ilosc_ak, i,x, nb_proc: integer;\r
 216    (* zmienna counter mowi ile jest elementow w buforze *)\r
 217    (* ilosc_ak = ilosc miejsca w magazynie juz wykorzystana*)\r
 218    (* nb_proc  = ilosc procesow stojacuch w obu kolejkach *)\r
 219  \r
 220    unit qEl: class;\r
 221     var  qui : pi, next : qEL;\r
 222    end qEL;\r
 223  \r
 224    unit queue: class(pos:integer);\r
 225    var first, last : qEL;\r
 226  \r
 227       unit into : procedure(p: pi,nr: integer (* nr is the no of pi*));\r
 228       var aux : qEL, c:integer;\r
 229       begin\r
 230  \r
 231            call ek.circle(2*nr+1,pos+30,339,10);\r
 232            pos := pos+30;\r
 233            (* rysowanie kolka w odpowiedniej kolejce i odp.kolorem*)\r
 234            nb_proc := nb_proc+1;\r
 235            aux := new qEL;\r
 236            aux .qui :=p;\r
 237            aux . next := none;\r
 238            if first=none then\r
 239                 first := aux; last := aux\r
 240            else\r
 241               last.next := aux;\r
 242               last := aux;\r
 243            fi;\r
 244       end into;\r
 245  \r
 246       unit out : function : pi;\r
 247       begin\r
 248           if first=none then exit else\r
 249              nb_proc := nb_proc -1;\r
 250              call ek.circle(0,pos,339,10);\r
 251              pos :=pos-30;\r
 252              (* wymazanie kolka w odpowiedniej kolejce *)\r
 253              result := first.qui;\r
 254              first := first.next;\r
 255           fi;\r
 256       end out;\r
 257  \r
 258       unit empty : function: boolean;\r
 259       begin\r
 260           result :=  (first=none) ;\r
 261       end empty;\r
 262    end queue;\r
 263  \r
 264    unit tempo : procedure(n:integer);\r
 265    var j,x:integer;\r
 266    begin\r
 267         for j := 1 to n do x:=x od;\r
 268    end tempo;\r
 269  \r
 270    unit putt : procedure(n:integer,qui:pi,ch:integer; output czekaj : boolean);\r
 271    var  aux, i : integer,e : elem;\r
 272    begin\r
 273  \r
 274          if (counter< 20 and ilosc_ak+ch<size)\r
 275          then\r
 276                 e := new elem;\r
 277                 e.nr :=n;\r
 278                 e.ile := ch;\r
 279                 e.qui := qui;\r
 280                 counter := counter +1;\r
 281                 buffer(counter) := new Belem(e,x);\r
 282  \r
 283     (*         monitor zapisuje przesylke od        *)\r
 284                 for i :=1 to ch do\r
 285                       call ek.line(2*n+1,x+i,posY+7,39,false);\r
 286                       call tempo(300);\r
 287                 od;\r
 288                 x := x+ ch;\r
 289                 ilosc_ak := ilosc_ak+ch;\r
 290                 czekaj := false;\r
 291                 if not queue_pour_lire.empty\r
 292                 then\r
 293 (*                monitor budzi pisarza z kolejki czytelnikow  *)\r
 294                     p := queue_pour_lire.out;\r
 295                     call ek.outtext((nr-1)*150,180,"       ");\r
 296                     resume(p);\r
 297                  fi;\r
 298             else\r
 299 (*               nie ma miejsca w buforze dla pisarza      *)\r
 300                  czekaj := true;\r
 301                  call queue_pour_ecrire.into(qui,n);\r
 302  \r
 303             fi;\r
 304       end putt;\r
 305  \r
 306       unit gett:procedure(inout nr:integer, qui:pi, ch:integer, czekaj:boolean);\r
 307       var i ,j : integer, e:elem , p:pi;\r
 308       begin\r
 309          p := qui;\r
 310          if counter<> 0  then (* mozna cos zabrac z magazynu *)\r
 311                 e := buffer(counter).e;\r
 312                 nr := e.nr; qui := e.qui; ch := e.ile;\r
 313                 counter := counter - 1;\r
 314                 czekaj := false;\r
 315                 for i := x downto x-ch\r
 316                 do\r
 317                    call ek.line(0,i,posY+7,39,false);\r
 318                    call tempo(200);\r
 319  \r
 320                 od;\r
 321                 x := x-ch;\r
 322                 ilosc_ak := ilosc_ak-ch;\r
 323                 (* w magazynie zwolnilo sie miejsce i ktos moze wpisac *)\r
 324  \r
 325                 if not queue_pour_ecrire.empty\r
 326                 then\r
 327        (*           writeln("M budzi pisarza ktory chce pisac ");*)\r
 328                     p := queue_pour_ecrire.out;\r
 329                     call ek.outtext((nr-1)*150,180,"       ");\r
 330                     resume(p);\r
 331                  fi;\r
 332             else (*jezeli counter=0 tzn. nic nie ma w magazynie *)\r
 333 (*                 writeln("M wpisuje pisarza",nr,"do kolejki czytelnikow");*)\r
 334                  czekaj := true;\r
 335                  qui := p;(* to jest instrukcja niepotrzebna *)\r
 336                  call queue_pour_lire.into(p,nr);\r
 337             fi;\r
 338       end gett;\r
 339  \r
 340 begin  (*   tu sie zaczyna tresc monitora *)\r
 341  \r
 342      array buffer dim(1:20);\r
 343  \r
 344      counter := 0;\r
 345      x := 12; ilosc_ak := 0;\r
 346      Qpos := posX;\r
 347      queue_pour_lire := new queue(Qpos);\r
 348      queue_pour_ecrire := new queue(Qpos+300);\r
 349      call ek.magazyn;\r
 350      call ek.outtext(posX,posY-6,"BUFFER");\r
 351      call ek.outtext(posX,posY+60,"READERS' QUEUE");\r
 352      call ek.outtext(posX+ 300, posY+60,"WRITERS'QUEUE");\r
 353      return;\r
 354      do\r
 355           accept putt, gett;\r
 356           if nb_proc = max_proc\r
 357           then\r
 358               call ek.outmessage(470,339,"DEADLOCK! press CR");\r
 359               readln;\r
 360               call ek.fin;\r
 361            fi;\r
 362      od;\r
 363 end monitor;\r
 364  \r
 365  \r
 366  (*  M A I N *)    \r
 367 \r
 368 var PROC : arrayof pi,p,P1,P2,P3 : pi,\r
 369     M : monitor,\r
 370     EK : ecran,\r
 371     i, NbProc : integer;\r
 372  \r
 373 begin  \r
 374  \r
 375      write("NbProc : ");\r
 376      readln(NbProc);\r
 377      array Proc dim(1:NbProc);\r
 378  \r
 379      ek := new ecran(0);\r
 380      resume(ek);\r
 381      M := new monitor(0,550,NbProc,ek);\r
 382      resume(M);\r
 383      for i := 1 to NbProc\r
 384      do\r
 385            P := new pi(0,i,M,ek);\r
 386            Proc(i) := P;\r
 387      od;\r
 388  \r
 389  \r
 390        call  ek.outmessage(550,320,"press CR");\r
 391        readln;\r
 392        call  ek.outtext(550,320,"        ");\r
 393  \r
 394         for i :=1 to NbProc\r
 395         do   p := Proc(i);\r
 396              resume(p);\r
 397         od;\r
 398  \r
 399  \r
 400 end processus4;\r