Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/rts/su.mac
There is 1 other file named su.mac in the archive. Click here to see a list.
; AUTHORS:	LARS ENDERIN, KIM WALDEN
; VERSION:	1
	SEARCH	SIMMAC,SIMMCR,SIMRPA
	SALL
	RTITLE	SU
	ERRMAC	SU
	MACINIT
	SUBTTL	SIMULATION


;	Module SU (CLASS SIMULATION)
;	============================

;	The SU module is concerned with  attributes  of  the  SIMULATION
;	class.

;	The following is contained in the SU module:
;	-------------------------------------------

intern	.SUAC 	; Activation statement.
intern	.SUAM 	; Accum.
intern	.SUCA 	; Cancel.
intern	.SUEV 	; Evtime.
intern	.SUHO 	; Hold.
intern	.SUMA 	; Prototype of Main Program.
intern	.SUNE 	; Nextev.
intern	.SUPA 	; Passivate.
intern	.SUPS	; Prototype of PROCESS
ENTRY	.SUSI 	; Prototype of SIMULATION class.
intern	.SUWA 	; Wait.

;	Subroutines internal to SU
;	--------------------------
;	SUPC 	; Precede.
;	SURM 	; Remove.
;	SURN 	; Rank a time.
;	SUSC 	; Succede.
;	SUSU 	; Successor.
;	SUUT 	; Utility routine: follow one link right, go down left.

; The following attributes are implemented inline:
;
; Current, Idle, Main, Terminated, Time.

	EXTERN	.SANE	;New event notice
	extern	.sshd	;[151] prototype of head
	EXTERn	.SSLK	;[151] prototype of link
; The SIMULATION class may only exist on one display  level  in  a
; SIMULA  program.   That  level is given by the right half of the
; global variable YSULEV(XLOW).   In  fact,  YSULEV  contains  the
; instruction:
;	MOVE	XSAC,simulation block offset in display(XCB)
; which can be executed to load XSAC  with  the  simulation  block
; address.    The  procedures  in  the  SU  module  implement  the
; sequencing set (SQS) as a binary tree of event  notices  ordered
; by evtime (ZEVTIM) values.  The root of the tree is ZSULT of the
; SIMULATION block.
;
; Coding conventions
; ------------------
; Several  algorithms  are  given  in   SIMULA   notation.    When
; translating  the  algorithms,  one  should  be  faithful  to the
; original notation, with obvious exceptions.  Registers  used  to
; represent  local or global variables and parameters should begin
; with X or XX, i e translate Y to X.  In the case of internal run
; time  pointers,  such  as  pointers  to  eventnotices,  NONE  is
; represented as zero.
;
; Register usage
;
; X0 contains the activation mask for .SUAC, may otherwise be used
; without  restoring.  XLOW=XIAC should always be used to point to
; the low segment static area.  XSAC  is  made  to  point  to  the
; simulation  block  by executing the instruction at YSULEV(XLOW).
; XTAC is used to define the top register  for  functions  (.SUEV,
; .SUNE)  called  from  compiled code and to return an eventnotice
; pointer.  XWAC1 and XWAC2 etc contain parameters  to  procedures
; which are not functions.  In those procedures, any work ac XWACi
; may be used without restoring.  The outputs of .SURN, YZEVF  and
; YZEVL, are mapped on the registers XZEVF=XWAC7, XZEVL=XWAC10.
	SUBTTL	LOCAL MACROS AND OPDEF'S

	DEFINE	PCALLDEF(P,A,R,OP)<
	DEFINE P(B)<
	IFNB <B>,<IFDIF <A>,<B>,<L	A,B>>
	IFB <OP>,<EXEC	R>
	IFNB <OP>,<OP	R>
	>>

PCALLDEF(PRECEDE,XWAC1,SUPC)
PCALLDEF(REMOVE,XSAC,SURM)
PCALLDEF(RESUME,XWAC1,SURS,JSP)
PCALLDEF(RANK,XWAC1,SURN)
PCALLDEF(SUCCESSOR,XWAC1,SUSU)
PCALLDEF(NEWNOTICE,XSAC,.SANE)
PCALLDEF(SUCCEDE,XWAC1,SUSC)

OPDEF	DETACH	[PUSHJ	XPDP,CPDT]
OPDEF	INNER	[JSP	CPCI]
	SUBTTL	.SUAC	(ACTIVATION)

; Purpose
; -------
; To implement the activation statements of SIMULATION:
; -         -                    -                          -
; ACTIVATE   ;                  ; (AT/DELAY) time [PRIOR]    ;
;            ;     process-1    ;                            ;
; REACTIVATE ;                  ; (BEFORE/AFTER)   process-2 ;
; -	     -		        -			     -
;
; Input
; -----
; Reference to   process-1 in XWAC1.  If BEFORE/AFTER,   process-2
; reference  in XWAC2 .  If AT clause, value of time in XWAC2.  If
; DELAY clause, time increment in  XWAC2.   Times  are  in  single
; precision  floating  point.   The statement type is encoded in a
; bit mask passed in X0.  The bits are interpreted as follows:
	AFTER=   04
	AT=      10
	BEFORE=  02
	DELAY=   20
	PRIOR=   40
	RE=      01  ;(REACTIVATE, not ACTIVATE)
