home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 5 / DATAFILE_PDCD5.iso / utilities / b / binprolog / !BinPro330 / progs / or < prev    next >
Encoding:
Text File  |  1994-01-31  |  4.9 KB  |  227 lines
  1. % TO BE PORTED to the Tcl/Tk environment
  2.  
  3. p:-compile('or.pl').
  4. % p:-[-po7ok]. % user can enter new processes on the fly
  5.  
  6. max(16,16).
  7.  
  8. :-op(600,xfx,<=).
  9. :-op(900,yfx,:).
  10.  
  11. % the process dies if it has no room for expansion
  12. % generous neighbours take care of it and its childs
  13. % it must pack itself and give its place
  14. % to its best (youngest,oldest,richest etc.) neighbour 
  15. % processes fight for a processor: the lighter process wins
  16.  
  17.  
  18. scr_clear:-max(L,_),Max is L+4,for(_,0,Max),nl,fail; true.
  19.  
  20. scr_send(p(L0,C0),Char):-
  21.   L is L0+1, C is C0+1,
  22.   put(27),
  23.   cwrite('['),cwrite(L),
  24.   cwrite(';'),cwrite(C),
  25.   cwrite('H'),
  26.   put(Char).
  27.  
  28. scr_rec(_):-fail.
  29.  
  30. dir_depl(0,p( 0, 1)).   % right -77
  31. dir_depl(1,p( 1, 0)).   % down -80
  32. dir_depl(2,p( 0,-1)).   % left -75
  33. dir_depl(3,p(-1, 0)).   % up -72
  34.  
  35. usr_dir(-77,0).
  36. usr_dir(-80,1).
  37. usr_dir(-75,2).
  38. usr_dir(-72,3).
  39. usr_dir(27,0):-scr_clear,abort.
  40.  
  41. next(Dir,p(L1,C1),p(L2,C2)):-
  42.     max(MaxL,MaxC),
  43.   dir_depl(Dir,p(DL,DC)),
  44.   L2 is L1+DL,C2 is C1+DC,
  45.   L2>=0,L2<MaxL,C2>=0,C2<MaxC.
  46.  
  47. move(Char,P1,P2):-
  48.         scr_send(P1,32),
  49.         scr_send(P2,Char).      
  50.  
  51. ranperm(Xs,Ps):-ranperm(Xs,Ps,_).
  52.  
  53. ranperm([],[],0):-!.
  54. ranperm([X|Xs],Zs,Max):-
  55.         ranperm(Xs,Ys,Max1),
  56.         Max is Max1+1,
  57.         random(Max,N),
  58.         ins(N,X,Ys,Zs).
  59.  
  60. ins(0,X,Ys,[X|Ys]):-!.
  61. ins(K,X,[Y|Ys],[Y|Zs]):-
  62.         K1 is K-1,
  63.         ins(K1,X,Ys,Zs).
  64.  
  65. random(Max,R):-
  66.     random(N),
  67.     R is N mod Max. 
  68.  
  69. randir(Dir):-ranperm([0,1,2,3],Perm),member(Dir,Perm).
  70.  
  71. super(P1,P2) -->
  72.         {scr_rec(C)},
  73.         serve(C,P1,P2),
  74.         !.
  75. super(P,P) --> [].
  76.  
  77. usr_depl(Dir,S,U1,U2):-
  78.         next(Dir,U1,U2),
  79.         free(U2,S),
  80.         !,
  81.         move(1,U1,U2).
  82.  
  83. serve(C,U1,U2,S,S):-            % move cursor
  84.         usr_dir(C,Dir),
  85.         !,
  86.         usr_depl(Dir,S,U1,U2).
  87. serve(13,U1,U2,S1,S3):-            % move process near cursor
  88.         usr_depl(_,S1,U1,U2),
  89.         deq(obj(N,P,Code),S1,S2),
  90.         move(N,P,U1),
  91.         !,
  92.         enq(obj(N,U1,Code),S2,S3).
  93.  
  94. serve(32,U1,U2,S1,S2):-            % start new process
  95.     usr_depl(_,S1,U1,U2),
  96.     scr_send(p(18,0),63),write('-- '),read(G),
  97.     [New]="0",
  98.     !,
  99.     enq(obj(New,U1,G<=G:[]),S1,S2),
  100.     scr_send(U1,New).
  101.  
  102. empty(0:_).
  103.  
  104. enq(X,K:Xs-[X|Qs],K1:Xs-Qs):-K1 is K+1.
  105.  
  106. deq(X,K1:[X|Ys]-Qs,K:Ys-Qs):-K1>0,K is K1-1.
  107.  
  108. sel(X) --> deq(X).
  109. sel(X) --> deq(Y),sel(X),enq(Y).
  110.  
  111. free(_,S):-empty(S),!.
  112. free(P,S1):-deq(obj(_,OtherP,_),S1,S2),P\==OtherP,!,
  113.         free(P,S2).
  114.      
  115. sked(_,_,[],S,S):-!.
  116. sked(N,P,[G|Gs],S1,S2):-
  117.         N1 is N+1,
  118.         enq(obj(N1,P,G:Gs),S1,S2),
  119.         scr_send(P,N1).
  120.  
  121. reduce(_,obj(N,P,Answer<=true:Gs)) --> !,    % broadcast answer
  122.     out(N,P,Answer),
  123.     sked(N,P,Gs).
  124. reduce(_,obj(N,P,A<=G1:[])) --> !,        % fork
  125.     { scr_send(P,32),
  126.         findall(A<=G2,G1<=G2,Gs)
  127.     },
  128.     sked(N,P,Gs).
  129. reduce(U,obj(N,P,G:[G1|Gs])) -->        % place its children
  130.     find_place(U,P,Q),!,
  131.     {scr_send(Q,N)},
  132.     enq(obj(N,P,G:Gs)),
  133.     enq(obj(N,Q,G1:[])).
  134. reduce(_,obj(N1,P1,G1:[G|Gs1])) -->        % fight for a processor
  135.     sel(obj(N2,P2,X2)),
  136.     { randir(Dir),
  137.       next(Dir,P1,P2),
  138.       compose_proc(obj(N1,P1,G1:[G|Gs1]),obj(N2,P2,X2),Winner,Looser)
  139.     },
  140.     !,
  141.     assimilate_proc(Winner,Looser).
  142.     
  143. compose_proc(    obj(N1,P1,G1:Gs1),obj(N2,P2,G2:Gs2),
  144.                             obj(N1,P1,G1:Gs1),obj(N2,P2,G2:Gs2)):-
  145.     length(Gs1,L1),length(Gs2,L2),
  146.     scr_send(p(20,0),62),
  147.     put(N1),put(58),write(L1),write( ' against '),
  148.     put(N2),put(58),write(L2),write('   '),
  149.     L1=<L2, % lightest is better
  150.     !.
  151. compose_proc(O1,O2,O2,O1).
  152.  
  153. assimilate_proc(obj(N1,P1,G1:Gs1),obj(N2,P2,G2:Gs2)) -->
  154.     { det_append(Gs1,[G2|Gs2],Gs3),
  155.       scr_send(P2,32)
  156.     },
  157.     !,
  158.     enq(obj(N1,P1,G1:Gs3)).
  159.  
  160. find_place(UserPos,OldP,NewP,S,S):-
  161.         randir(Dir),
  162.         next(Dir,OldP,NewP),
  163.         free(NewP,S),
  164.         NewP\==UserPos.
  165.  
  166. demo(U1,S1):- 
  167.         new_state(U1,U2,S1,S2),
  168.         !, 
  169.         demo(U2,S2).
  170.  
  171. new_state(U1,U2)-->
  172.      deq(O),
  173.    reduce(U1,O),
  174.    super(U1,U2).
  175.  
  176. solve(G):-
  177.   scr_clear,
  178.     max(MaxL,MaxC),
  179.     L is MaxL // 2,
  180.     C is MaxC // 2,
  181.     P=p(L,C),
  182.     [N]="0",
  183.     User=p(0,0),scr_send(User,1),
  184.   scr_send(P,N),
  185.   enq(obj(N,P,G<=G:[]),0:Q-Q,S1),
  186.     demo(User,S1).
  187.  
  188. out(N,P,X,S,S):-
  189.         scr_send(P,32),scr_send(p(21,0),N),write('=>'),write(X),nl,
  190.         S=(Len:_),write('active processes':Len),
  191.         statistics(global_stack,L),
  192.         write(-L).
  193.  
  194. % data
  195.  
  196. app([],A,A,B)<=B.
  197. app([C|D],E,[C|F],G)<=app(D,E,F,G).
  198.  
  199. nrev([],[],H)<=H.
  200. nrev([I|J],K,L)<=nrev(J,M,app(M,[I],K,L)).
  201.  
  202. perm([],[],N)<=N.
  203. perm([O|P],Q,R)<=perm(P,S,ins(O,S,Q,R)).
  204.  
  205. ins(T,U,[T|U],V)<=V.
  206. ins(W,[X|Y],[X|Z],X0)<=ins(W,Y,Z,X0).
  207.  
  208. rperm(X,W,Cont)<=nrev(X,Y,perm(Y,Z,nrev(Z,W,Cont))).
  209.     
  210. xperm(X,Y,Cont)<=rperm(Y,X,Cont).
  211.  
  212. i1:-G=xperm(R,S,true),solve(G).
  213. i2:-G=app(X,Y,Z,true),solve(G).
  214.  
  215. go:-write('use bp -h3000'),nl,
  216.     L=[1,2,3,4,5],G=rperm(L,R,true), solve(G).
  217.  
  218. bad:-G=rperm(L,R,true), solve(G).
  219.  
  220. bm:-G=nrev([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18],X,true), 
  221.      time((solve(G)),T),L is (19*20*1000)//(2*T),pp(time:T+lips:L).
  222. bp:-G=perm([1,2,3,4,5 ],R,true),
  223.         time(solve(G),T),pp(perm:T).
  224.  
  225. time(G,_):-statistics(runtime,_),G,fail.
  226. time(_,T):-statistics(runtime,[_,T]).
  227.