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