procedure execute(prog:tree); #include "lazy.type.P" var evals, envcells, conscells :integer; { statistics } LastId :alfa; { debugging} processvalues :set of ValueClass; ChannelCntr :integer; Processes, OutputChan, OutputProc, InputChan, InputProc :Value; OutputMsg, InputMsg, OutputCont, InputCont :tree; SysEnv :Env; n :integer; procedure error( m:alfa ); begin writeln; writeln('Error: ', m, ' LastId=', LastId); goto 99 {error abort} end; #include "lazy.mkval.P" { Make various Values } function eval( x:tree; rho:Env ):Value; forward; procedure force( v:Value ); forward; #include "lazy.env.P" { manipulate Environment } #include "lazy.D.P" { Execute Declarations } #include "lazy.apply.P" { Apply a Function } #include "lazy.U.P" { Execute Unary Operators } #include "lazy.O.P" { Execute Binary Operators } #include "lazy.eval.P" { eval and force an Expression } #include "lazy.show.P" { Output Values } #include "pfl.interact.P" { Process Interaction } #include "pfl.count.P" { Count active processes } begin{execute} evals := 0; envcells := 0; conscells := 0; {zero counters} LastId := '-start- '; ChannelCntr := 0; processvalues := [inprocessval..stopprocessval]; OutputChan := mkchannel; new(OutputMsg); with OutputMsg^ do begin tag:=ident; id:='x ' end; new(OutputCont); with OutputCont^ do begin tag:=ident; id:='outputProc' end; OutputProc := mkprocess2(inprocessval{!},OutputChan,OutputMsg,OutputCont, nil); InputChan := mkchannel; new(InputMsg); InputMsg^.tag:=emptycon; new(InputCont); with InputCont^ do begin tag:=ident; id:='inputProc ' end; InputProc := mkprocess2(outprocessval{!},InputChan,InputMsg,InputCont, nil); SysEnv:=bind('output ', OutputChan, bind('outputProc', OutputProc, bind('input ', InputChan, bind('inputProc ', InputProc, bind('stop ', mkvalue(stopprocessval), nil))))); OutputProc^.pr:=SysEnv; InputProc^.pr:=SysEnv; Processes:=mkprocess1(paraprocessval, OutputProc, mkprocess1(paraprocessval, eval({user's}prog, SysEnv), InputProc)); while interact(Processes) do {the execution loop}; n:=count(Processes); writeln; write( n, ' processes left'); if n>2 then write(' (deadlock)'); writeln; write( evals, ' evals, '); write( envcells, ' env cells used, '); writeln( conscells, ' cells used') end{execute}; {\fB Shell of Interpreter for Parallel Functional Language. \fP} { Do not remove: This program is released under Gnu `copyleft' General } { Public Licence (GPL) -- L.Allison, CSSE, Monash Uni., .au, 7/2004 }