;
; Function
; --------
; If   process-1 is already scheduled (i e has an  eventnotice  in
; the   SQS)   and  X0  does  not  specify  reactivation,  return.
; Otherwise insert eventnotice for new scheduling, remove the  old
; eventnotice, and resume current.
;
; Algorithm
; ---------
; The  algorithm  is  given  below  in  SIMULA  notation.   YYDIRE
; corresponds to code 0 or 1, i e no special clause.
;	PROCEDURE
;	suac    (yyzps,yyzpsr,yytime,yydire,yyat,yydely,yybefo,yyafte,
;		yyprio,yyreac);
;		REF(zps)yyzps,  ! activated process;
;			yyzpsr; ! reference process;
;		REAL    yytime; ! after DELAY/AT;
;		BOOLEAN yydire, ! direct activation;
;			yyat  , ! AT clause, yyzpsr not used;
;			yydely, ! DELAY, yyzpsr not used;
;			yybefo, ! BEFORE, yytime not used;
;			yyafte, ! AFTER, yytime not used;
;			yyprio, ! PRIOR in AT or DELAY clause;
;			yyreac; ! RE-activation;
;	BEGIN	! See CB 14.2.4.1, CAP p 212;
;		REF(zev)yzev; REF(zps)yzps;
;		INSPECT yyzps WHEN zps DO
;		IF zpszev == NONE OR yyreac THEN
;		BEGIN
;			yzps:-zsuft.zevzps;	!current;
;			IF yyat OR yydely THEN
;			BEGIN	IF yyat THEN
;				BEGIN	IF yytime < zsuft.zevtim
;					THEN yytime:=zsuft.zevtim
;				END	ELSE
;				yytime:=max(0,yytime)+zsuft.zevtim;
;				surn(yytime); ! rank the notice;
;				IF yyprio THEN
;				yzev:- supc(yzevf) ELSE
;				yzev:- susc(yzevl);
;				yzev.zevtim:=yytime;
;			END	ELSE
;			IF NOT yydire THEN
;			BEGIN	IF yyzpsr=/=NONE AND 
;				yyzpsr.zpszev=/=NONE THEN
;				BEGIN	IF yybefo THEN
;					yzev :- supc(yyzpsr.zpszev)
;					ELSE
;					yzev :- susc(yyzpsr.zpszev);
;					yzev.zevtim :=
;					yyzpsr.zpszev.zevtim;
;				END	ELSE GOTO out;
;			END	ELSE
;			BEGIN	! direct activation;
;				yzev :- supc(zsuft);
;				yzev.zevtim := zsuft.zevzbl.zevtim;
;			END;
;			IF yyreac AND zpszev =/= NONE THEN surm(zpszev);
;			yzev.zevzps :- THIS zps;
;			zpszev :- yzev;
;			IF yzps=/=zsuft.zevzps THEN
;			cprs(zsuft.zevzps); ! resume(current);
;	out:	END;
;	END suac;
XXTIME=XWAC2
XXZPSR=XWAC2
XZSUFT=XWAC3
XFTIME=XWAC4
XZEVF=XWAC7
XZEVR=XWAC7
XZEVL=XWAC10
XZEVRT=XWAC10

.SUAC:	PROC
	LOWADR
	CFORBID
	XCT	YSULEV(XLOW)
	IF	CAIN	XWAC1,NONE
		GOTO	FALSE
	THEN
		LF	XZSUFT,ZSUFT(XSAC)
		LF	XSAC,ZEVZPS(XZSUFT)
		ST	XSAC,YSUPFT(XLOW)
		LF	XSAC,ZPSZEV(XWAC1)
		IF	;suspended or REACTIVATE
			JUMPE	XSAC,TRUE
			TRNN	RE
			GOTO	FALSE
		THEN
			LF	XFTIME,ZEVTIM(XZSUFT)
			ST	XWAC1,YSUPAC(XLOW)
			IF	TRNN	AT+DELAY
				GOTO	FALSE
			THEN	;AT or DELAY specified
				IF	TRNN	AT
					GOTO	FALSE
				THEN	;AT specified
					CAMG	XXTIME,XFTIME
					L	XXTIME,XFTIME
				ELSE	;DELAY specified
					SKIPG	XXTIME
					SKIPA	XXTIME,XFTIME
					FADR	XXTIME,XFTIME
				FI
				RANK(XXTIME)
				IF	TRNN	PRIOR
					GOTO	FALSE
				THEN	;PRIOR specified
					PRECEDE(XZEVF)
				ELSE	;PRIOR not specified
					SUCCEDE(XZEVL)
				FI
				SF	XXTIME,ZEVTIM(XTAC)
			ELSE	;neither AT nor DELAY was specified
				IF	TRNN	AFTER+BEFORE
					GOTO	FALSE
				THEN	;AFTER or BEFORE was specified
					IF	CAIN	XXZPSR,NONE
						GOTO	FALSE
						LF	XWAC1,ZPSZEV(XXZPSR)
						JUMPE	XWAC1,FALSE
					THEN	;ref process has event notice
						IF	TRNN	BEFORE
							GOTO	FALSE
						THEN	;BEFORE specified
							PRECEDE(XWAC1)
						ELSE	;AFTER specified
							SUCCEDE(XWAC1)
						FI
						LF	XZEVRT,ZEVTIM(XWAC1)
						SF	XZEVRT,ZEVTIM(XTAC)
					ELSE
						SETZM	YSUPFT(XLOW)
						GOTO	SUACX
					FI
				ELSE	;direct activation
					PRECEDE(XZSUFT)
					SF	XFTIME,ZEVTIM(XTAC)
				FI
			FI
			L	XWAC1,YSUPAC(XLOW)
			SETZM	YSUPAC(XLOW)
			LF	XSAC,ZPSZEV(XWAC1)
			IF	JUMPE	XSAC,FALSE
				TRNN	RE
				GOTO	FALSE
			THEN	;reactivation of active process specified
				STACK	XTAC
				REMOVE(XSAC)
				UNSTK	XTAC
			FI
			SF	XTAC,ZPSZEV(XWAC1)
			SF	XWAC1,ZEVZPS(XTAC)
			XCT	YSULEV(XLOW)
			LF	XZSUFT,ZSUFT(XSAC)
			LF	XWAC1,ZEVZPS(XZSUFT)
			SETZ	XSAC,
			EXCH	XSAC,YSUPFT(XLOW)
			CALLOW
			CAME	XSAC,XWAC1
			RESUME(XWAC1)
	FI	FI
