BLOCK (*****************************************************************************) (********************************** F I F O **********************************) (*****************************************************************************) unit FIFO : class ( type T); var HEAD,LAST : ELEM; unit ELEM : class ( INFO : T); var NEXT : ELEM; begin end ELEM; unit EMPTY : function : boolean; begin result := (HEAD=NONE) end unit INTO : procedure ( INFO : T ); begin if EMPTY then HEAD := new ELEM(INFO); LAST := HEAD else LAST.NEXT := new ELEM(INFO); LAST := LAST.NEXT (* fi *) end INTO; unit FIRST : function : T; begin result.a := HEAD.INFO (*!!!!!!!!*) end FIRST; unit OUT_FIRST : procedure; var HLP : ELEM; begin if not EMPTY then HLP := HEAD; HEAD := HEAD.NEXT fi end OUT_FIRST; unit CARDINAL : function : integer; var HLP : ELEM; begin HLP := HEAD; while HLP <> NONE do result :=result + 1; HLP := HLP.NEXT od end CARDINAL; end FIFO; (*****************************************************************************) (************************** E N D F I F O *******************************) (*****************************************************************************) (* * * * * * * * *) (*****************************************************************************) (************************* S I M U L A T I O N *******************************) (*****************************************************************************) UNIT PRIORITYQUEUE: IIUWGRAPH CLASS; UNIT QUEUEHEAD: CLASS; (* HEAP ACCESING MODULE *) VAR LAST,ROOT:NODE; UNIT MIN: FUNCTION: ELEM; BEGIN IF ROOT=/= NONE THEN RESULT:=ROOT.EL FI; END MIN; UNIT INSERT: PROCEDURE(R:ELEM); (* INSERTION INTO HEAP *) VAR X,Z:NODE; BEGIN X:= R.LAB; IF LAST=NONE THEN ROOT:=X; (* root,right usunieto*) ROOT.LEFT,LAST:=ROOT ELSE IF LAST.NS=0 THEN LAST.NS:=1; Z:=LAST.LEFT; LAST.LEFT:=X; X.UP:=LAST; X.LEFT:=Z; Z.RIGHT:=X; ELSE LAST.NS:=2; Z:=LAST.RIGHT; LAST.RIGHT:=X; X.RIGHT:=Z; X.UP:=LAST; Z.LEFT:=X; LAST.LEFT.RIGHT:=X; X.LEFT:=LAST.LEFT; LAST:=Z; FI FI; CALL CORRECT(R,FALSE) END INSERT; UNIT DELETE: PROCEDURE(R: ELEM); VAR X,Y,Z:NODE; BEGIN X:=R.LAB; Z:=LAST.LEFT; IF LAST.NS =0 THEN Y:= Z.UP; if y<>none then Y.RIGHT:= LAST else root :=none fi; (**10-93***) LAST.LEFT:=Y; LAST:=Y; ELSE Y:= Z.LEFT; Y.RIGHT:= LAST; LAST.LEFT:= Y; FI; Z.EL.LAB:=X; X.EL:= Z.EL; LAST.NS:= LAST.NS-1; R.LAB:=Z; Z.EL:=R; (**** poprawka 10-93 ******) z.left.right := none; z.ns := 0; z.left, z.right, z.up := none; IF X.LESS(X.UP) THEN CALL CORRECT(X.EL,FALSE) ELSE CALL CORRECT(X.EL,TRUE) FI; END DELETE; UNIT CORRECT: PROCEDURE(R:ELEM,DOWN:BOOLEAN); (* CORRECTION OF THE HEAP WITH STRUCTURE BROKEN BY R *) VAR X,Z:NODE,T:ELEM,FIN,LOG:BOOLEAN; BEGIN Z:=R.LAB; IF DOWN THEN WHILE NOT FIN DO IF Z.NS =0 THEN FIN:=TRUE ELSE IF Z.NS=1 THEN X:=Z.LEFT ELSE IF Z.LEFT.LESS(Z.RIGHT) THEN X:=Z.LEFT ELSE X:=Z.RIGHT FI; FI; IF Z.LESS(X) THEN FIN:=TRUE ELSE T:=X.EL; X.EL:=Z.EL; Z.EL:=T; Z.EL.LAB:=Z; X.EL.LAB:=X FI; FI; Z:=X; OD ELSE X:=Z.UP; IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z); FI; WHILE NOT LOG DO T:=Z.EL; Z.EL:=X.EL; X.EL:=T; X.EL.LAB:=X; Z.EL.LAB:=Z; Z:=X; X:=Z.UP; IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z); FI; OD FI; END CORRECT; END QUEUEHEAD; UNIT NODE: CLASS (EL:ELEM); (* ELEMENT OF THE HEAP *) VAR LEFT,RIGHT,UP: NODE, NS:INTEGER; UNIT LESS: FUNCTION(X:NODE): BOOLEAN; BEGIN IF X= NONE THEN RESULT:=FALSE ELSE RESULT:=EL.LESS(X.EL) FI; END LESS; END NODE; UNIT ELEM: CLASS(PRIOR:REAL); (* PREFIX OF INFORMATION TO BE STORED IN NODE *) VAR LAB: NODE; UNIT VIRTUAL LESS: FUNCTION(X:ELEM):BOOLEAN; BEGIN IF X=NONE THEN RESULT:= FALSE ELSE RESULT:= PRIOR< X.PRIOR FI; END LESS; BEGIN LAB:= NEW NODE(THIS ELEM); END ELEM; END PRIORITYQUEUE; UNIT SIMULATION: PRIORITYQUEUE CLASS; (* THE LANGUAGE FOR SIMULATION PURPOSES *) (**** poprawka 10-93 *********) hidden Mmainpr, curr, pq; VAR CURR: SIMPROCESS, (*ACTIVE PROCESS *) PQ:QUEUEHEAD, (* THE TIME AXIS *) MAINPR: MAINPROGRAM; unit SIMPROCESS: COROUTINE; (* USER PROCESS PREFIX *) (***** poprawka 10-93 **********) hidden event, eventaux, finish; VAR EVENT, (* ACTIVATION MOMENT NOTICE *) EVENTAUX: EVENTNOTICE, (* THIS IS FOR AVOIDING MANY NEW CALLS AS AN RESULT OF *) (* SUBSEQUENT PASSIVATIONS AND ACTIVATIONS *) FINISH: BOOLEAN; UNIT IDLE: FUNCTION: BOOLEAN; BEGIN RESULT:= EVENT= NONE; END IDLE; UNIT TERMINATED: FUNCTION :BOOLEAN; BEGIN RESULT:= FINISH; END TERMINATED; UNIT EVTIME: FUNCTION: REAL; (* TIME OF ACTIVATION *) BEGIN IF IDLE THEN raise ERROR1; FI; RESULT:= EVENT.EVENTTIME; END EVTIME; handlers when ERROR1 : WRITELN(" AN ATTEMPT TO ACTIVATE AN IDLE PROCESS TIME"); attach(main); when ERROR2 : WRITELN(" AN ATTEMPT TO ACTIVATE A TERMINATED PROCESS TIME"); attach(MAIN); end handlers; BEGIN RETURN; INNER; FINISH:=TRUE; CALL PASSIVATE; raise ERROR2; END SIMPROCESS; UNIT EVENTNOTICE: ELEM CLASS; (* A PROCESS ACTIVATION NOTICE TO BE PLACED ONTO THE TIME AXIS PQ *) VAR EVENTTIME: REAL, PROC: SIMPROCESS; UNIT VIRTUAL LESS: FUNCTION(X: EVENTNOTICE):BOOLEAN; (* OVERWRITE THE FORMER VERSION CONSIDERING EVENTTIME *) BEGIN IF X=NONE THEN RESULT:= FALSE ELSE RESULT:= EVENTTIME< X.EVENTTIME OR (EVENTTIME=X.EVENTTIME AND PRIOR<= X.PRIOR); FI; END LESS; END EVENTNOTICE; UNIT MAINPROGRAM: SIMPROCESS CLASS; (* IMPLEMENTING MASTER PROGRAM AS A PROCESS *) BEGIN DO ATTACH(MAIN) OD; END MAINPROGRAM; UNIT TIME:FUNCTION:REAL; (* CURRENT VALUE OF SIMULATION TIME *) BEGIN RESULT:=CURRENT.EVTIME END TIME; UNIT CURRENT: FUNCTION: SIMPROCESS; (* THE FIRST PROCESS ON THE TIME AXIS *) BEGIN RESULT:=CURR; END CURRENT; UNIT SCHEDULE: PROCEDURE(P:SIMPROCESS,T:REAL); (* ACTIVATION OF PROCESS P AT TIME T AND DEFINITION OF "PRIOR"- PRIORITY *) (* WITHIN TIME MOMENT T *) BEGIN (*** poprawka 10-93 *****) if p.terminated then raise ERROR2 fi; IF T