Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	SUBTTL	SIMULA RUNTIME SYSTEM, EVENTNOTICE ALLOCATION

; Author:	Lars Enderin
; Version:	1
; Purpose:	To manage storage for the sequencing set.


	RELOC	0
	SEARCH	SIMMAC,SIMMCR,SIMRPA

	ENTRY	.SANE
	SALL
	RTITLE	SANE  New event notice
	ERRMAC	SA
	MACINIT

IFN <%ZDNTYP-^D17>,<CFAIL ZDNTYP FIELD MUST END IN BIT 17..>

	SUBTTL	.SANE   (new event notice)

; Purpose:	To allocate an event notice.

; Input:	XSAC contains the address of an event notice.  .SANE should  try
;		to allocate a new notice in the same event notice record as this
;		one. Special case: allocate a new ZER record if XSAC=0.
;		For garbage collection purposes, a ZEV pointer has probably been
;		saved in YSUPCP(XLOW), maybe also in YSUSCP(XLOW).

; Output:	Pointer to new event notice in XTAC.

; Function:	Search the free list of  ZEVZER(XSAC).   If  a  free  notice  is
;		found,  remove it from the chain and return its address in XTAC.
;		The free list is headed by the ZERZEV field of the  ZER  record.
;		If no free notice is found, search each ZER record on the ZSUZER
;		chain of the simulation block for a free notice.  The simulation
;		block  is  found in display(XCB) at offset YSULEV(XLOW).  If all
;		ZER records are full, allocate  a  new  ZER  record  by  calling
;		SAAR. Change YSUPCP (and YSUSCP) before calling SAAR,    so that
;		the garbage collector is not confused.
;		On return from SAAR, restore the global cells.


Q1SA=<OFFSET(ZEVZCH)-ZEV%S>

.SANE:	PROC
	SAVE	<X0>
	JUMPE	XSAC,L2		;ZER allocation directly?
	LF	XTAC,ZEVZER(XSAC)
	LF	XSAC,ZERZEV(XTAC)
	IF	;Any free ZEV
		JUMPE	XSAC,FALSE
	THEN
L1():!		LF	,ZEVZCH(XSAC)
		CAIN	-1		;End of chain?
		SETZ
		SF	,ZERZEV(XTAC)
		ZF	ZEVZCH(XSAC)	;Mark as in use
		L	XTAC,XSAC
		RETURN
	FI
	LOWADR
	XCT	YSULEV(XLOW)	;Load XSAC with SIMULATION block address
	LF	XTAC,ZSUZER(XSAC)
	LOOP	;Find a ZER record with a free ZEV.
		LF	XSAC,ZERZEV(XTAC)
		JUMPN	XSAC,L1
		LF	XTAC,ZERZER(XTAC)
	AS
		JUMPN	XTAC,TRUE
	SA
	; No ZER record useful, allocate a new one
	; Save ZER pointer, keep offset in  XSAC
	IF	;YSUSCP has a ZEV pointer
		SKIPN	XSAC,YSUSCP(XLOW)
		GOTO	FALSE
	THEN	;Break it up into offset,,ZER address
		LF	XTAC,ZEVZER(XSAC)
		SUB	XSAC,XTAC
		HRL	XTAC,XSAC
		ST	XTAC,YSUSCP(XLOW)
	FI
	IF	;YSUPCP has a ZEV address
		SKIPN	XSAC,YSUPCP(XLOW)
		GOTO	FALSE
	THEN	;Split up into offset,,base (ZER)
		LF	XTAC,ZEVZER(XSAC)
		SUB	XSAC,XTAC	;Keep the offset in XSAC
		ST	XTAC,YSUPCP(XLOW)
	FI
L2():!	LOWADR
	; At this point, XSAC is zero or offset of an event notice
	; relative to its ZER record.
	L	XTAC,[ZER%V,,QZERLG]
	SETZM	YSANIN(XLOW)	;Should be zeroed
	EXEC	SAAR
	ADDM	XSAC,YSUPCP(XLOW)	;Restore ZEV pointers
	HLRZ	XSAC,YSUSCP(XLOW)
	ADD	XSAC,YSUSCP(XLOW)
	HRRZM	XSAC,YSUSCP(XLOW)
	IFN QSADEA,<;[231] Must not deallocate this block directly
	L	YSATOP(XLOW)
	ST	YSADEA(XLOW)
	>
	;Make list of free eventnotices in ZER record
	LI	XSAC,ZER%S(XTAC)	;Start of chain
	SF	XSAC,ZERZEV(XTAC)
	LI	<<QZERLG-ZER%S>/ZEV%S>
	LOOP
		LI	XSAC,ZEV%S(XSAC)	;Each ZEV points to the next one
		SF	XSAC,ZEVZCH(XSAC,-ZEV%S)
		SF	XTAC,ZEVZER(XSAC,-ZEV%S)
	AS
		SOJG	TRUE
	SA
	;Mark end of ZEV chain.
	IFE <%ZEVZCH-^D17>,<HRROS Q1SA(XSAC)>
	IFE <%ZEVZCH-^D35>,<HLLOS Q1SA(XSAC)>
	;Put ZER record on ZSUZER chain.
	XCT	YSULEV(XLOW)
	LF	,ZSUZER(XSAC)
	SF	XTAC,ZSUZER(XSAC)
	IF	;The chain existed before
		JUMPE	FALSE
	THEN	;Put this ZER in front
		SF	,ZERZER(XTAC)
	FI
	LF	XSAC,ZERZEV(XTAC)
	GOTO	L1
	EPROC

	LIT
	END