SUACX:	CALLOW
	RETURN
	EPROC
	SUBTTL	.SUAM	(ACCUM)

; Purpose
; -------
; To implement the system procedure ACCUM.

; Input
; -----
; XWAC1=address of A, XWAC2=address  of  B,  XWAC3=address  of  C,
; XWAC4=value  of  D,  where  A  is  the  accumulated value of the
; integral, B is the time of the last update of  the  variable  C,
; and D is the current increment to C.  Single precision is used.

; Function
; --------
; According to the SIMULA definition:
;	PROCEDURE accum (a,b,c,d); NAME a,b,c;
;	REAL	a,b,c,d;
;	BEGIN	a := a + c * (time-b);
;		b := time; c := c + d
;	END	accum;
; a statement of  the  form  "accum  (A,B,C,D)"  may  be  used  to
; accumulate  the  "system  time  integral"  of  the  variable  C,
; interpreted as a step function of system time.

XA=XWAC1
XB=XWAC2
XC=XWAC3
XD=XWAC4

.SUAM:	PROC
	LOWADR
	XCT	YSULEV(XLOW)
	LF	XWAC5,ZSUFT(XSAC)
	LF	XWAC5,ZEVTIM(XWAC5)
	L	XWAC5		;time
	FSBR	(XB)		;time-b
	FMPR	(XC)		;c*(time-b)
	FADRM	(XA)		;a:=a+c*(time-b)
	ST	XWAC5,(XB)	;b:=time
	FADRM	XD,(XC)		;c:=c+d
	RETURN
	EPROC
	SUBTTL	.SUCA	(CANCEL)

; Purpose
; -------
; To implement the system procedure CANCEL.

; Input
; -----
; Process reference in XWAC1.

; Function
; --------
; According to the SIMULA description:

;	PROCEDURE suca(yyzps); REF(zps)yyzps;
;	IF zsuft==yyzps.zpszev THEN
;	supa    ELSE
;	INSPECT yyzps.zpszev DO
;	BEGIN	zevzps.zpszev :- NONE;
;		remove(THIS zev)
;	END;

; CANCEL(CURRENT)  is  equivalent  to  PASSIVATE,  otherwise   the
; eventnotice, if any, of the process is removed from SQS (by SURM).

.SUCA:	PROC
	CAIN	XWAC1,NONE
L1():!	RETURN
	LOWADR
	XCT	YSULEV(XLOW)
	LF	,ZSUFT(XSAC)
	LF	XSAC,ZPSZEV(XWAC1)
	JUMPE	XSAC,L1		;[120] zpszev==NONE: no action
	CAMN	XSAC
	BRANCH	.SUPA
	ZF	ZPSZEV(XWAC1)
	BRANCH	SURM
	EPROC
	SUBTTL	.SUEV	(EVTIME)

; Purpose
; -------
; Computes EVTIME(<process>), i e the next scheduled time for the
; process.

; Input
; -----
; Process reference in Xtop according to the calling sequence:
;	MOVEI   XTAC,Xtop
;	EXEC    .SUEV

; Output
; ------
; Xtop=the time scheduled for the next event (activation) of the
; process.

; Function
; --------
; If the process is idle, i e has no event notice,
; or the reference is NONE, give error message.
; Otherwise, the value is ZEVTIM(ZPSZEV(Xtop)).

.SUEV:	PROC
	EXCH	XWAC1,(XTAC)
	IF	CAIE	XWAC1,NONE
		GOTO	FALSE
	THEN	SUERR	1,EVTIME: object NONE
	FI
	LF	XWAC1,ZPSZEV(XWAC1)
	IF	JUMPN	XWAC1,FALSE
	THEN	SUERR	2,EVTIME: passive process
	FI
	LF	XWAC1,ZEVTIM(XWAC1)
	EXCH	XWAC1,(XTAC)
	RETURN
	EPROC
	SUBTTL	.SUHO	(HOLD)

; Purpose
; -------
; Implements the HOLD statement.

; Input
; -----
; Holding time in XWAC1 (floating point).

; Function
; --------
; Halts the current process and schedules its next active phase at
; a time determined by time+holding time.  The next process in SQS
; is resumed.

; Algorithm
; ---------
; PROCEDURE suho(yyt);    REAL yyt;
; INSPECT zsuft DO
; BEGIN	REF(zev)yzev,yzev1;
;	yzev1:-zsuft.zevzps;	!current;
;	IF yyt>0 THEN zevtim := zevtim+yyt;
;	rank(zevtim);
;	yzev :- succede(yzevl);
;	yzev.zevtim:=zevtim;
;	yzev.zevzps :- zevzps;
;	zevzps.zpszev:- yzev;
;	remove(THIS zev);
;	IF yzev1=/=zsuft.zevzps THEN
;	resume(zsuft.zevzps)
; END	suho;
XZSUFT=XWAC2
XFTIME=XWAC3
XZEVF=XWAC7
XZEVL=XWAC10

.SUHO:	PROC
	LOWADR
	XCT	YSULEV(XLOW)
	LF	XZSUFT,ZSUFT(XSAC)
	JUMPE	XZSUFT,L9	;[120] No action if no event notice
	LF	XSAC,ZEVZPS(XZSUFT)
	ST	XSAC,YSUPFT(XLOW)
	LF	XFTIME,ZEVTIM(XZSUFT)
	IF	JUMPG	XWAC1,FALSE
	THEN	L	XWAC1,XFTIME
	ELSE
		FADR	XWAC1,XFTIME
	FI
	RANK(XWAC1)
	EXCH	XWAC1,XZEVL
	CFORBID
	SUCCEDE(XWAC1)
	SF	XZEVL,ZEVTIM(XTAC)
	XCT	YSULEV(XLOW)
	LF	XZSUFT,ZSUFT(XSAC)
	L	XWAC1,XSAC
	LF	XSAC,ZEVZPS(XZSUFT)
	SF	XSAC,ZEVZPS(XTAC)
	SF	XTAC,ZPSZEV(XSAC)
	REMOVE(XZSUFT)
	LF	XZSUFT,ZSUFT(XWAC1)
	LF	XWAC1,ZEVZPS(XZSUFT)
	SETZ	XSAC,
	EXCH	XSAC,YSUPFT(XLOW)
	CALLOW
	CAIN	XSAC,(XWAC1)
L9():!	RETURN
	RESUME(XWAC1)
	EPROC
	SUBTTL	.SUNE	(NEXTEV)

; Purpose
; -------
; Implements NEXTEV.

; Input
; -----
; Process pointer in Xtop. Calling sequence:
;	MOVEI   XTAC,Xtop
;	EXEC    .SUNE
; Xtop is given by XTAC.

; Output
; ------
; Ref(ZPS) in Xtop gives the process scheduled immediately after
; the input process.

; Function
; --------
; The result is NONE if the process is IDLE or is last in the SQS
; (i e has no successor, given by .SUSU(ZPSZEV(Xtop))).
; Otherwise, the result is ZEVZPS(.SUSU(ZPSZEV(Xtop))).

.SUNE:	PROC
	L	XSAC,XTAC
	EXCH	XWAC1,(XSAC)
	IF	CAIN	XWAC1,NONE
		GOTO	FALSE
	THEN
		LF	XWAC1,ZPSZEV(XWAC1)
		JUMPE	XWAC1,FALSE
		SUCCESSOR(XWAC1)
		LF	XWAC1,ZEVZPS(XTAC)
	ELSE
		LI	XWAC1,NONE
	FI
	EXCH	XWAC1,(XSAC)
	RETURN
	EPROC
	SUBTTL	.SUPA	(PASSIVATE)

; Purpose
; -------
; Implements PASSIVATE.

; Function
; --------
; Removes the eventnotice for CURRENT. Resumes the new CURRENT
; process.

; Algorithm
; ---------
; PROCEDURE supa;
; BEGIN	zsuft.zevzps.zpszev :- NONE;
;	remove(zsuft);
;	resume(zsuft.zevzps)
; END;

XZSUFT=XWAC2

.SUPA:	PROC
	LOWADR
	XCT	YSULEV(XLOW)
	L	XWAC1,XSAC
	LF	XSAC,ZSUFT(XSAC)
	LF	XWAC2,ZEVZPS(XSAC)
	CFORBID
	ZF	ZPSZEV(XWAC2)
	REMOVE(XSAC)
	LF	XZSUFT,ZSUFT(XWAC1)
	LF	XWAC1,ZEVZPS(XZSUFT)
	CALLOW
	RESUME(XWAC1)
	EPROC
	SUBTTL	SUPC (PRECEDE)

; Purpose
; -------
; To insert an event notice in the SQS, PRECEDING a given notice.

; Input
; -----
; XWAC1 points to the event notice which the new notice should
; precede.

; Output
; ------
; XTAC points to the new event notice.

; Algorithm
; ---------
; REF(zev)PROCEDURE supc(yyzev);
; REF(zev)yyzev;
; BEGIN	REF(zev)yzev,yzevb;
;	IF yyzev.zevzrl == NONE THEN
;	BEGIN	yzev :- sane(yyzev);
;		IF yyzev.zevzll=/=NONE THEN
;		yyzev.zevzrl :- yzev ELSE
;		yyzev.zevzll :- yzev;
;		yzev.zevzbl :- yyzev;
;		IF yyzev==zsuft THEN
;		zsuft :- yzev
;	END	ELSE
;	BEGIN	yzev:-yyzev.zevzrl;
;		yzevb:-sane(yzev);
;		yzev.zevzbl:-yzevb;
;		yzevb.zevzll:-yzev;
;		yzevb.zevzbl:-yyzev;
;		yyzev.zevzrl:-yzevb;
;		yzev :- yzevb
;	END;
;	supc :- yzev;
; END	supc;
SUPC:	PROC
	ST	XWAC1,YSUPCP(XLOW)	;Save in case of garbage collection
	SAVE	X0
	LF	,ZEVZRL(XWAC1)
	IF
		JUMPN	FALSE
	THEN	;no right link present
		NEWNOTICE(XWAC1)
		LOWADR
		L	XWAC1,YSUPCP(XLOW)
		LF	,ZEVZLL(XWAC1)
		IF
			JUMPE	FALSE
		THEN	;left link present
			SF	XTAC,ZEVZRL(XWAC1)
		ELSE	;no left link present
			SF	XTAC,ZEVZLL(XWAC1)
		FI
		SF	XWAC1,ZEVZBL(XTAC)
		XCT	YSULEV(XLOW)
		LF	,ZSUFT(XSAC)
		IF
			CAMN	XWAC1
		THEN	;to precede first node
			SF	XTAC,ZSUFT(XSAC)
		FI
	ELSE	;right link present
		LF	XSAC,ZEVZRL(XWAC1)
		NEWNOTICE(XSAC)
		L	XWAC1,YSUPCP(XLOW)
		LF	XSAC,ZEVZRL(XWAC1)	;In case of garbage coll.
		SF	XTAC,ZEVZBL(XSAC)
		SF	XSAC,ZEVZLL(XTAC)
		SF	XWAC1,ZEVZBL(XTAC)
		SF	XTAC,ZEVZRL(XWAC1)
	FI
	SETZM	YSUPCP(XLOW)
	RETURN
	EPROC
	SUBTTL	.SUPS	(PROCESS prototype)

; Purpose
; -------
; Implements the prototype of PROCESS.

; Function
; --------
; The PROCESS prototype has LINK (.SSLK) as  prefix.  The  initial
; actions  are  coded  at  SUPS%D  (declaration coding) and SUPS%S
; (statements) according to CB.   TERMINATED  is  taken  as  truly
; terminated (ZDNTER bit).

IFL <SUPS-400K>,<D%SUPS>	;Define prototype if low segment

SUPS%D:	ZF	ZPSZEV(XCB)
	LI	XSAC,2
	JSP	CPCD
SUPS%S:	DETACH
	LI	XSAC,2
	INNER
SUPS%I:	SETON	ZDNTER(XCB)
	EXEC	.SUPA
SUPS%T:	SUERR	3,Reactivation of terminated process

SUPS%M=0

;Symbol table
;------------
	DZSMCL	PROCESS,SUPS

	;[22] ADD ZSDSPI CODE AS SECOND PARAMETER

	DZSD	IDLE,,QBOOLEAN,,QPROCEDURE,0
	DZSD	TERMINATED,,QBOOLEAN,,QPROCEDURE,0
	DZSD	EVTIME,QIEVTIME,QREAL,,QPROCEDURE,3
	DZSD	NEXTEV,QINEXTEV,QREF,,QPROCEDURE,0,.SUPS
	Z
	SUBTTL	.SUMA	(MAIN PROGRAM)

; Purpose
; -------
; To implement the MAIN PROGRAM of the simulation class.

; Function
; --------
; .SUMA is the address of the prototype of the MAIN PROGRAM.   The
; actions are defined by SUMA%S.

IFL <SUMA-400K>,<D%SUMA>	;Expand prototype if low segment
SUMA%D:	LI	XSAC,3
	JSP	CPCD
SUMA%S:	DETACH
	GOTO	SUMA%S
SUMA%I:	RFAIL	CANNOT TERMINATE MAIN PROGRAM

SUMA%M=0

;Symbol table
;------------
	DZSMCL	MAIN_PROGRAM,SUMA,0
	SUBTTL	SURM	(REMOVE)

; Purpose
; -------
; To remove an event notice from the SQS.

; Input
; -----
; XSAC points to event notice to be removed.

; Function
; --------
; Remove the notice from the SQS and chain it to the free list for
; the  eventnotice record.    Special cases arise depending on the
; position of the notice in the SQS and in relation to its  parent
; node.

; Algorithm
; ---------
; PROCEDURE  surm(yyzev);
;	REF(zev)yyzev;
; BEGIN
;	REF(zev)yzev,yzevl,yzevb,yzevr;
;	yzevb:-yyzev.zevzbl;    ! back link;
;	yzevl:-yyzev.zevzll;    ! left link;
;	yzevr:-yyzev.zevzrl;    ! right link;
;	IF yzevl==NONE THEN
;	BEGIN	! terminal node;
;		IF yzevb.zevzll==yyzev THEN	! left subnode
;		yzevb.zevzll:-yzevb.zevzrl;
;		yzevb.zevzrl:-NONE;
;		IF yyzev==zsuft THEN
;		BEGIN	zsuft:-yzevb;
;			WHILE zsuft.zevzll=/=NONE
;			DO zsuft:-zsuft.zevzll;
;		END
;	END	ELSE	! non terminal node;
;	IF yzevb.zevzrl==yyzev THEN
;	BEGIN	! yyzev is a right hand subnode;
;		IF yzevr=/=NONE THEN
;		BEGIN	! right hand subtree present;
;			yzevr.zevzbl:-yzevb;
;			yzevb.zevzrl:-yzevr;
;			yzev:-suut(yyzev);
;			yzev.zevzll:-yzevl;
;			yzevl.zevzbl:-yzev;
;		END	ELSE
;		begin	! right hand subtree not present;
;			yzevl.zevzbl:-yzevb;
;			yzevb.zevzrl:-yzevl;
;		END
;	END	ELSE
;	BEGIN	! yyzev is a left subnode;
;		yzevb.zevzll:-yzevl;
;		yzevl.zevzbl:-yzevb;
;		IF yzevr=/=NONE THEN	! right hand subtree present;
;		BEGIN	IF yzevb.zevzrl==NONE THEN
;			BEGIN	yzevb.zevzrl:-yzevr;
;				yzevr.zevzbl:-yzevb;
;			END	ELSE
;			BEGIN
;				yzev:-suut(yzev);
;				yzev.zevzll:-yzevr;
;				yzevr.zevzbl:-yzev;
;			END
;		END
;	END
;	! put the notice on the free list of its
;	  eventnotice  record;
;	yyzev.zevzch:-yyzev.zevzer.zerzev;
;	yyzev.zevzer.zerzev:-yyzev;
; END	surm;
XXZEV=XWAC1
XZEVB=XWAC2
XZSUFT=XWAC3
XZEVR=XWAC7
XZEVL=XWAC10

SURM:	PROC
	SAVE	XWAC1
	L	XXZEV,XSAC
	LF	XZEVB,ZEVZBL(XXZEV)
	LF	XZEVL,ZEVZLL(XXZEV)
	LF	XZEVR,ZEVZRL(XXZEV)
	IF	JUMPN	XZEVL,FALSE
	THEN	;terminal node
		IF	LF	,ZEVZLL(XZEVB)
			CAME	XXZEV
			GOTO	FALSE
		THEN	;left subnode
			LF	,ZEVZRL(XZEVB)
			SF	,ZEVZLL(XZEVB)
		FI
		ZF	ZEVZRL(XZEVB)
		IF	LOWADR
			XCT	YSULEV(XLOW)
			LF	XZSUFT,ZSUFT(XSAC)
			CAME	XZSUFT,XXZEV
			GOTO	FALSE
		THEN	;first notice to be removed
			L	XZSUFT,XZEVB
			WHILE	LF	,ZEVZLL(XZSUFT)
				JUMPE	FALSE
			DO	L	XZSUFT,
			OD
			SF	XZSUFT,ZSUFT(XSAC)
		FI
	ELSE	;non terminal node
		IF	LF	,ZEVZRL(XZEVB)
			CAME	XXZEV
			GOTO	FALSE
		THEN	;right hand subnode
			IF	JUMPE	XZEVR,FALSE
			THEN	;right hand subtree present
				SF	XZEVB,ZEVZBL(XZEVR)
				SF	XZEVR,ZEVZRL(XZEVB)
				EXEC	SUUT
				SF	XZEVL,ZEVZLL(XTAC)
				SF	XTAC,ZEVZBL(XZEVL)
			ELSE	;right hand subtree not present
				SF	XZEVB,ZEVZBL(XZEVL)
				SF	XZEVL,ZEVZRL(XZEVB)
			FI
		ELSE	;left subnode
			SF	XZEVL,ZEVZLL(XZEVB)
			SF	XZEVB,ZEVZBL(XZEVL)
			IF	JUMPE	XZEVR,FALSE
			THEN	;right hand subtree present
				LF	,ZEVZRL(XZEVB)
				IF	JUMPN	FALSE
				THEN	;father has right link
					SF	XZEVR,ZEVZRL(XZEVB)
					SF	XZEVB,ZEVZBL(XZEVR)
				ELSE	;father has no right link
					EXCH	XZEVB,XXZEV
					EXEC	SUUT
					L	XXZEV,XZEVB
					SF	XZEVR,ZEVZLL(XTAC)
					SF	XTAC,ZEVZBL(XZEVR)
				FI
			FI
		FI
	FI
	LF	XWAC10,ZEVZER(XXZEV)
	LF	XWAC7,ZERZEV(XWAC10)
	SKIPN	XWAC7
	LI	XWAC7,-1
	SF	XWAC7,ZEVZCH(XXZEV)
	SF	XXZEV,ZERZEV(XWAC10)
	SETZM	OFFSET(ZEVZLL)(XXZEV)
	ZF	ZEVZBL(XXZEV)
	RETURN
	EPROC
	SUBTTL	SURN	(RANK)

; Purpose
; -------
; To rank a time, i e find its place in the SQS.

; Input
; -----
; XWAC1=the time to be ranked.

; Output
; ------
; Two eventnotice addresses: YZEVF and YZEVL.  YZEVF  denotes  the
; "first"  notice, i e if PRIOR was specified, a new notice should
; precede this notice.  YZEVL denotes the notice which  should  be
; followed by a new notice if PRIOR is not specified.

; Function
; --------
; According to the algorithm.   YZEVF  and  YZEVL  are  registers,
; called XZEVF, XZEVL.

; Algorithm
; ---------
; PROCEDURE  surn(yytime);  REAL yytime;
; BEGIN
;	REF(zev)yzev;
;	yzevf:-yzevl:-zsuft;
;	WHILE   yzevf.zevtim<yytime DO
;	BEGIN	! find the last time before yytime;
;		yzevl :- yzevf;
;		yzevf :- successor(yzevl);
;	END;
;	! at this point, yzevf is the notice
;	  just after or at yytime.
;	  yzevl points to the preceding notice;
;	IF      yzevf.zevtim=yytime THEN
;	BEGIN	! there is at least one eventnotice at yytime;
;		yzevl :- yzevf;
;		yzev :- successor(yzevl);    ! successor;
;		WHILE   yzev.zevtim=yytime DO
;		BEGIN	! find the last notice at yytime;
;			yzevl:-yzev;
;			yzev:-successor(yzev);
;		END;
;	END;
; END	surn;
XZSUFT=XTAC
XXTIME=XWAC2
XZEVF=XWAC7
XZEVL=XWAC10

SURN:	PROC
	XXTIM==XXTIME	;[202]
	SAVE	<X0,XXTIM,XSAC,XTAC,XWAC1> ;[202]
	LOWADR
	XCT	YSULEV(XLOW)
	LF	XZSUFT,ZSUFT(XSAC)
	L	XZEVL,XZSUFT
	L	XZEVF,XZSUFT
	L	XXTIME,XWAC1
	;IF maxtime THEN subtract 1;
	CAML	XXTIME,[QLARGE]
	SUBI	XXTIME,1
	WHILE	LF	,ZEVTIM(XZEVF)
		CAML	XXTIME
		GOTO	FALSE
	DO	L	XZEVL,XZEVF
		SUCCESSOR(XZEVL)
		L	XZEVF,XTAC
	OD
	IF	LF	,ZEVTIM(XZEVF)
		CAME	XXTIME
		GOTO	FALSE
	THEN	;at least one ev notice at xxtime
		L	XZEVL,XZEVF
		SUCCESSOR(XZEVL)
		WHILE	LF	,ZEVTIM(XTAC)
			CAME	XXTIME
			GOTO	FALSE
		DO	L	XZEVL,XTAC
			SUCCESSOR(XZEVL)
		OD
	FI
	RETURN
	EPROC
	SUBTTL	SURS	(RESUME PROCESS)

SURS:	CAIE	XWAC1,NONE
	BRANCH	CPRS
	HRRZ	X1,(XPDP)	;Return address for call on cancel or passivate or hold
	IF	;Call was at PROCESS termination
		CAIE	X1,SUPS%T
		GOTO	FALSE
	THEN	;Fix stack for better error message
		LF	X1,ZBIZPR(XCB)
		LF	X1,ZCPIEA(X1)
		HRRM	X1,(XPDP)
	FI
	SUERR	4,SQS empty
	RETURN
	SUBTTL	SUSC	(SUCCEDE)

; Purpose
; -------
; To insert a new notice following a given notice.

; Input
; -----
; XWAC1 points to the notice which the new notice should follow.

; Output
; ------
; XTAC=address of the new notice.

; Algorithm
; ---------
; REF(zev)PROCEDURE  susc(yyzev);  REF(zev)yyzev;
; BEGIN	REF(zev)yzev;
;	yzev:-susu(yyzev);
;	susc:-supc(yzev);
; END	susc;

SUSC:	PROC
	SAVE	X0
	ST	XWAC1,YSUSCP(XLOW)
	SUCCESSOR(XWAC1)
	L	XWAC1,XTAC
	EXEC	SUPC
	SETZ	XWAC1,
	EXCH	XWAC1,YSUSCP(XLOW)
	RETURN
	EPROC
	SUBTTL	.SUSI	(SIMULATION prototype)

; Purpose
; -------
; .SUSI  corresponds   to   the   SIMULATION   prototype.

; Function
; --------
; ZPCSTA of .SUSI points to SUSI%S, which  performs  the  following
; initial actions (see CB 14.2.1):
; Using the prototype .SUMA, create a MAIN  PROGRAM,  referred  by
; ZSUZPS.	 Allocate  an eventnotice record (of length QZERLG
; words) and put it on the free list (ZSUZER).	         Each page
; is  formatted  into  free  eventnotices on a chain.  Allocate an
; eventnotice for the main program in the first ZER  record.   Set
; ZSUFT  and ZSULT to point to the new eventnotice (start of SQS).
; Initialize YSULEV(XLOW) to the instruction:
;	MOVE   XSAC,d(XCB)
; where  d  =  ZPREBL(ZBIZPR(XCB)).     This   instruction,   when
; executed,  loads  the  address  of the SIMULATION block to XSAC.
; The right half can be used on its own as the displacement of the
; SIMULATION block display entry relative to a block with display.

IFL <SUSI-400K>,<D%SUSI>
	EXTERN	.SIMLV,.SIMVL

SUSI%D:	LOWADR
	CFORBID
	SETZM	OFFSET(ZSULT)(XCB)	;BEGIN !Initialize SIMULATION data
	SETZM	OFFSET(ZSUZER)(XCB)
	LI	NONE
	SF	,ZSUZPS(XCB)
	LF	XSAC,ZBIZPR(XCB)	;Set up instruction to load SIMULATION
	LF	XSAC,ZPREBL(XSAC)	;block address.
	HRLI	XSAC,(MOVE XSAC,(XCB))
	ST	XSAC,YSULEV(XLOW)
	LI	.SUNE			;Make nextev procedure accessible
	ST	YSUNE(XLOW)		;from high segment or SIMDDT
	LI	XSAC,1
	CALLOW
	JSP	CPCD
SUSI%S:	LOWADR
	CFORBID
	;Make NEW MAIN PROGRAM
	EXEC	CPNE
YMAINL:	XWD	.SIMLV,.SUMA
	;ZSUZPS :- NEW MAIN PROGRAM
	SF	XWAC1,ZSUZPS(XCB)
	LI	XSAC,0
	NEWNOTICE(XSAC)			;ZPSZEV :- NEW EVENT NOTICE(0,ZSUZPS)
	SF	XTAC,ZSULT(XCB)		;zsult:-dummy
	L	[QLARGE]
	SF	,ZEVTIM(XTAC)
	LI	NONE
	SF	,ZEVZPS(XTAC)
	NEWNOTICE(XTAC)
	LF	XWAC1,ZSUZPS(XCB)
	SF	XTAC,ZPSZEV(XWAC1)
	SF	XWAC1,ZEVZPS(XTAC)
	SF	XTAC,ZSUFT(XCB)		;ZSUFT:-ZPSZEV;
	LF	XWAC1,ZSULT(XCB)
	SF	XWAC1,ZEVZBL(XTAC)
	SF	XTAC,ZEVZLL(XWAC1)
	CALLOW
	LI	XSAC,1
	INNER

SUSI%I:	JSP	CPE0			;END SIMULATION;

SUSI%M=0

;Symbol table
;------------
	.SSLK					;[151] insert references to the subclasses of SIMULATION
	.SSHD				;[151]
	.SUPS				;[151]
	DZSMCL	SIMULATION,SUSI
	DZSD	MAIN,,QREF,,,OFFSET(ZSUZPS),.SUMA
	DZSD	CURRENT,QICURRENT,QREF,,QPROCEDURE,0,.SUPS
	DZSD	TIME,QITIME,QREAL,,QPROCEDURE,3
	DZSD	PROCESS,,QNOTYPE,,QCLASS,0
	Z
	SUBTTL	SUSU	(SUCCESSOR)

; Purpose
; -------
; Find the successor to a given event notice.

; Input
; -----
; XWAC1= eventnotice address.

; Output
; ------
; XTAC= successor of XWAC1 in SQS 

; Algorithm
; ---------
; REF(zev)PROCEDURE  susu(yyzev);
;	REF(zev)yyzev;
; BEGIN	REF(zev)yzev;
;	yzev:-yyzev.zevzbl;
;	IF yzev.zevzrl == NONE
;	THEN susu:-yzev
;	ELSE susu:-suut(yzev);
; END	susu;

SUSU:	PROC
	LF	XTAC,ZEVZBL(XWAC1)
	LF	,ZEVZRL(XTAC)
	IF	JUMPE	FALSE
		CAMN	XWAC1
		GOTO	FALSE
	THEN
		L	XWAC1,XTAC
		BRANCH	SUUT
	FI
	RETURN
	EPROC
	SUBTTL	SUUT	(utility routine)

; Purpose
; -------
; Utility routine: Finds successor of the left link of a node.

; Input
; -----
; XWAC1= notice address.

; Output
; ------
; XTAC= successor of ZEVZLL(XWAC1).

; Algorithm
; ---------
; REF(zev)PROCEDURE  suut(yyzev);
;	REF(zev)yyzev;
; BEGIN	REF(zev)yzev;
;	yzev:-yyzev.zevzrl;
;	WHILE   yzev.zevzll=/=NONE DO
;		yzev:-yzev.zevzll;
;	suut:-yzev
; END	suut;

SUUT:	PROC
	SAVE	XWAC1
	LF	XTAC,ZEVZRL(XWAC1)
	WHILE	LF	XWAC1,ZEVZLL(XTAC)
		JUMPE	XWAC1,FALSE
	DO	L	XTAC,XWAC1
	OD
	RETURN
	EPROC
	SUBTTL	.SUWA	(WAIT)

; Purpose
; -------
; To implement the standard procedure WAIT.

; Input
; -----
; REF(head) in XWAC1.

; Function
; --------
; Put CURRENT into the queue specified by XWAC1. Passivate
;  CURRENT.

; Algorithm
; ---------
; PROCEDURE  suwa(yyzhd);  REF(zhd)yyzhd;
; BEGIN	ssit(zsuft.zevzps); supa  END;

	EXTERN	.SSIT	;(INTO)

.SUWA:	PROC
	L	XWAC2,XWAC1
	LOWADR
	XCT	YSULEV(XLOW)
	LF	XWAC1,ZSUFT(XSAC)
	LF	XWAC1,ZEVZPS(XWAC1)
	EXEC	.SSIT
	BRANCH	.SUPA
	EPROC
	LIT
	END