SUBTTL	SIMULA RUNTIME SYSTEM, STORAGE ALLOCATION

; Author:	Lars Enderin, Reidar Karlsson
; Version:	4 (11,65,72,175,215,265,273,276)
; Purpose:	To manage storage for objects (RTS dynamic data).

	SEARCH	SIMMAC,SIMMCR,SIMRPA
	SALL

;	The SA module contains the following procedures:

intern	.SAAB  ;  Allocate block instance record
		; (without display record).
intern	.SAAR  ;  Allocate a non-block record (array, text, ac stack etc).
intern	.SACL  ;  Give a log message and close GCP.TMP
intern	.SADB  ;  Allocate a block record with
		;  an attached display  record.
intern	.SADE  ;  Deallocate record. Not implemented in the first RTS
		;  version.
intern	.SAGC  ;  Garbage collector.
intern	.SAGI  ;  Garbage collector initialization
intern	.SAIN  ;  Initialize ref and array variables in a block.
intern	.SANP  ;  Determine and allocate new storage pool area.

Comment;

The routines described  implement  a  particular  storage  allocation
scheme,  which  may  be changed as experience is gained. Essentially,
storage is allocated in a contiguous pool, starting at  YSABOT(XLOW).
All  blocks  are  allocated from YSABOT upwards. YSATOP(XLOW) at each
instant shows the next free location.  When  YSATOP  reaches  YSALIM,
.SAGC  is  called  to get more core, and if necessary, reclaim unused
storage.  YSALIM is adjusted to leave room for a maximal  acs  object
(of  size  2+QNAC*2 words), ensuring that the accumulators can always
be saved before garbage collection is performed.
***AUBEG
IFN QKI10,<
[175]  Statistics  of  page  faults  between   and   during   garbage
collections  are  collected  and  used  in  SANP to determine virtual
memory size for paging jobs.  YSANWA and  YSANWC  are  used  to  save
paging data.
>
***AUEND;

	RTITLE	SA
	TWOSEG
	RELOC	400K
	MACINIT
	ERRMAC	SA

					edit(65)
	IFNDEF	QZERO,<QZERO==0>	;[65] Do not zero new core (should be zero)


	IFE QDEBUG,< DEFINE ASSERT(B)=<>
	>

	EXTERN	.JBREL, .JBFF, .JBHRL

	ASSERT<
	INTERN	SAGCLE,SAGCOD,SAGCOO
	EXTERN	SAPDCO,SAPDOI,SAPDTO
	EXTERN	.OCINC, .OCIN7, .OCIND

	OPDEF	FREEBUFF	[PUSHJ	XPDP,.OCINC]	;Frees a buffer area
	OPDEF	GETBUFF		[PUSHJ	XPDP,.OCIN7]	;Finds a free buffer
	OPDEF	LINKBUFF	[PUSHJ	XPDP,.OCIND]	;Links a buffer ring

	edit(273)	;[273]
	DEFINE CLAIMBUFF	<
				LF	X0,ZBHLEN(X1)
				MOVN	X0,X0
				SF	X0,ZBHLEN(X1)
				>
		>

	DEFINE	ZDNCASE(z,w)<
	LF	XTYP,ZDNTYP(XCUR)
	IFN QDEBUG,<
	JUMPL XTYP,.+2
	CAILE XTYP,QZDNTM
	 GOTO @.+2
	>
	GOTO	@.+1(XTYP)
	DEFINE X(A)<IRP A,<EXP w''A''z>>
	TYPZDN
	>



	;Constants used in .SAGC and .SANP
	; All floating point constants are stored in right half
	; as immediate constants


	RH=	-^D18		;To shift a floating point assembly
				; constant to the right half
	QSAF0=	0.0_RH	;F0 floating	initial value of F^ (YSAFES)
	QSAR0=	0.0_RH	;R0  "		initial value of R^ (YSARES)
	QSAB0=	0.0_RH	;B0  "		initial value of B^ (YSABES)
	IFN QSASTE,<
	QSAPMI= ^D256	;Min free pool area
	>
	IFE QSASTE,<
	QSALMI= ^D512	;Min low seg area change (treshold value) that
			; causes a core request after garbage collection
	>

	QSALF=	0.0_RH	;LF floating	exponential smoothing const. for F^
	QSALR=	0.0_RH	;LR   "		exponential smoothing const. for R^
	QSALB=	0.0_RH	;LB   "		exponential smoothing const. for B^


	QSAL1F=	1.0_RH	;L1F	floating	QSALF + 1.0
	QSAL1R=	1.0_RH	;L1R	  "		QSALR + 1.0
	QSAL1B=	1.0_RH	;L1B	  "		QSALB + 1.0

;=========== N O T E  !!!!!!!!!!!!!!  ========================================
;======== QSAL? and QSAL1? MUST be CHANGED at the SAME time ==================
;==============================================================================

	QCHGCP=17	;GCP.TMP channel number
	.IOBIN=14	;GCP.TMP data mode (binary)
	QPROTE=0	;1: a fixed pool is allocated
			;0: the dynamic allocation formula is used


IFN <%ZDNTYP-^D17>,<CFAIL ZDNTYP field must end in bit 17..>
	SUBTTL	.SAAB   (allocate block record)

; Purpose:	To allocate a block record without a display record.

; Input:	Prototype address in XSAC.

; Output:	Address of the new block in XRAC.

; Function:	Take the length from ZPRBLE(XSAC).  If  YSATOP+length
;		>  YSALIM,  call  .SAGC  with  the  difference in X0.
;		Place  the  current  value  of  YSATOP  in  XRAC  and
;		increase YSATOP by  the  length.    Set  ZBIZPR=XSAC,
;		which  should  be preserved (not destroyed by .SAGC).
;		Return.

.SAAB:	PROC
	SAVE	<X0,XSAC>
	LOWADR
	LF	,ZPRBLE(XSAC)
	ADD	YSATOP(XLOW)
	SUB	YSALIM(XLOW)
	IF	;Not enough space
		JUMPLE	FALSE
	THEN	;Collect garbage to get more
		EXEC	.SAGC
	FI
	L	XRAC,YSATOP(XLOW)
	LF	,ZPRBLE(XSAC)
	ADDM	YSATOP(XLOW)
	REPEAT 0,<
	SETZM	ZBI%S(XRAC)
	IF	;More than one variable
		CAIG	ZBI%S+1
		GOTO	FALSE
	THEN
		STACK	XTAC
		LI	ZBI%S+1(XRAC)
		HRLI	ZBI%S(XRAC)
		L	XTAC,YSATOP(XLOW)
		BLT	-1(XTAC)
		UNSTK	XTAC
	FI
	>
	MOVSI	QZBI
	WSF	,ZDNTYP(XRAC)
	WSF	XSAC,ZBIZPR(XRAC)
	EXEC	.SAIN	;Initialize  any  ref  and/or array variable
	RETURN
	EPROC
	SUBTTL	.SAAR   (allocate non-block record)

; Purpose:	Allocate a dynamic record of given length and type and return
;		its address.

; Input:	XTAC= XWD record type,record length

; Output:	New record address in XTAC.

; Function:	If YSATOP + length >  YSALIM,  call  .SAGC.   Set  XTAC  to  the
;		current  value  of  YSATOP,  and  increase YSATOP with the given
;		length.  Initialize data area with YSANIN value (if not  =  -1).
;		Reset YSANIN to zero.  Store record type in ZDNTYP field, length
;		in second word (which is the most common place), then return.

.SAAR:	PROC
	LOWADR
	LI	(XTAC)			;Length
	ADD	YSATOP(XLOW)
	SUB	YSALIM(XLOW)
	IF
		JUMPLE	FALSE
	THEN
		EXEC	.SAGC
	FI
	HLLZM	XTAC,@YSATOP(XLOW)	;Type
	LI	(XTAC)			;Length,
	L	XTAC,YSATOP(XLOW)
	ST	1(XTAC)			;put it in second word
	ADD	XTAC
	ST	YSATOP(XLOW)
	IF	;Initialization required
		AOSN	YSANIN(XLOW)
		GOTO	FALSE
	THEN
		STACK	XSAC
		IF
			SOSN	XSAC,YSANIN(XLOW)
			GOTO	FALSE
		THEN
			ST	XSAC,2(XTAC)
			LI	XSAC,3(XTAC)
			HRLI	XSAC,2(XTAC)
			EXCH	XSAC
			CAILE	XSAC,3(XTAC)	;If more than one data word,
			 BLT	-1(XSAC)	;initialize the rest
		FI
		UNSTK	XSAC
	FI
	SETOM	YSANIN(XLOW)
	RETURN
	EPROC
	SUBTTL	.SACL	(close  GCP.TMP)

	COMMENT;

Purpose:	Give a GC log message.
		Output the final GC parameter values
		and close GCP.TMP in debug version.

Entry:		.SACL

Normal exit:	RETURN

Call format:	EXEC	.SACL

Used  subroutines:	SANPDU, SAGCOD
			FREEBUFF

	;




.SACL:
	PROC
;***AUBEG
IFN QKI10,<
	edit(175)	;[175] save X3 too!
	SAVE	<X0,X1,X2,X3>
>
IFN QKA10,<
	SAVE	<X0,X1,X2>
>
;***AUEND
	LOWADR(X16)

	IF	;GC was ever called
		SKIPN	X1,YSAGCN(XLOW)
		GOTO	FALSE
	THEN	;Log number of GC's, GC time
		OUTSTR	[ASCIZ	/	
/]
		IFN QDEBUG,<
		L	X0,YSASW(XLOW)
			SETONA	SWGCT2
		>
		EXEC	SAGCOD
			edit(265)	;[265]
		OUTSTR	[ASCIZ	/ garbage collection(s) in /]
		L	X1,YSAGCT(XLOW)
		EXEC	SAGCOD
		OUTSTR	[ASCIZ	/ ms
/]

	FI
REPEAT 0,<;[276] Misleading, don't output
edit(175)
;[175] type page fault statistics
	L	X3,[%VMSPF]
	GETTAB	X3,
	SETZ	X3,
	HLRZ	X3,X3
	SUB	X3,YSANWA(XLOW)
	HRLZ	X3,X3
	ADDB	X3,YSANWC(XLOW)	;Cumul. NIW count between GC:s in left half
	IF	SKIPN	X3
		GOTO	FALSE
	THEN
		edit(265)	;[265]
		OUTSTR	[ASCIZ"[Page faults between/during G.C.'s]=["]
		HLRZ	X1,X3	;NIW faults between
		EXEC	SAGCOD
		LI	X1,"/"
		OUTCHR	X1
		HRRZ	X1,X3	;NIW faults during GC:s
		EXEC	SAGCOD
		OUTSTR	[ASCIZ/]
/]
	FI	>;[276]

	IFN QDEBUG,<
		;If log output on GCP.TMP
		;Update TIM and set TAU

	IF
		L	X0,YSASW(XLOW)
		IFONA	SAGCPE
		GOTO	FALSE
	THEN

	SETZ	X0,
	RUNTIM	X0,
	L	X1,YSATIM(XLOW)
	SUB	X0,X1
	FLTR	X0,X0
	ST	X0,YSATAU(XLOW)

		;Set YSATIM to -1 to indicate last dump record and dump

	SETOM	YSATIM(XLOW)
	EXEC	SANPDU

		;Close GCP.TMP and release buffer

	CLOSE	QCHGCP,
	L	X1,YSABH(XLOW)
	FREEBUF


	FI
	>

	RETURN

	EPROC
	SUBTTL	.SADB   (allocate block record with display)

; Purpose:	To allocate a block record with an attached display  record  and
;		fill some fields with information.

; Input:	Block type in XSAC left half, prototype  address  in  the  right
;		half.

; Output:	XRAC = address of the new block instance.

; Function:	If the length of the  display  record  (ZPCDLE(XSAC))  plus  the
;		length  of  the block (ZPRBLE) plus YSATOP > YSALIM, call .SAGC.
;		The display record is allocated, and the ZDNTYP, ZDRLEN,  ZDRZAC
;		fields are set.  ZDRZAC is copied from YCSZAC.

;		XRAC is set to the block instance address, ZDNTYP and ZBIZPR are
;		copied  from the input parameter (XSAC), ZDNZAC is set if YCSZAC
;		is non-zero.  YCSZAC  is  reset.   ZDRZBI:-XCB,  ZDRARE:=YOBJRT.
;		Store new ZBI address at ZPREBL in the display.   Initialize the
;		block to zeros,  except for REF variables,  the  value  of a REF
;		PROCEDURE and ARRAY variables, which are initialized to NONE.

.SADB:	PROC
	SAVE	<X0,XSAC,XTAC>
	LOWADR
	LF	XRAC,ZPCDLE(XSAC)
	LF	,ZPRBLE(XSAC)
	ADDI	(XRAC)
	ADD	YSATOP(XLOW)
	SUB	YSALIM(XLOW)
	IF	JUMPLE	FALSE
	THEN	EXEC	.SAGC
	FI
	L	XTAC,YSATOP(XLOW)
	MOVSI	QZDR
	WSF	,ZDNTYP(XTAC)
	SF	XRAC,ZDRLEN(XTAC)
	L	YCSZAC(XLOW)
	IF	;Any ac's saved
		JUMPE	FALSE
	THEN	;Mark the block
		SF	,ZDRZAC(XTAC)
		SETONA	ZDNACS(XSAC)
	FI
	SETZM	YCSZAC(XLOW)
	ADDI	XRAC,(XTAC)		;ZBI address
	repeat 0,<
	SETZM	2(XTAC)
	LI	3(XTAC)
	IF	CAIL	-1(XRAC)
		GOTO	FALSE
	THEN	HRLI	2(XTAC)
		BLT	-2(XRAC)
	FI
	>
	HRRZM	XSAC,OFFSET(ZBIZPR)(XRAC)
	HLLZM	XSAC,OFFSET(ZDNTYP)(XRAC)
	LFE	XTAC,ZPREBL(XSAC)	;Innermost display level
	ADDI	XTAC,(XRAC)
	ST	XRAC,(XTAC)
	SF	XCB,ZDRZBI(XRAC)	;Dynamic link
	HRRZ	YOBJRT(XLOW)
	SF	,ZDRARE(XRAC)		;Return address
	LF	XSAC,ZPRBLE(XSAC)	;Block length
	ADD	XSAC,XRAC
	ST	XSAC,YSATOP(XLOW)
	REPEAT	0,<
	SETZM	ZBI%S(XRAC)
	IF	;More than one variable
		CAIG	XSAC,ZBI%S+1(XRAC)
		GOTO	FALSE
	THEN
		LI	ZBI%S+1(XRAC)
		HRLI	ZBI%S(XRAC)
		BLT	-1(XSAC)
	FI
	>
	LF	XSAC,ZBIZPR(XRAC)	;Get prototype for special initialization
	LF	,ZPCTYP(XSAC)		;Check for type procedure
	IF	;Ref procedure
		CAIE	QREF
		GOTO	FALSE
	THEN
		LI	NONE
		ST	ZBI%S(XRAC)
	FI
	EXEC	.SAIN	;Initialize any ref and/or array variable
	RETURN
	EPROC
	SUBTTL	.SADE   (Deallocate record)

; Purpose:	To return a record to the free pool.

; Input:	YSARES(XLOW)= address of record to deallocate.


.SADE:	RFAIL	.SADE SHOULD NOT BE CALLED
	RETURN
	SUBTTL	.SAGC   (garbage collector)


; Purpose:	To provide space for a new piece of data.

; Input:	The  amount  of  storage  required  is  specified  in  X0.    If
;		YSAREL(XLOW)  is  different  from zero, the pool should be moved
;		upwards by that amount.

; Function:	The garbage collector works in 4 phases.
;	Phase 1:
;		Start from XCB and internal run time record pointers  and  chain
;		all referenceable records by their ZDNLNK fields.

;		Search record references in records on the chain,  chaining  all
;		found records to the end of the chain.

;	Phase 2:
;		When all referenceable records have been found, step through the
;		storage  pool  from  the  start and compute new record addresses
;		(assuming that the records should be moved towards the bottom of
;		the  pool).  If YSAREL is non-zero, add it to all new addresses.
;		The new addresses are saved in the ZDNLNK fields of the records.
;		The unreferenceable records have ZDNLNK=0.
;		[273] Do not relocate blocks below address given in YSAFRZ(XLOW).
;		When all new addresses are determined,  the  minimum  amount  of
;		core  is requested to make it  possible  to  continue  execution
;		after the garbage collection. If not enough core is available  a
;		run time error is generated.

;	Phase 3:
;		Step through the pool again and replace (update)  all  reference
;		quantities in the system.

;	Phase 4:
;		Step through the pool a third time and move the records to their
;		new  positions as given by their ZDNLNK fields.
;		Determine a new garbage collector limit and if  QSASTE=1  a  new
;		optimal step size. If QSASTE=0 a pool  up  to  the  new  garbage
;		collector limit is allocated, and if QSASTE=1 a free  pool  step
;		is allocated. If the CORMAX limit is exceeded, the CORMAX  value
;		is taken as the new garbage collector limit.
;		If CORMAX > high segment start, use that as limit.
	;REGISTER ASSIGNMENTS AND OPDEFS

XSW=	X1	;Switches the return jump in SAGCNP
XTYP=	X1	;Dyn. rec. type or formal param. type
XLO=	X1	;Used as XLOW

XST=	X2	;Store instruction to update pointers by  XCT XST
XBEG=	X2	;First dyn. rec. in pool that must be moved

XPT=	X3	;New pointer value
XKND=	X3	;Formal parameter kind

XAD=	X4	;The address to be loaded into XST before    XCT XST
		; or address of first occupied word in the new pool

XTOP=	X5	;End of old pool = YSATOP(XLOW)

XCUR=	X6	;Current dyn. rec.

XIND=	X7	;Index register
XSTOP=	X7	;LOOP LIMIT
XSAV=	X7	;Save register

XEND=	X10	;End of ZDNLNK chain in PHASE1
XTOT=	X10	;Total length of adjacent not referenced rec.
XFROM=	X10	;Source address at word by word move
XFROTO=	X10	;BLT ac with source address in left half
		;and target address in right

XZPR=	X11	;ZBIZPR
XZEV=	X11	;ZEV pointer

XLEN=	X12	;Length of current rec.

XLNK=	X13	;ZDNLNK

XBOT=	X14	;Bottom of the old pool  YSABOT(XLOW)

XNEXT=	XCB	;Address to routine NEXT
		; (i.e. SAGCN1 in PHASE1 and SAGCN3 in PHASE3)





OPDEF	NEXT	[JRST	(XNEXT)]	;Find next dyn. rec.
OPDEF	NPOINT	[JSP	XSW,SAGCNP]	;Check new pointer
OPDEF	NZEV	[JSP	X0,NEWZEV]	;Compute new zev pointer
OPDEF	LENGTH	[JSP	X0,SAGCLE]	;XLEN := length of current rec.
OPDEF	GOBACK	[JSP	X16,(X16)]	;Coroutine return
OPDEF	OP	[HRLI]			;Load operation in left half


DEFINE	INPOOL <CAIL XPT,(XBOT)		;;Skip next if pointer in pool
		CAIL	XPT,(XTOP)	>


DEFINE	NPNT(F)	<	;;Handle the pointer in the field F
			IFE<%'F - ^D17>,<OP	XST,(HRLM  XPT,)> ;;Left half
			LI	XAD,OFFSET(F)(XCUR)
			LF	XPT,F(XCUR)
			NPOINT
			IFE<%'F - ^D17>,<OP	XST,(HRRM  XPT,)> ;;Right half
								  ;;as default
		>


OPDEF	OUTOCT		[PUSHJ	17,SAGCOO]	;Output octal number
OPDEF	OUTDEC		[PUSHJ	17,SAGCOD]	;Output decimal number

	SUBTTL	SAGCCH	(Garbage collector coroutine)

	Comment;

Purpose:	Used  in  Phase  1  to  chain  a new dyn. rec. to the
		ZDNLNK chain if it is not referenced  before.  Update
		XEND to point to the latest chained rec.

Entry:		SAGCCH

Input arguments: XPT points to the new record

Normal exit:	GOBACK	(JSP	X16,(X16))

Call format:	GOTO	(XSW)	where XSW contains the PC value
				saved by the previous GOBACK.


	;




SAGCCH:	LF	XLNK,ZDNLNK(XPT)
	IF	;Not referenced before
		JUMPN	XLNK,FALSE
		CAIN	XPT,(XEND)
		GOTO	FALSE
	THEN			;Chain the new rec. and update XEND
		SF	XPT,ZDNLNK(XEND)
		LI	XEND,(XPT)
		IFN	QDEBUG,<	;Log chained records if SWGCTE on
				LOWADR(X1)
				IF
					L	X0,YSASW(XLOW)
					IFOFFA	SWGCTE
					GOTO	FALSE
				THEN
					RTEXT
					L	X1,XPT
					OUTOCT
				FI
				>
	FI
	GOBACK		;to SAGCSP or SAGCGP
	GOTO	SAGCCH	;Entry for next coroutine call on SAGCCH
			; Saved by GOBACK in X16
	SUBTTL	SAGCDR	(Garbage collector subroutine)

	Comment;

Purpose:	Search for dynamic pointers in a display record.
		The routine is used for ZBP, ZPB and ZCL records.

Entry:		SAGCDR

Input arguments:
		XCUR points to the ZBI record
		immediately following the display record.
		XZPR points to its prototype.

Normal exit:	GOTO ZBI.

Call format:	GOTO SAGCDR

	;




SAGCDR:	IF	;NOT Terminated AND NOT keepdisplay
		L	X0,(XCUR)
		IFOFFA	ZDNTER
		GOTO	TRUE
		IFOFFA	ZDNKDP
		GOTO	FALSE
	THEN	;Display record is referenced
		L	XSTOP,XCUR
		LF	XLEN,ZPCDLE(XZPR)
		SUBI	XCUR,(XLEN)

	;If ZDNLNK = 0 (i.e. in PHASE1),
	; then mark this ZDR rec. as referenced

		LF	XLNK,ZDNLNK(XCUR)
		IF
			JUMPN	XLNK,FALSE
		THEN	;Put -1 in ZDNLNK to mark as referenced
			HLLOS	OFFSET(ZDNLNK)(XCUR)
		FI


		LI	XAD,OFFSET(ZDRZAC)(XCUR)
		OP	XST,(HRLM XPT,)
		LOOP
			;Search for pointers into the pool in the left half
			; of words in the display record area
			; i.e. ZDRZAC, ZTSZBI and ZDRZBI fields

			HLRZ	XPT,(XAD)
			SKIPE	XPT
			NPOINT
		AS
			AOJ	XAD,
			CAIGE	XAD,(XSTOP)
			GOTO	TRUE
		SA
		LI	XAD,OFFSET(ZDRZAC)(XCUR)
		OP	XST,(HRRM	XPT,)
		LOOP
			;Search for pointers into the pool in the right half
			; of words in the display record area
			; i.e. display vector elements (ZDRZPB)
			; and ZTSZAC fields

			HRRZ	XPT,(XAD)
			SKIPE	XPT
			NPOINT
		AS
			AOJ	XAD,
			CAIGE	XAD,(XSTOP)
			GOTO	TRUE
		SA
		L	XCUR,XSTOP	;Restore XCUR
	FI
	BRANCH	ZBI.
	SUBTTL	SAGCFP	(Garbage collector subroutine)

	Comment;

Purpose:	Check formal parameter locations for ZBP, ZCL and ZPB rec.

Entry:		SAGCFP

Input arguments:	XCUR points to current dyn. rec. and
			XZPR points to its prototype rec.

Normal exit:	RETURN

Call format:	EXEC	SAGCFP

	;




SAGCFP:	HLLZ	XIND,OFFSET(ZPCNRP)(XZPR) ;number of param's in left half
	TLNN	XIND,-1
	RETURN				;No parameters

	MOVNS	XIND			;Number of param's negated in left half
	HRRI	XIND,OFFSET(ZPCZFP)(XZPR) ;XIND points to first formal
					; parameter descriptor
	LOOP
		;Find the ZDVZBI,ZDSZBI,ZDLZBI,ZDAZAR,ZRVZBI,ZDPZBI and
		; ZFLZBI pointers (i.e. the right half of the first word
		; in the formal location)

	    LF	X0,ZFPMOD(XIND)
	    LF	XTYP,ZTDTYP(XIND)
	    LF	XKND,ZPDKND(XIND)
	    IF
		CAIN	X0,QVALUE	; Not VALUE mode
		CAIN	XKND,QARRAY	; OR kind ARRAY
		GOTO	TRUE
		CAIN	XTYP,QREF	; OR type REF
		GOTO	TRUE
		CAIE	XTYP,QTEXT	; OR TEXT
		GOTO	FALSE
	    THEN ;We have an address in RH
		LF	XAD,ZFPOFS(XIND)
		ADDI	XAD,(XCUR)	;XAD = formal location address
		HRRZ	XPT,(XAD)
		NPOINT

	;Special code for procedures (not switches) not called by name

		LF	XTYP,ZTDTYP(XIND)
		LF	XKND,ZPDKND(XIND)
		IF	;Procedure not called by name
			CAIE	XKND,QPROCEDURE
			GOTO	FALSE
			IFNEQF	XIND,ZFPMOD,QNAME
			CAIN	XTYP,QLABEL
			GOTO	FALSE
		THEN	;Procedure not called by name and no switch
			LF	XPT,ZDPEBI(XAD)
			LI	XAD,OFFSET(ZDPEBI)(XAD)
			NPOINT		;ZDPEBI
		FI
		IFEQF	XIND,ZTDTYP,QREF
		ADDI	XIND,1		;Allow for qualification
	    FI
	AS
		AOBJN	XIND,TRUE	;more parameters
	SA
	RETURN
	SUBTTL	SAGCGP	(Garbage collector subroutine)

Comment;

Purpose:	Find global dynamic record pointers
		i.e. pointers in the static area declared in SIMRPA.MAC

Entry:		SAGCGP

Normal exit:	RETURN

Call format:	EXEC	SAGCGP

	;




SAGCGP:	LOWADR(XIND)

	;Start the chain with the outermost block
	; which is fixed, allocated in generated code

	L	XCUR,YOCXCB(XLOW)	;Outermost block address
	LI	XEND,(XCUR)		;End of chain
	LI	XNEXT,.+2		;Return address for SAGCSP
	GOTO	SAGCSP			;Search outermost block

					;Make XNEXT point to first record
	LI	XNEXT,(XCUR)		;in the chain
	LOWADR(XIND)

	OP	XST,(HRRM  XPT,(XLOW))	;Set the store inst. in XST
					; to be indexed with XLOW
	LI	XAD,XCB+YSASAV
	L	XPT,XCB+YSASAV(XLOW)
	NPOINT				;XCB
	LI	XAD,YTXZTV
	HRRZ	XPT,YTXZTV(XLOW)
	NPOINT				;YTXZTV

	LI	XAD,YOBJAD
	LI	XCUR,(XAD)
	ADDI	XCUR,(XLOW)		;XCUR = YOBJAD + (XLOW)
	HRLI	XAD,-<QOBJAD + QNGP>
	LOOP
		HRRZ	XPT,(XCUR)
		NPOINT			;YOBJAD[0:QOBJAD-1] and
					; YCSZAC,YSYSIN,YSYSOU,...
		ADDI	XCUR,1
	AS
		AOBJN	XAD,TRUE
	SA


	;Channel table right half

	LI	XAD,YIOCHT
	LI	XCUR,(XAD)
	ADDI	XCUR,(XLOW)		;XCUR = YIOCHT + (XLOW)
	HRLI	XAD,-20
	LOOP
		HRRZ	XPT,(XCUR)
		NPOINT			;YIOCHT [0:17] right half
		ADDI	XCUR,1
	AS
		AOBJN	XAD,TRUE
	SA


	;Channel table left half

	OP	XST,(HRLM  XPT,(XLOW))	;Pointer in left half
					; indexed with XLOW
	LI	XAD,YIOCHT
	LI	XCUR,(XAD)
	ADDI	XCUR,(XLOW)		;XCUR = YIOCHT + (XLOW)
	HRLI	XAD,-20
	LOOP
		HLRZ	XPT,(XCUR)
		NPOINT			;YIOCHT [0:17] left half
		ADDI	XCUR,1
	AS
		AOBJN	XAD,TRUE
	SA

	OP	XST,(HRRM  XPT,)	;Set default store instr. in XST

	RETURN
	SUBTTL	SAGCLE	(Garbage collector coroutine)

	Comment;

Purpose:	To determine the length of a dynamic record

Entry:		SAGCLE

Input arguments:	XCUR points to the record

Normal exit:	GOTO	@X0

Output arguments:	XLEN contains the length

Call format:	LENGTH		(JSP	X0,SAGCLE)

	;




SAGCLE:	edit(273)
	ZDNCASE(,.)	;[273]

.ZDN:	RFAIL	Bad ptr in XCUR (SAGCLE)
.ZBI:
.ZBP:
.ZPB:
.ZCL:	LF	XZPR,ZBIZPR(XCUR)
	LF	XLEN,ZPRBLE(XZPR)
	GOTO	@X0

.ZTT:	LI	XLEN,ZTT%S
	GOTO	@X0

.ZAC:	LF	XLEN,ZACNAC(XCUR)
	ADDI	XLEN,2+OFFSET(ZACSVA)
	GOTO	@X0

.ZTE:
.ZAR:
.ZER:
.ZDR:
.ZYS:
.ZXB:	LF	XLEN,ZYSLG(XCUR)
	GOTO	@X0
	SUBTTL	SAGCN1,SAGCN3	(Garbage collector subroutines)

	Comment;

Purpose:	SAGCN1:	To find next record in the ZDNLNK chain

		SAGCN3:	To find next record in pool and to update
			internal pointers in the new record

Entries:	SAGCN1,SAGCN3

Input arg.:	SAGCN1:	XCUR points to the rec just handled, and XEND points
			to the last rec in the chain to be handled.
		SAGCN3:	XCUR points to the rec just handled and XLEN
			contains the length of this rec. XTOP points to the
			first free location in the pool. The ZDNLNK field
			of a referenced record contains the new address.

Normal exits:	GOTO	SAGCSP

		SAGCN1:	GOTO	PHASE2		at end of chain

		SAGCN3:	GOTO	PHASE4		at end of pool

Call format:	NEXT	(GOTO	(XNEXT) where XNEXT = SAGCN1 in PHASE1
			and XNEXT = SAGCN3 in PHASE3)

	;




SAGCN1:		;Find next rec. in chain
	CAIN	XCUR,(XEND)
	GOTO	PHASE2		;Last rec. is already handled
	LF	XCUR,ZDNLNK(XCUR)
	GOTO	SAGCSP		;Handle next in chain




SAGCN3:		;Find next rec in the pool
	LOOP
		ADDI	XCUR,(XLEN)	;XCUR points to the next
					; rec. in pool
		CAIL	XCUR,(XTOP)
		GOTO	PHASE4		;End of pool
	AS
		LF	XLNK,ZDNLNK(XCUR)
		JUMPN	XLNK,FALSE	;Referenced rec.
		LENGTH
		GOTO	TRUE		;Not referenced rec.
	SA

	;Update internal pointers in the new record
	;i.e. add the difference  new address [ZDNLNK(XCUR)]
	; - old address [XCUR]  to the internal pointer location

	edit(273)
	ZDNCASE(..)	;[273]

	edit(265)	;[265]
ZDN..:	RFAIL	Bad ptr in XCUR (SAGCN3)

ZAR..:	LF	XLNK,ZDNLNK(XCUR)
	SUBI	XLNK,(XCUR)
	ADDM	XLNK,OFFSET(ZARBAD)(XCUR)		;ZARBAD
	GOTO	SAGCSP

ZER..:	LF	XSTOP,ZERLEN(XCUR)
	ADDI	XSTOP,(XCUR)		;XSTOP points to the first
					; word of the next record
	LF	XLNK,ZDNLNK(XCUR)
	SUBI	XLNK,(XCUR)		;XLNK contains the relocation
					; constant for all internal pointers
					; in this ZER rec.
	LF	XPT,ZERZEV(XCUR)
	IF	;Any free chain in this ZER rec.?
		JUMPE	XPT,FALSE
	THEN
		;Update the free chain
		LI	XZEV,(XPT)
		ADD	XPT,XLNK
		SF	XPT,ZERZEV(XCUR)
		WHILE		;Not end of free chain
			LFE	XPT,ZEVZCH(XZEV)
			JUMPL	XPT,FALSE	;-1 = End of chain
			IFN QDEBUG,<	CAIL	XPT,(XCUR)
				CAIL	XPT,(XSTOP)
				RFAIL	ZEVZCH points out of ZER rec.>
		DO
			LI	XAD,(XZEV)
			LI	XZEV,(XPT)
			ADD	XPT,XLNK
			SF	XPT,ZEVZCH(XAD)
		OD
	FI

	;Step through all ZEV nodes in the ZER rec. and update the link
	; Pointers in used ZEV nodes (i.e. ZEV nodes with ZEVZCH = 0)
	;The ZEVZER pointer is updated at the beginning of PHASE4 since this
	; field is used to find the relocation factor in NEWZEV.

	LI	XZEV,ZER%S(XCUR)
	LOOP
		LF	XPT,ZEVZCH(XZEV)
		IF
			JUMPN	XPT,FALSE
		THEN
			IFN QDEBUG,<
				LOWADR(X1)
				IF
					L	X0,YSASW(XLOW)
					IFOFFA	SWGCTE
					GOTO	FALSE
				THEN		;Log the internal ZEV update
					STACK	X2
					RTEXT	(ZEV-ZBL -ZLL -ZRL at )
					L	X1,XZEV
					OUTOCT
					UNSTK	X2
				FI
			>

			;Update ZEV-ZBL,-ZLL,-ZRL
			LF	XPT,ZEVZBL(XZEV)
			NZEV
			SF	XPT,ZEVZBL(XZEV)	;ZEVZBL

			LF	XPT,ZEVZLL(XZEV)
			NZEV
			SF	XPT,ZEVZLL(XZEV)	;ZEVZLL

			LF	XPT,ZEVZRL(XZEV)
			NZEV
			SF	XPT,ZEVZRL(XZEV)	;ZEVZRL
		FI
		STEP	XZEV,ZEV
	AS
		CAIGE	XZEV,1-ZEV%S(XSTOP)
		GOTO	TRUE
	SA
	GOTO	SAGCSP

NEWZEV:		;Enter with the old ZEV pointer value in XPT
		; Its new value is computed into XPT
	INPOOL
	GOTO	@X0
	LF	XAD,ZEVZER(XPT)
	LF	XLNK,ZDNLNK(XAD)	;New ZER rec. address
	SUB	XLNK,XAD		;New - old ZER rec. address

	IFN QDEBUG,<
		STACK	X0
		LOWADR(X1)
		IF
			L	X0,YSASW(XLOW)
			IFOFFA	SWGCTE
			GOTO	FALSE
		THEN		;Log the ZEV pointer update
			STACK	X2
			RTEXT	(	)
			L	X1,XPT
			OUTOCT
			TEXT	(	)
			L	X1,XPT
			ADD	X1,XLNK
			OUTOCT
			UNSTK	X2
		FI
		UNSTK	X0
	>

	ADD	XPT,XLNK		;Update pointer value
	GOTO	@X0			;Return (NEWZEV called by JSP X0,NEWZEV)


ZPB..:
ZCL..:		;Update ZEV pointers in Simulation and Process block
	LF	XZPR,ZBIZPR(XCUR)
	LOOP			;Search for ZCPGCI \= 0 in prefix chain
		LF	XTYP,ZCPGCI(XZPR)
	AS
		JUMPN	XTYP,FALSE
		LF	X0,ZCPZCP(XZPR)
		JUMPE	X0,FALSE
		L	XZPR,X0
		GOTO	TRUE
	SA
	IF
		CAIE	XTYP,QSUSI
		GOTO	FALSE
	THEN
		;Simulation block

		IFN QDEBUG,<
			LOWADR(X1)
			IF
				L	X0,YSASW(XLOW)
				IFOFFA	SWGCTE
				GOTO	FALSE
			THEN		;Log the Simulation block update
				STACK	X2
				RTEXT	(ZSU-FT -LT at )
				L	X1,XCUR
				OUTOCT
				UNSTK	X2
			FI
		>

		LF	XPT,ZSUFT(XCUR)
		NZEV
		SF	XPT,ZSUFT(XCUR)	;ZSUFT

		LF	XPT,ZSULT(XCUR)
		NZEV
		SF	XPT,ZSULT(XCUR)	;ZSULT

	ELSE
		IF
			CAIE	XTYP,QSUPS
			GOTO	FALSE
		THEN
			;Process block

			IFN QDEBUG,<
				LOWADR(X1)
				IF
					L	X0,YSASW(XLOW)
					IFOFFA	SWGCTE
					GOTO	FALSE
				THEN		;Log the Process block update
					STACK	X2
					RTEXT	(ZPSZEV at )
					L	X1,XCUR
					OUTOCT
					UNSTK	X2
				FI
				>

			LF	XPT,ZPSZEV(XCUR)
			NZEV
			SF	XPT,ZPSZEV(XCUR)	;ZPSZEV
		FI
	FI

ZBI..:				;These rec. types have no
ZBP..:				; internal pointers
ZTT..:
ZTE..:
ZAC..:
ZDR..:
ZYS..:
ZXB..:	GOTO	SAGCSP
	SUBTTL	SAGCNP	(Garbage collector subroutine)

	Comment;

Purpose:	Check if the new pointer in XPT points into the pool.
		If not return at once to SAGCGP or SAGCSP else go to
		SAGCCH (PHASE1) or SAGCUP (PHASE3)
		(i.e. the current address in X16)

Entry:		SAGCNP

Input arguments:	XPT contains the pointer value
			XAD contains the pointer address
			XSW contains the return address

Normal exit:	GOTO	(XSW)
		where XSW has been exchanged with X16 if the new pointer
		points into the pool and will cause a jump to SAGCCH (PHASE1)
		and SAGCUP (PHASE3). X16 will then contain the return
		address from where SAGCNP was called

CALL FORMAT:	NPOINT		(JSP	XSW,SAGCNP)

	;




SAGCNP:	INPOOL
	GOTO	(XSW)
	EXCH 	XSW,X16
	GOTO	(XSW)
	SUBTTL	SAGCOO, SAGCOD	(Garbage collector subroutines)

	Comment;

Purpose:	To output an octal or a decimal number

Entry:		SAGCOO		Output octal number
		SAGCOD		Output decimal number


Input arguments:	X1 (right half) contains the number
			X0 contains the switch word YSASW(XLOW)
			In production version the number is output on TTY
			In test version the number is output on TTY if
				SWGCT2 in X0 is on and on Sysout if SWGCT3
				in X0 is on.

Normal exit:	RETURN

Call format:	EXEC	SAGCOO
		EXEC	SAGCOD


	;

SAGCOO:
	PROC
	SAVE	<X3>
	SETZ	X3,
	LOOP
		LSHC	X1,-3
		AOJ	X3,
	AS
		JUMPN	X1,TRUE
	SA
	LOOP
		SETZ	X1,
		LSHC	X1,3
		ADDI	X1,"0"
		IFN QDEBUG,<
		IFONA	SWGCT2
		>
		OUTCHR	X1
		IFN QDEBUG,<
		IF
			IFOFFA	SWGCT3
			GOTO	FALSE
		THEN
			EXEC	SAPDCO,<X1>
		FI
		>
	AS
		SOJG	X3,TRUE
	SA
	RETURN
	EPROC



SAGCOD:
	PROC
	SAVE	<X3,X4>
	IF
		JUMPL	X1,FALSE
	THEN
		SETZ	X4,
		LOOP
			IDIVI	X1,^D10
			LSHC	X2,-4
			AOJ	X4,
		AS
			JUMPN	X1,TRUE
		SA
		LOOP
			SETZ	X2,
			LSHC	X2,4
			ADDI	X2,"0"
			IFN QDEBUG,<
			IFONA	SWGCT2
			>
			OUTCHR	X2
			IFN QDEBUG,<
			IF
				IFOFFA	SWGCT3
				GOTO	FALSE
			THEN
				EXEC	SAPDCO,<X2>
			FI
			>
		AS
			SOJG	X4,TRUE
		SA
	IFN QDEBUG,<
	ELSE
		TEXT	(negative?)
	>
	FI
	RETURN
	EPROC
	SUBTTL	SAGCSP	(Garbage collector subroutine)

Comment;

Purpose:	Find all pointers in a dynamic record that point to
		other dynamic records and call SAGCNP (NPOINT)
		for each pointer found

Entry:		SAGCSP

Input arguments:	XCUR points to the record to be handled

Normal exit:	NEXT	(GOTO	(XNEXT)	where XNEXT points to SAGCN1
			in PHASE1 and to SAGCN3 in PHASE3)

Output arg.:	XLEN contains the record length.
		XZPR points to the prototype record if present

Call format:	GOTO	SAGCSP

	;




SAGCSP:	edit(273)
	ZDNCASE(.)	;[273]

	edit(265)	;[265]
ZDN.:	RFAIL	Bad ptr in XCUR (SAGCSP)

ZBI.:		;Block instance record
		;Common to ZBI, ZBP, ZPB and ZCL records
	LF	XZPR,ZBIZPR(XCUR)
	LF	XLEN,ZPRBLE(XZPR)

		;Find the offset of the first MAP entry
	LF	XIND,ZBIBNM(XCUR)
	IFE<ZMP%S - 4>,<ASH	XIND,2>		; * 4	( = * ZMP%S)
	IFN<ZMP%S - 4>,<IMULI	XIND,ZMP%S>	; * ZMP%S

	LOOP
		;Loop on the prefix chain if ZCL or ZPB record

		;Find the first variable MAP address
		; (I.E. ZPRMAP + ZMP%S*ZBIBNM)

	    LF	XAD,ZPRMAP(XZPR)
	    IF	;Any map?
		JUMPE	XAD,FALSE
	    THEN
		ADDI	XIND,(XAD)		;XIND = first map address
		LOOP
			;Check the map for the ZBI block and its
			; enclosing blocks
			WLF	XAD,ZMPNRV(XIND)	;Number of REF and
							; ARRAY variables
			IF	;Any REF or ARRAY var.
							edit(215)
				JUMPGE	XAD,FALSE	;[215]
			THEN
				ADDI	XAD,(XCUR)	;Start address
							; in right half
				LOOP
					;Find all REF and ARRAY var. pointers
					L	XPT,(XAD)
					NPOINT
				AS
					AOBJN	XAD,TRUE
				SA
			FI
			WLF	XAD,ZMPNTX(XIND)	;Number of words for
							; TEXT var.
			IF	;Any TEXT var.
				JUMPGE	XAD,FALSE	;[215]
			THEN
				ADDI	XAD,(XCUR)	;Start address
							; in right half
				LOOP
					;Find all TEXT rec. pointers
					LF	XPT,ZTVZTE(XAD)
					NPOINT		;ZTVZTE
				AS
					AOBJP	XAD,FALSE
					AOBJN	XAD,TRUE
				SA
			FI
			LF	XIND,ZMPZMP(XIND)	;Next outer map
		AS
			JUMPN	XIND,TRUE		; If not the outermost
		SA
	    FI
	AS

	    LF	XTYP,ZDNTYP(XCUR)
	    IF	;ZCL or ZPB
		CAIE	XTYP,QZCL
		CAIN	XTYP,QZPB
		GOTO	FALSE
	    THEN	;Check variable maps in prefix chain
		NEXT
	    FI
	    SETZ	XIND,		;BNM=0 in the prefix chain
	    LF	XZPR,ZCPZCP(XZPR)
	    JUMPN	XZPR,TRUE
        SA
	NEXT


ZBP.:		;PROCEDURE
	LF	XZPR,ZBIZPR(XCUR)

		;Check for function procedure type REF or TEXT

	LF	XTYP,ZPCTYP(XZPR)
	IF
		CAIN	XTYP,QREF
		GOTO	TRUE
		CAIE	XTYP,QTEXT
		GOTO	FALSE
	THEN
		LI	XAD,ZBI%S(XCUR)
		HRRZ	XPT,(XAD)
		NPOINT			;Function value location
	FI

	EXEC	SAGCFP		;Check formal parameters
	BRANCH	SAGCDR		;Handle the display rec.
				; and then return to ZBI.

ZCL.:
ZPB.:		;Class and prefixed block
	LF	XZPR,ZBIZPR(XCUR)
	LOOP				;Search for spec. GC index in prefix chain
		LF	XTYP,ZCPGCI(XZPR)
	AS
		JUMPN	XTYP,FALSE
		LF	X0,ZCPZCP(XZPR)
		JUMPE	X0,FALSE
		L	XZPR,X0
		GOTO	TRUE
	SA
	LF	XZPR,ZBIZPR(XCUR)

	IFN QDEBUG,<	SKIPL	XTYP
		CAILE	XTYP,QIOFI
		RFAIL	Wrong ZCPGCI in SAGCSP	>
	GOTO	@SYSTCL(XTYP)

SYSTCL:	SYSCLASS	;Generate jump table

CLPB.:		;Not a  system class
	LOOP
		;Check formal parameters for the class and its
		; enclosing classes
		EXEC	SAGCFP
		LF	XZPR,ZCPZCP(XZPR)
	AS
		JUMPN	XZPR,TRUE
	SA
	LF 	XZPR,ZBIZPR(XCUR)
	BRANCH	SAGCDR		;Handle the display rec.
				; and then return to ZBI.

SUSI.:		;Simulation class


	NPNT(ZSUZPS)			;ZSUZPS



		;In PHASE1
		; Simulation blocks are chained in a special backward chain
		;	with last ref. in YSAZSU(XLOW) and linked in
		;	ZSULNK field
		; ZSUZER records are chained in the usual way but not updated
		;	during PHASE3
		; In PHASE4 the chain mentioned above is followed
		;	and ZER pointers in the sequencing set are updated
		;	(i.e. ZSUZER and ZERZER and ZEVZER pointers)

	IF
		CAIE	XNEXT,SAGCN1
		GOTO	FALSE
	THEN
		LOWADR(XLO)
		L	X0,YSAZSU(XLOW)
		SF	X0,ZSULNK(XCUR)
		ST	XCUR,YSAZSU(XLOW)
				;Chain but don't update ZSUZER
		NPNT(ZSUZER)			;ZSUZER
	FI
	GOTO	CLPB.


SUPS.:		;Process class
SSLG.:		;Linkage class
	NPNT(ZLGSUC)			;ZLGSUC
	NPNT(ZLGPRE)			;ZLGPRE
	GOTO	CLPB.


IOFI.:		;File object
	;ZFISPC is handled as parameter (741121 LE)
	LI	XAD,OFFSET(ZFIIMG)(XCUR)
	LF	XPT,ZTVZTE(XAD)
	NPOINT				;TEXT rec. pointer in ZFIIMG

	IF
		IFOFF	ZFISFD(XCUR)
		GOTO	FALSE
	THEN
		NPNT(ZFIARG)		;ZFIARG
	FI

	IF
		IFOFF	ZFIDE(XCUR)
		GOTO	FALSE
	THEN
		NPNT(ZFIFIL)		;ZFIFIL
	FI

	GOTO	CLPB.




ZTT.:		;Temporary TEXT variable
	LI	XLEN,ZTT%S
	NPNT(ZTTZTE)			;ZTTZTE
	NEXT


ZAR.:		;ARRAY record
	LF	XLEN,ZARLEN(XCUR)
	LF	XTYP,ZARTYP(XCUR)
	IF		;REF or TEXT ARRAY
		CAIN	XTYP,QREF
		GOTO	TRUE
		CAIE	XTYP,QTEXT
		GOTO	FALSE
	THEN
		;Find the address of the first element
		; (i.e. XCUR + 3N + 3 where N = number of subscripts)
		LF	XIND,ZARSUB(XCUR)	;N
		LI	XAD,(XIND)		;N
		ASH	XAD,1			;2N
		ADDI	XAD,3(XIND)		;2N + N + 3 = 3N + 3
		ADD	XAD,XCUR		;XCUR+3N+3

	;Set XSTOP to the address of the first word after the ZAR rec.
		LI	XSTOP,(XLEN)
		ADDI	XSTOP,(XCUR)

		LOOP
			;Step through all elements
			HRRZ	XPT,(XAD)
			NPOINT			;ZTVZTE or REF pointer
			ADDI	XAD,1
			CAIN	XTYP,QTEXT
			ADDI	XAD,1		;2 words for a TEXT ARR. element
		AS
			CAIGE	XAD,(XSTOP)
			GOTO	TRUE
		SA
	FI
	NEXT


ZAC.:		;Accumulator stack record
	LF	XLEN,ZACNAC(XCUR)
	LI	XAD,OFFSET(ZACSVA)(XCUR)
	LF	XIND,ZACZAM(XCUR)
	HLLZ	X0,(XIND)		;X0 = relocation flags in left half
					; for real ac's
	WHILE
		SOJL	XLEN,FALSE
	DO
		ROT	X0,1
		IF
			TRNN	X0,1
			GOTO	FALSE

		THEN
			;Right half must be relocated
			HRRZ	XPT,(XAD)
			NPOINT
		FI
		ADDI	XAD,1
		CAIN	XAD,QNAC+OFFSET(ZACSVA)(XCUR)
		HRLZ	X0,(XIND)		;X0 = relocation flags in
						; left half for pseudo ac's
	OD
	LF	XLEN,ZACNAC(XCUR)
	ADDI	XLEN,2+OFFSET(ZACSVA)
	NEXT


ZER.:		;Event notice record
	LF	XLEN,ZERLEN(XCUR)


		;Chain but don't update ZERZER

	IF
		CAIE	XNEXT,SAGCN1
		GOTO	FALSE
	THEN
		NPNT(ZERZER)			;ZERZER only in PHASE1
	FI

	LI	XAD,OFFSET(ZERZV1)(XCUR)	;XAD points to the first
						; event notice
	LI	XSTOP,(XLEN)
	ADDI	XSTOP,(XCUR)		;XSTOP points to the next rec. in pool
	LOOP
		;Find all ZEVZPS in used ZEV nodes
		IF	;ZEV in use? (i.e. ZEVZCH = 0)
			LF	X0,ZEVZCH(XAD)
			JUMPN	X0,FALSE
		THEN
			LF	XPT,ZEVZPS(XAD)
			NPOINT			;ZEVZPS
		FI
		STEP	XAD,ZEV
	AS
		CAIGE	XAD,1-ZEV%S(XSTOP)
		GOTO	TRUE
	SA
	NEXT


ZDR.:		;Display record
	IFN QDEBUG,<	IF		;PHASE1?
			CAIE	XNEXT,SAGCN1
			GOTO	FALSE
		THEN		;ZDR should not be referenced
			RFAIL	XCUR points to ZDR rec. in SAGCSP PHASE1
		FI	>
ZTE.:		;TEXT record
ZYS.:		;System record (no relocation of contents)
	LF	XLEN,ZYSLG(XCUR)
	NEXT


ZXB.:		;Extended lookup block
	LF	XLEN,ZXBLG(XCUR)
	LF	XPT,ZXBP2(XCUR)
	IF
		;SFD pointer in ZXBP2 if left half = 0

		TLNE	XPT,-1
		GOTO	FALSE
	THEN
		LI	XAD,OFFSET(ZXBP2)(XCUR)
		NPOINT
	FI
	NEXT

	SUBTTL	SAGCUP	(Garbage collector coroutine)

	Comment;

Purpose:	Update a new pointer by executing the instruction in
		XST	with the new value in XPT

Entry:		SAGCUP

Input arguments:	XPT points to the old rec. with the new value in
				its ZDNLNK field
			XST contains the instruction to store XPT at the
				pointer address

Normal exit:	GOBACK		(JSP	X16,(X16))

Call format:	GOTO	(XSW)

	;




SAGCUP:
		IFN	QDEBUG,<
			LOWADR(X1)
			IF
				L	X0,YSASW(XLOW)
				IFOFFA	SWGCTE
				GOTO	FALSE
			THEN
					;Log the update phase
				STACK	X2
				RTEXT
				HRRZ	X1,XAD
				OUTOCT
				TEXT	(	)
				L	X1,XPT
				OUTOCT
				TEXT	(	)
				LF	X1,ZDNLNK(XPT)
				OUTOCT
				UNSTK	X2
			FI
			>
	LF	XPT,ZDNLNK(XPT)	;New pointer value
	HRRI	XST,(XAD)	;Set the address field in XST
	XCT	XST		;Store the new address in the pointer field
	GOBACK
	GOTO	SAGCUP		;Entry for next call on SAGCUP
	SUBTTL	.SAGC	(Garbage collector)

.SAGC:
	PROC

	IFN QSASTE,<

;	If allocation in steps then
;	If X0 = 0 a garbage collection should be forced
;	(.SAGC called from SIMDDT or with YSAREL GT 0)
;	If X0 NE 0 then check if a new step can be allocated
;	without exceeding the garbage collection limit.
;		.JBREL + X0 + YSASTE LT YSABOT +YSAL
;	If so call SANP1 for a CORE request with lowseg size in X2
;	If not do a garbage collection (call SAGC1).

	LOWADR(X16)
	edit(265)	;[265]
	STD	X1,YSASAV+X1(XLOW)
	JUMPE	X0,.SAGC1
	L	X1,.JBREL
	ADD	X1,X0
	ADD	X1,YSASTE(XLOW)
	L	X2,X1
	SUB	X1,YSAL(XLOW)
	CAML	X1,YSABOT(XLOW)
	 GOTO	.SAGC1
	XEC	SANP1
	LD	X1,YSASAV+X1(XLOW)
	RET

.SAGC1:		;Garbage collector main entry

	>	;END IFN QSASTE,
	IFE QSASTE,<LOWADR X16>

	edit(265)	;[265] Save X0,X3-X15 (X1,X2 already saved)
	ST	X0,YSASAV+X0(XLOW)
	LI	YSASAV+X3(XLOW)
	HRLI	X3
	BLT	YSASAV+X15(XLOW)


	IFON	SWNOGC(XLOW)
	 SAERR	0,Garbage collection not possible

	SETON	SWNOGC(XLOW)	;Indicate GC started

	IFN QDEBUG,<
	IF	L	X0,YSASW(XLOW)
		IFOFFA	SWGCTE
		GOTO	FALSE
	THEN	;Start log output
		RTEXT(GARBAGE COLLECTION STARTED)
	FI
	>

	STACK	YDSCSW(XLOW)	;Save ^C-REENTER switch
	SKIPN	YDSCSW(XLOW)
	 CDEFER			;Defer call on SIMDDT

	IF	;Pool to be expanded at the top
		SKIPE	YSAREL(XLOW)
		GOTO	FALSE
	THEN	L	X0,YSALIM(XLOW)
		SUB	X0,YSATOP(XLOW)	;Let X0(saved) be the minimum amount
		ADDM	X0,X0+YSASAV(XLOW); of free pool area needed
	FI

		;Update parameters for calculation of new garbage collection
		; limit and step size

;***AUBEG
IFN QKI10,<
edit(175)	;[175]
	EXTERN	.JBPFH
	IF	;Page fault handler is in core
		SKIPN	.JBPFH
		GOTO	FALSE
	THEN
		L	X1,[%VMSPF]
		GETTAB	X1,
		SETZ	X1,
		HLRZ	X1,X1
		L	X0,X1
		SUB	X1,YSANWA(XLOW)	;NIW faults between gc:s
		ST	X1,YSANWB(XLOW)
		HRLZ	X1,X1
		ADDM	X1,YSANWC(XLOW)	;Accumulate between gc:s
		ST	X0,YSANWA(XLOW)
	FI
>
;***AUEND
	AOS	YSAGCN(XLOW)		;Increment GC counter
	SETZ	X0,
	RUNTIM	X0,
	L	X1,YSATIM(XLOW)
	ST	X0,YSATIM(XLOW)		;Update TIM
	SUB	X0,X1
	FLTR	X0,X0
	ST	X0,YSATAU(XLOW)		;TAU:=run time before GC
	L	X1,YSAFES(XLOW)
	ST	X1,YSAFLA(XLOW)		;Save last F^
	L	X2,YSAL(XLOW)
	FLTR	X2,X2
	FSBR	X2,X1			;L-F^
	IF
		JUMPE	X0,FALSE	;R unchanged if TAU = 0
		JUMPLE	X2,FALSE	; or if L-F^ <= 0
	THEN
		FDVR	X2,X0			;/TAU
		ST	X2,YSAR(XLOW)		;R:=(L-F^)/TAU
	FI

		;Set XTOP and XBOT

	L	XTOP,YSATOP(XLOW)	;Top of pool
	L	XBOT,YSABOT(XLOW)	;Bottom of pool

	IFN QDEBUG,<

		;In debug version a buffer ring for GCP.TMP is needed
		; (see .SAGI). In this case .SAGC is called with
		; an empty pool

	IF
		CAME	XTOP,XBOT
		GOTO	FALSE
	THEN
		;Here in debug version to get buff for GCP.TMP
		;Just ask for more core and set new pool limit

		L	X0,YSAREL(XLOW)
		ADDI	X0,(XBOT)
		ST	X0,YSABOT(XLOW)
		ST	X0,YSATOP(XLOW)
		L	X0,.JBREL
		ADD	X0,YSAREL(XLOW)
		L	XFROTO,.JBREL
		CORE	X0,
		 SAERR	1,CORE failed
		edit(65)
	IFN QZERO,<;[65]
		SETZM	(XFROTO)	;Zero new core just for sure
		HRL	XFROTO,XFROTO
		ADDI	XFROTO,1
		BLT	XFROTO,@.JBREL
	>

		L	X0,.JBREL
		HRRM	X0,.JBFF
		SUBI	X0,QSALIM
		ST	X0,YSALIM(XLOW)
		BRANCH	SAGCEX		;Exit at once without any updating
	FI
	>
	SUBTTL	SAGC (Garbage collector) PHASE 1

PHASE1:		;Chain all referenced dynamic records
		; SAGCGP and SAGCSP communicate with the coroutine
		; SAGCCH via SAGCNP

	IFN QDEBUG,<
			L	 X0,YSASW(XLOW)
			IF
				IFOFFA	SWGCTE
				GOTO	FALSE
			THEN	;Title in log output
				RRTEXT	(Chain record at)
			FI>

	LI	X16,SAGCCH	;X16 should contain the address of the routine
				; to be called when a new pointer is found with
				; a value pointing into the pool, and that is
				; SAGCCH during PHASE1.

	EXEC	SAGCGP		;Start with global pointers
	LI	XCUR,(XNEXT)	;Go on with pointers in records in the chain
				; Start of chain saved in XNEXT (SAGCGP)
	LI	XNEXT,SAGCN1	;NEXT will call SAGCN1 in PHASE1
	JUMPE	XCUR,PHASE2	;No chain to search
	BRANCH	SAGCSP		;Start searching for pointers in all chained
				; records, and chain new referenced records.
	SUBTTL	SAGC (Garbage collector) PHASE 2

PHASE2:		;Return here from SAGCN1 when there are no more records in the
		; chain

	HLLOS	OFFSET(ZDNLNK)(XEND)	;Set -1 in ZDNLNK to mark
					; that the last rec in the chain
					; is referenced

	;Step through the pool and compute new addresses for all referenced
	; records, and store the new addresses in their ZDNLNK field.
	; Collect adjacent unreferenced records to one ZYS record
	; with the total length in ZYSLG


	LOWADR	(X16)

	IFN QDEBUG,<
			L	X0,YSASW(XLOW)
			IF
				IFOFFA	SWGCTE
				GOTO	FALSE
			THEN
				;Title in the log output
				RRTEXT	(Rec. at	to	length)
			FI>

	L	XAD,YSAREL(XLOW)	;The quantity to be added to YSABOT
					; if the pool must be moved upwards
	ADDI	XAD,(XBOT)
	ST	XAD,YSABOT(XLOW)	;New start address of the pool
	LI	XCUR,(XBOT)		;Start at the bottom
	LOOP	;Thru the pool
		LENGTH			;XLEN := length of rec. at XCUR
		LF	XLNK,ZDNLNK(XCUR)
		IF	;Not referenced
			JUMPN	XLNK,FALSE
		THEN	;Make a ZYS rec. of unreferenced neighbours
			LI	XPT,(XCUR)
			LI	XTOT,(XLEN)
			SETF	QZYS,ZDNTYP(XPT)
			WHILE
				ADDI	XCUR,(XLEN)
				CAIL	XCUR,(XTOP)
				GOTO	FALSE
			DO
				LENGTH
				LF	XLNK,ZDNLNK(XCUR)
				JUMPN	XLNK,FALSE
				ADDI	XTOT,(XLEN)
			OD
			SF	XTOT,ZYSLG(XPT)
			edit(273)	;[273] Do not relocate below YSAFRZ
			CAMG	XCUR,YSAFRZ(XLOW)
			 ADDI	XAD,(XTOT)
		ELSE
			IFN QDEBUG,<
				IF
					L	X0,YSASW(XLOW)
					IFOFFA	SWGCTE
					GOTO	FALSE
				THEN
					;Log output
					RTEXT
					L	X1,XCUR
					OUTOCT
					TEXT	(	)
					L	X1,XAD
					OUTOCT
					TEXT	(	)
					L	X1,XLEN
					OUTOCT
				FI
				>

			SF	XAD,ZDNLNK(XCUR) ;Store new address
			ADDI	XAD,(XLEN)	;XAD:=new address for next rec.
			ADDI	XCUR,(XLEN)
		FI
	AS
		CAIGE	XCUR,(XTOP)
		GOTO	TRUE	;Check next rec. in pool
	SA
	;Now XAD = the new YSATOP
	; IF XAD + X0(saved) + QSALIM > .JBREL,
	; ask for more core and update YSALIM(XLOW)


	ST	XAD,YSATOP(XLOW)

IFN QSADEA,<	;Update YSADEA (the deallocation pointer)
		; If YSADEA points to a referenced rec. get its new
		; address else set YSADEA to the new YSATOP value

		L	XPT,YSADEA(XLOW)
		LF	XPT,ZDNLNK(XPT)
		SKIPN	XPT
		 L	XPT,XAD
		ST	XPT,YSADEA(XLOW)
	>

	ADD	XAD,X0+YSASAV(XLOW)
	ADDI	XAD,QSALIM
	IF	;More core needed
		CAMG	XAD,.JBREL
		GOTO	FALSE
	THEN
	    L	XFROTO,.JBREL
	    IF
		CORE	XAD,
		GOTO	FALSE
	    THEN
		L	XAD,.JBREL
		HRRM	XAD,.JBFF

			edit(65)
		IFN QZERO,<;[65]
		SETZM	(XFROTO)	;Zero new core just for sure
		HRL	XFROTO,XFROTO
		ADDI	XFROTO,1
		BLT	XFROTO,(XAD)
		>

		SUBI	XAD,QSALIM
		ST	XAD,YSALIM(XLOW)
	    ELSE
		;Restore XTOP and XCB for SIMDDT

		ST	XTOP,YSATOP(XLOW)
		L	XCB,XCB+YSASAV(XLOW)
		 SAERR	1,Cannot get enough core for object pool
	    FI
	FI
	SUBTTL	SAGC (Garbage collector) PHASE 3

PHASE3:
		;Update all dynamic pointers in referenced records
		; SAGCGP and SAGCSP communicate with the coroutine
		; SAGCUP via SAGCNP
		;All internal pointers (except ZEVZER) are also updated
		; via the NEXT routine SAGCN3

	IFN QDEBUG,<
			L	X0,YSASW(XLOW)
			IF
				IFOFFA	SWGCTE
				GOTO	FALSE
			THEN
				;Title in log output
				RRTEXT	(Pointer	old val	new val)
			FI>

	LI	X16,SAGCUP
	OP	XST,(HRRM  XPT,);Set the default store inst. in XST
	EXEC	SAGCGP		;Start with global pointers
	LI	XCUR,(XBOT)	;Go on with pointers in the pool
	LI	XNEXT,SAGCN3	;NEXT will jump to SAGCN3
	GOTO	SAGCSP		;Step through the pool
	SUBTTL	SAGC (Garbage collector) PHASE 4

PHASE4:
		;Return here from SAGCN3 when the last record in the pool
		; has been handled


		;Update sequencing set chains and ZEVZER in all ZER records

	LOWADR(X16)
	L	XCUR,YSAZSU(XLOW)
	SETZM	YSAZSU(XLOW)
	WHILE	;More SIMULATION blocks on chain
		JUMPE	XCUR,FALSE
	DO
		LF	XPT,ZSUZER(XCUR)
		LI	XAD,OFFSET(ZSUZER)(XCUR)
		WHILE
			;ZER rec found
			JUMPE	XPT,FALSE
		DO
			;Update all internal pointers in this ZER and
			; the ZER chain. ZDNLNK contains the new address.

			LF	XLNK,ZDNLNK(XPT)
			HRRM	XLNK,(XAD)	;Update ZER chain
						; (ZSUZER or ZERZER)
			IFN QDEBUG,<
				L	X0,YSASW(XLOW)
				IF
					IFOFFA	SWGCTE
					GOTO	FALSE
				THEN
					;Log the update of ZSUZER and ZERZER
					RTEXT	(ZER-pointer at )
					L	X1,XAD
					OUTOCT
					RTEXT	(	)
					L	X1,XPT
					OUTOCT
					TEXT	(	)
					L	X1,XLNK
					OUTOCT
				FI
			>
			;Step through the ZER rec and update all ZEVZER
			LI	XZEV,OFFSET(ZERZV1)(XPT)
			LF	XSTOP,ZERLEN(XPT)
			ADDI	XSTOP,(XPT)
			LOOP
				IFN QDEBUG,<
					L	X0,YSASW(XLOW)
					IF
						IFOFFA	SWGCTE
						GOTO	FALSE
					THEN
						;Log the ZEVZER update
						RTEXT
						LI	X1,OFFSET(ZEVZER)(XZEV)
						OUTOCT
						TEXT	(	)
						LF	X1,ZEVZER(XZEV)
						OUTOCT
						TEXT	(	)
						L	X1,XLNK
						OUTOCT
					FI
				>
				SF	XLNK,ZEVZER(XZEV)
			AS
							;Next ZEV in ZER rec.
				STEP	XZEV,ZEV
				CAIGE	XZEV,1-ZEV%S(XSTOP)
				GOTO	TRUE
			SA
			LI	XAD,OFFSET(ZERZER)(XPT)	;Next ZER rec. in chain
			LF	XPT,ZERZER(XPT)
		OD
		LF	X0,ZSULNK(XCUR)
		ZF	ZSULNK(XCUR)
		L	XCUR,X0		;Next SIMULATION block in chain
	OD
;Step through the pool a third time and move all referenced
; records to the new address and clear their ZDNLNK field

	SETZB	XBEG,XSAV
	LI	XCUR,(XBOT)
	LOOP
		;Find the first rec. to be moved towards the bottom of
		; the pool
		LF	XLNK,ZDNLNK(XCUR)
		JUMPE	XLNK,L2		;Unreferenced

			;Find first referenced rec.
			;  in pool that has to be moved

		IF	;Not found yet
			JUMPN	XBEG,FALSE
		THEN
			IF
				CAIE	XLNK,(XCUR)
				GOTO	FALSE
			THEN
				ZF	ZDNLNK(XCUR)
				GOTO	L2	;Ref. rec. at top of pool
						; need not be moved
			FI
			LI	XBEG,(XCUR)	;XBEG points to the first rec.
						; in the pool that must be moved
		FI
		CAIG	XLNK,(XCUR)
		GOTO	FALSE			;The first rec. to be moved
						; towards the bottom is found
		LI	XSAV,(XCUR)		;Save the latest referenced rec.
L2():!		LENGTH
		ADDI	XCUR,(XLEN)
	AS
		CAIGE	XCUR,(XTOP)
		GOTO	TRUE			;Handle next rec.
		IFN QDEBUG,<	CAIE	XCUR,(XTOP)
			RFAIL	No match XCUR-XTOP at end of pool>

	SA
	LI	XPT,(XCUR)	;XPT points to the first rec. to be
				; moved towards the bottom
	JUMPE	XSAV,L3		;No records are to be moved towards the top
	LI	XCUR,(XSAV)	;XCUR points to the rec. with the highest
				; address that must be moved towards the top
	LENGTH
	LF	XAD,ZDNLNK(XCUR)
	ADDI	XAD,(XLEN)	;XAD points to the first word in the new rec.
				; area of the first rec. moved towards
				; the bottom

				edit(72)
	LI	XCUR,(XBEG)	;[72] Generate backward chain in records to be
				;[72] moved towards the top
	SETZ	XFROM,0		;[72] End of chain
	LOOP
		;All rec's to be moved towards the top are moved with a BLT or
		; if the old and the new area overlap with a word by word
		; transfer starting with the last word in the rec.

		LF	XLNK,ZDNLNK(XCUR)
		LENGTH

		;Check if the referenced rec. with the highest address
		; overlaps with its new area,
		; i.e. the rec. whose ZDNLNK points to an address (XLEN) less
		; than (XAD), where XAD points to the first occupied word
		; in the new pool


		IF
			JUMPE	XLNK,FALSE
			SF	XFROM,ZDNLNK(XCUR)	;[72] Insert back chain
			LI	XFROM,(XCUR)		;[72] Save new chain addr
			LI	X0,(XLNK)
			ADDI	X0,(XLEN)
			CAIE	X0,(XAD)
			GOTO	FALSE
		THEN
L4():!			;[72]
			;Next rec. to be moved is found
			LI	XFROM,(XCUR)
			ADDI	XFROM,(XLEN)
			LF	XBEG,ZDNLNK(XCUR)	;[72] Next record addr
			ZF	ZDNLNK(XCUR)		;[72] Clear link field
			IF	;Overlap
				CAIG	XFROM,(XLNK)
				GOTO	FALSE
			THEN	;Move word by word
				IFN QDEBUG,<
					LOWADR(X1)
					IF
						L	X0,YSASW(XLOW)
						IFOFFA	SWGCTE
						GOTO	FALSE
					THEN
						;Log upward overlap move
						STACK	X2
						RTEXT	(Rec at )
						L	X1,XCUR
						OUTOCT
						TEXT( overlap moved to )
						L	X1,XLNK
						OUTOCT
						TEXT	( length )
						L	X1,XLEN
						OUTOCT
						UNSTK	X2
					FI
					>

							;[72]
				LOOP
					;Move one word at a time
					SUBI	XAD,1
					SUBI	XFROM,1
					L	X0,(XFROM)
					ST	X0,(XAD)
				AS
					CAIN	XFROM,(XCUR)
					GOTO	FALSE	;The first word in the
						; old area is moved -> the whole
						; rec. is moved, and XAD points
						; to the first occupied word in
						; the new pool
					GOTO	TRUE	;Move the next word
				SA
			ELSE	;No overlap, use BLT
							;[72]
				LI	XAD,(XLNK)
				LI	XFROTO,(XLNK)
				HRLI	XFROTO,(XCUR)
				ADDI	XLNK,-1(XLEN)


			IFN QDEBUG,<
				LOWADR(X1)
				IF
					L	X0,YSASW(XLOW)
					IFOFFA	SWGCTE
					GOTO	FALSE
				THEN
					;Log upward BLT move
					STACK	X2
					RTEXT	(Rec at )
					HLRZ	X1,XFROTO
					OUTOCT
					TEXT	( BLT to )
					HRRZ	X1,XFROTO
					OUTOCT
					TEXT	( length )
					L	X1,XLEN
					OUTOCT
					UNSTK	X2
				FI
				>


				BLT	XFROTO,(XLNK)
			FI
			edit(72)
			;[72]  Next record to be moved has address XBEG
			;Calculate the address to which it should be moved
			JUMPE	XBEG,L3		;No more records are to be moved
			LI	XCUR,(XBEG)	;Next record address
			LENGTH
			LI	XLNK,(XAD)	;XAD points to the first occupied
						;word in the new pool
			SUBI	XLNK,(XLEN)	;New record address after the move
			GOTO	L4
		FI		;[72] END
			;Search for next rec. to be moved
		ADDI	XCUR,(XLEN)
		IFN QDEBUG,<	CAIL	XCUR,(XTOP)
			RFAIL	XCUR points out of the pool >
			;[72]
	AS
		GOTO	TRUE
	SA
L3():!		;Move the remaining ref. rec. towards the bottom with a BLT
		; for each rec.

	LI	XCUR,(XPT)
	WHILE
		;Records left
		CAIL	XCUR,(XTOP)
		GOTO	FALSE		;All records in the old pool are checked
					; and moved to the new pool if
					; referenced
	DO
		LF	XLNK,ZDNLNK(XCUR)
		LENGTH
		IF	;Referenced
			JUMPE	XLNK,FALSE
		THEN
			;Move a referenced record and clear ZDNLNK
			ZF	ZDNLNK(XCUR)
			LI	XFROTO,(XLNK)
			HRLI	XFROTO,(XCUR)
			ADDI	XLNK,-1(XLEN)


			IFN QDEBUG,<
				LOWADR(X1)
				IF
					L	X0,YSASW(XLOW)
					IFOFFA	SWGCTE
					GOTO	FALSE
				THEN
					;Log downward BLT move
					RTEXT	(Rec at )
					HLRZ	X1,XFROTO
					OUTOCT
					TEXT	( BLT to )
					HRRZ	X1,XFROTO
					OUTOCT
					TEXT	( length )
					L	X1,XLEN
					OUTOCT
				FI
				>

			BLT	XFROTO,(XLNK)
		FI
		ADDI	XCUR,(XLEN)	;Check next record
	OD
	IFN QDEBUG,<	CAIE	XCUR,(XTOP)
		RFAIL	No match XCUR-XTOP at end of SAGC>

	LOWADR(X16)
	;Clear freed area at the top
	L	XFROTO,YSATOP(XLOW)
	IF
		CAIL	XFROTO,(XTOP)
		GOTO	FALSE
	THEN
		SETZM	(XFROTO)
		IF	;More than one word freed
			CAIL	XFROTO,-1(XTOP)
			GOTO	FALSE
		THEN
			HRLI	XFROTO,(XFROTO)
			ADDI	XFROTO,1
			BLT	XFROTO,-1(XTOP)
		FI
	FI

	;Clear freed area at the bottom
	LI	XFROTO,(XBOT)
	L	XSTOP,YSABOT(XLOW)
	IF
		;At least one word freed
		CAIL	XFROTO,(XSTOP)
		GOTO	FALSE
	THEN
		SETZM	(XFROTO)
		IF	;More than one word freed
			CAIL	XFROTO,-1(XSTOP)
			GOTO	FALSE
		THEN
			HRLI	XFROTO,(XFROTO)
			ADDI	XFROTO,1
			BLT	XFROTO,-1(XSTOP)
		FI
	FI


	;Update YSATIM and set X6 to garbage collection runtime
	; and output on TTY in debug version

	SETZ	X6,
	RUNTIM	X6,
	L	X1,YSATIM(XLOW)
	ST	X6,YSATIM(XLOW)
	SUBB	X6,X1		;X6 := X1 := TAUGC  (fixed)
	IFN QDEBUG,<
	IF
		L	X0,YSASW(XLOW)
		IFOFFA	SWGCT4
		GOTO	FALSE
	THEN
		;Log the g.c. time
		RTEXT( RUNTIME:  )
		OUTDEC
	FI
	>
	ADDM	X6,YSAGCT(XLOW)	;Accumulate GC time

	EXEC	.SANP		;Determine free storage pool area
				; and allocate a first step
				; (or if QSASTE=0 the whole pool)

	IFN QDEBUG,<
	IF
		L	X0,YSASW(XLOW)
		IFOFFA	SWGCT4
		GOTO	FALSE
	THEN
		;Log the new low segment limit
		L	X1,.JBREL
		RTEXT(LOW SEGMENT LIMIT:  )
		EXEC	SAGCOO
		RTEXT
	FI
	>
;** EXIT **

SAGCEX:
	LOWADR	(X16)
	UNSTK	YDSCSW(XLOW)		;Restore ^C-REENTER switch
	SETOFF	SWNOGC(XLOW)		;Indicate GC finished
	SETZM	YSAREL(XLOW)


IFN QDEBUG,<
	;Output the last line on Sysout if Sysout used for dump and log output
	IFON	SWGCT3(XLOW)
	EXEC	SAPDOI
>

	;Restore ac's

	MOVSI	X16,YSASAV(XLOW)		; YSASAV(XLOW),, 0
	BLT	XLOW,X15
	LOWADR (X16)

	RETURN

	EPROC
	SUBTTL	.SAGI	(Garbage collector initializations)

	Comment;

Purpose:	Open in append mode GCP.TMP in debug version
		and initialize garbage collection parameters

Entry:		.SAGI

Input arguments:
		YSABOT(XLOW) should be initialized to
		needed low seg. area excluding the storage pool.
		YRUNTM(XLOW) should be set to execution start time.

Normal exit:	RETURN

Call format:	EXEC	.SAGI

Used subroutines:	SANP1, SANP2, GETBUFF, LINKBUFF


	;




.SAGI:	PROC
	SAVE	<X0,X1,X2,X3,X6,X7>

	LOWADR(X16)
	IFN QDEBUG,<
	SETOFF	SAGCPE(XLOW)
	LI	X6,QBUFS	;Buffer size
	LI	X7,2		;Number of buffers
	GETBUFF
	ST	X1,YSABH(XLOW)
	LI	X2,1(X1)	;Buffer header address returned by GETBUFF
	HRL	X2,X2
	LI	X0,.IOBIN	;Mode
	MOVSI	X1,'DSK'
	IF
		OPEN	QCHGCP,X0
		GOTO	FALSE
	THEN
		L	X1,YSABH(XLOW)
		LINKBUFF
		LF	X0,ZBHBUP(X1)
		HRLI	X0,4400
		SF	X0,ZBHBUP(X1)
		LI	X0,200
		SF	X0,ZBHCNT(X1)
		PJOB	X1,		;Job number in X1
		;Convert to sixbit in X0 left half

		IDIVI	X1,^D100
		IDIVI	X2,^D10
		LSH	X1,^D12
		LSH	X2,6
		ADD	X1,X2
		ADD	X1,X3
		HRL	X0,X1
		TLO	X0,202020

		HRRI	X0,'GCP'
		MOVSI	X1,'TMP'
		SETZB	X2,X3
		IF
			LOOKUP	QCHGCP,X0
			GOTO	FALSE
		THEN
L1():!			SETZ	X3,
			IF
				ENTER	QCHGCP,X0
				GOTO	FALSE
			THEN
				L	X1,YSABH(XLOW)
				CLAIMBUFF
				USETI	QCHGCP,-1	;End of file
				IF
					OUT	QCHGCP,	;Initial OUT
					GOTO	FALSE
				THEN
					SETON	SAGCPE(XLOW)
					OUTSTR	[ASCIZ	/Err 1:st OUT GCP/]
				FI
			ELSE
L2():!				SETON	SAGCPE(XLOW)
				OUTSTR	[ASCIZ	/ENTER error GCP.TMP/]
			FI
		ELSE
				;Create a file if not already present

			ENTER	QCHGCP,X0
			GOTO	L2
			CLOSE	QCHGCP,
			LOOKUP	QCHGCP,X0
			SKIPA
			GOTO	L1
			SETON	SAGCPE(XLOW)
			OUTSTR	[ASCIZ	/LOOKUP error GCP.TMP/]
		FI
	ELSE
		SETON	SAGCPE(XLOW)
		OUTSTR	[ASCIZ	/OPEN error GCP.TMP/]
	FI

	;Initialize for dump output on Sysout

	L	X1,YSATOP(XLOW)
	ST	X1,YSAIMP(XLOW)		;Local image pointer
	HRLZI	X0,^D72
	ST	X0,YSAILC(XLOW)		;ZTVLNG,,ZTVCP
	HRLZI	X0,QZTE
	ST	X0,(X1)			;ZDN word for a text record
					; placed at the bottom of the pool
	LI	X0,^D17
	ADDM	X0,YSATOP(XLOW)
	ADDM	X0,YSABOT(XLOW)		;Let Image be outside the pool
	HRLI	X0,^D72
	ST	X0,1(X1)		;ZTECLN,,ZTELEN
	LI	X0,OFFSET(ZTECHR)(X1)
	HRLI	X0,440700		;POINT 7,ZTECHR,
	ST	X0,YSAIBP(XLOW)		;Local image byte pointer

	SETON	SWGCT2(XLOW)		;Default is log and dump output
					;  on TTY
	>


	;Initialize garbage collection parameters for garbage collection
	; limit and step size calculations.


	SETZM	YSAGCN(XLOW)	;Number of gc:s
	SETZM	YSAGCT(XLOW)	;Accumulated GC time
;***AUBEG
IFN QKI10,<
edit(175)	;[175]
	L	X1,[%VMSPF]
	GETTAB	X1,
	SETZ	X1,
	HLRZ	X1,X1
	ST	X1,YSANWA(XLOW)
>
;***AUEND
	L	YRUNTM(XLOW)
	ST	YSATIM(XLOW)	;TIM := execution start time
	MOVSI	QSAF0
	ST	YSAFES(XLOW)	;F^ := F0
	MOVSI	QSAR0
	ST	YSARES(XLOW)	;R^ := R0
	MOVSI	QSAB0
	ST	YSABES(XLOW)	;B^ := B0

	IFN QSASTE,<
	L	X2,YSABOT(XLOW)
	ADDI	X2,QSALIM+QSAPMI
	EXEC	SANP1
	L	X2,.JBREL
	ADDI	X2,QPOLMI
	SUB	X2,YSABOT(XLOW)
	ST	X2,YSAL(XLOW)	;L := first garb.coll. limit
	LI	X2,QSAPMI
	ST	X2,YSASTE(XLOW)	;Initialize step size
	>

	IFE QSASTE,<
	L	X1,.JBREL
	SUB	X1,YSABOT(XLOW)
	ST	X1,YSAL(XLOW)	;L:=free pool area
	>


	RETURN
	EPROC
	SUBTTL	.SAIN	(initialize ref and array)

; Purpose:	To initialize any ref and/or array variables in a block.

; Input:	Prototype address in XSAC, block address in XRAC.

; Function:	If ZPRMAP(XSAC) =/= 0 and ZMPNRV of the map =/= 0,
;		set the variables to NONE.

.SAIN:	PROC
	SAVE	XSAC
	LF	XSAC,ZPRMAP(XSAC)
	IF	;Any MAP
		JUMPE	XSAC,FALSE
	THEN
		WLF	XSAC,ZMPNRV(XSAC)
		IF	;Any REF or ARRAY variable
			JUMPE	XSAC,FALSE
		THEN
			ADDI	XSAC,(XRAC)
			LI	NONE
			LOOP
				ST	(XSAC)
			AS
				AOBJN	XSAC,TRUE
			SA
		FI
	FI
	RETURN
	EPROC
	SUBTTL	.SANP	(New pool)

	Comment;

Purpose:	To determine a new g.c. limit  and
		 IFN QSASTE,< a new optimal step size and>
		make a core request for low. seg area needed

Function:	New g.c. limit  (L) :=
		IFN QSASTE,<:= F^ [ 1 + SQRT( 2B^ R^ ( 1 + A/F^ )]>
		IFE QSASTE,<:= F^ [ 1 + SQRT( 1B^ R^ ( 1 + A/F^ )]>

		L := Min (L,CORMAX limit)

		where
		F^ = YSAFES =	active memory
		R^ = YSARES =	allocation rate
		B^ = YSABES =	garbage collection cost
		A  = YSAA   =	accounting dependent parameter

		IFN QSASTE,<

		New step size  YSASTE :=

			     K     4A/W - U*U
		SQRT ( R^ * --- [ ------------ + (X+U) ] )
			     2        X + U


		where expressed in pages and seconds:

		R^ = YSARES = allocation rate   [pages/sec.]
		K  = time for a CORE UUO  approx.= 0.004  [sec.]
		X  = C0 + C1	[pages]
		C0 = YSATOP + YSAHSZ   [pages]
		C1 = YSABOT + YSAL + YSAHSZ   [pages]
		A, W and U are constants that can be evaluated from the
		 accounting  algorithm written on the form:

			TIME * [ A + W(M+U)*M]

		where M is the total number of 512 word pages allocated
		 to the job.

		>	END IFN QSASTE,


	========= N O T E  !!!!!!!!!!!!!!!!!!   =====================
	 the calculation of A = YSAA should be changed in the code
	 as soon as the accounting algorithm is changed to
	 minimize the cost of SIMULA program executions.

	 if QSASTE = 1 the calculation of the step size
	 must also be changed.
	=============================================================


Entries:	.SANP, SANP1, SANP2
		.SANP is the main entry after each gc
		SANP1 is the entry point to set the storage pool
			to the initial value and allocate core
		SANP2 is the entry to set the pool to the initial
			value if enough core already allocated

Input arguments: At entry to SANP1 X0 should contain the low segment
		 area needed

Normal exit:	RETURN

Call format:	EXEC	.SANP
		EXEC	SANP1
		EXEC	SANP2

Used local subroutines:	SANPSQ, SANPDU

	;




	DEFINE	NEWEST(P,XREG)	<

	;;Compute a new estimate by exponential smoothing of parameter P
	;; into register XREG and store the result in YSA'P'ES(XLOW)
	;; it is assumed that X0 contains the observed value of P

 	;; P^ := (P + LP * P^)/(1 + LP) = (P + LP*P^)/L1P
	;; where
	;; P^ = YSA'P'ES
	;; LP = QSAL'P
	;; L1P= QSAL1'P = QSAL'P + 1

	L	XREG,YSA'P'ES(XLOW)
	FMPRI	XREG,QSAL'P
	FADR	XREG,X0
	FDVRI	XREG,QSAL1'P
	ST	XREG,YSA'P'ES(XLOW)
	>

	SUBTTL	SANPSQ

	Comment;

Purpose:	Floating point single precision square root function

Function:	The square root of the arg. in X1 is calculated.
		The arg. is written in the form
		arg. = frac * (2**2b)
		where 0 < frac < 1
		Sqrt(arg.) is then calculated as
		Sqrt(frac) * (2**b)
		Sqrt(frac) is calculated by a linear approximation, the nature
		of which depends on whether 1/4 < frac < 1/2 or 1/2 < frac < 1
		followed by two iterations of Newton's method.

Entry:		SANPSQ

Input arguments: X1  contains the input arguments

Normal exit:	RETURN

Output arguments: X0 contains the result

Call format:	EXEC	SANPSQ

	;




SANPSQ:	PROC
				;X0:=SQRT(X1)
	SETZ	X0
	JUMPE	X1,L9		;X1 = 0
	LSHC	X0,^D9		;Get exp. to X0
	SUBI	X0,201		;Get true exp. -1
	ROT	X0,-1		;Divide by 2 and
				; if true exp. even the sign bit in X0
				; will be set
	HRRM	X0,X3		;And store for FSC instr.
	LSH	X1,-^D9		;Restore fraction in X1
	IF 	;True exp is odd
		JUMPL	X0,FALSE
	THEN
		FSC	X1,177		;Halve and scale fraction
		ST	X1,X4		;Now .25 <= X1 <  .5
		FMPRI	X1,200640	;Compute approx1
		FADRI	X1,177465
	ELSE	;Even true exp
		FSC	X1,200		;Scale fraction
		ST	X1,X4		;Now .5 <= X1 < 1
		FMPRI	X1,200450	;Compute approx1
		FADRI	X1,177660
	FI
	L	X0,X4		;1:st iteration of Newton
	FDV	X0,X1		;frac/approx1
	FAD	X1,X0		;approx1 + frac/approx1
	FSC	X1,-1		;Halve
	L	X0,X4		;2:nd iteration of Newton
	FDV	X0,X1		;frac/approx2
	FADR	X0,X1		;approx2 + frac/approx2
	FSC	X0,(X3)		;Halve and scale
L9():!	RETURN			;Result in X0


	EPROC
	SUBTTL	SANPDU

	Comment;

Purpose:	To dump GC parameter values on GCP.TMP

Function:	If debug version and if SAGCPE is off (i.e. GCP.TMP
		is ready to receive output data) the GC parameters are
		moved with a BLT to the out buffer and written on the
		file GCP.TMP when the buffer is filled.

Entry:		SANPDU

Normal exit:	RETURN

Call format:	EXEC	SANPDU

	;



	IFN QDEBUG,<
SANPDU:	PROC
	SETLOW(X16)
	IFON	SAGCPE(XLOW)
	RETURN

	WHILE
		L	X1,YSABH(XLOW)
		LF	X2,ZBHCNT(X1)		;Byte counter
		SUBI	X2,YSAEND-YSASTA
		JUMPGE	X2,FALSE
	DO
		IF
			OUT	QCHGCP,
			GOTO	FALSE
		THEN
			SETON	SAGCPE(XLOW)
			OUTSTR	[ASCIZ	/OUT error GCP.TMP/]
			RETURN
		FI
	OD
	SF	X2,ZBHCNT(X1)	;Byte counter
	LF	X2,ZBHBUP(X1)	;Byte pointer
	LI	X3,1(X2)	;First free data word in buffer
	HRRI	X2,YSAEND-YSASTA(X2) ;Next pointer value
	SF	X2,ZBHBUP(X1)
	HRLI	X3,YSASTA(XLOW)
	BLT	X3,(X2)
	RETURN

	EPROC
	>
	SUBTTL	SANP1

	Comment;

Purpose:	To make a core request for the low seg area needed
		in version with step allocation (QSASTE=1)

Function:	After the core request, if QZERO is non-zero
		the new core is zeroed.
		A new limit for the object pool is determined

Entry:		SANP1

Input arguments:	X2 contains the number of words needed in low segment

Output arguments:	X2 contains maximum number of 1K core blocks
			available to the user

Normal exit:	RETURN

Error exit:	SAERR 1,Cannot get enough core for object pool

Call format:	EXEC	SANP1

	;



	IFN QSASTE,<

SANP1:	PROC
	SETLOW(X16)
IFN QZERO,<L	X1,.JBREL>
	IF
		CORE	X2,
		GOTO	FALSE
	THEN
	ELSE
		;CORE failed, COREMAX in X2 (Kwords)

;***AUBEG
IFN QKI10,<
edit(175)	;[175]
		IF	;Virtual core limits are found
			L	X1,[-1,,.GTCVL]
			GETTAB	X1,
			GOTO	FALSE
		THEN	;NOTE!! Not quite correct!!
			LSH	X1,-1	;Get phys guideline Kwords
			ANDI	X1,3777	;Delete rubbish from GETTAB
			CAMG	X1,X2
			 SUBI	X2,1	;Going virtual:subtract space
					; of PFH
		IFN QZERO,<
		ELSE
			L	X1,.JBREL
		>
		FI
>
;***AUEND
		LSH	X2,^D10		;Pages to words
		SUB	X2,YSAHSZ(XLOW)
		edit(276)	;Do not go beyond hiseg start
		CAILE	X2,377777	;[276]
		 LI	X2,377777	;[276]

		CAMG	X2,.JBREL
		 L	X2,.JBREL	;If more core already allocated in ph2
					; (The truncated P if COREMAX = an odd
					; number of pages)

		CORE	X2,
		SAERR	1,Cannot get enough core for object pool
	FI

		edit(65)
	IFN QZERO,<;[65]
		;Zero new core
	IF	;Expanded
		CAML	X1,.JBREL
		GOTO	FALSE
	THEN
		SETZM	(X1)
		HRL	X1,X1
		ADDI	X1,1
		BLT	X1,@.JBREL
	FI
	>


		;Set new limit for object pool
	L	X1,.JBREL
	HRRM	X1,.JBFF
	SUBI	X1,QSALIM
	ST	X1,YSALIM(XLOW)

	RETURN

	EPROC

	>	;END IFN QSASTE,
	SUBTTL	.SANP	(New pool)
.SANP:
	PROC
	LOWADR(X16)
	L	XCB,XCB+YSASAV(XLOW)	;Restore XCB for SIMDDT
					; if error occurs
Comment;  Check  if  .SAGC called just to move the pool upwards, then
        the upper limit is increased with the amount in  YSAREL(XLOW)
        and  this garbage collection is not considered to determine a
	new dynamic pool area.;
;***AUBEG
IFN QKI10,<
	edit(175)
;[175]	X6 holds TAUGC (time for this gc) on entry.
>
;***AUEND

	IF	;Pool is to be moved upwards
		SKIPN	YSAREL(XLOW)
		GOTO	FALSE
	THEN
		FIX	X0,YSATAU(XLOW)	;Set YSATIM to look as if no
		SUBM	X0,YSATIM(XLOW) ; garb. coll. had occurred
		IFN QSASTE,<
		L	X2,YSATOP(XLOW)
		ADDI	X2,QSALIM+QSAPMI
		CAMLE	X2,.JBREL
		 BRANCH	SANP1
		RETURN
		>

		IFE QSASTE,<
		L	X0,.JBREL
		ADD	X0,YSAREL(XLOW)
		BRANCH	SANP1		;Make a core request and return
		>

	FI
;***AUBEG
IFN QKI10,<
;[175]
TSWAP=^D20	;Time for page swap in ms
	IF
		SKIPN	.JBPFH		;Page fault handler present
		 GOTO	FALSE
		L	X1,[%VMSPF] 	;Get system page
		GETTAB	X1,		; fault counts
		 GOTO	FALSE
		HLRZ	X1,X1		; Not In Working set
		L	X0,X1
		SUB	X1,YSANWA(XLOW)	;ng := this count
					; - count at SAGC start
		ST	X0,YSANWA(XLOW)	;Save current count
		ADDM	X1,YSANWC(XLOW)	;Accumulated count in GC
		JUMPE	X1,FALSE
	THEN	;Use virtual core algorithm
		;Determine overheads from gc parameters
		L	X0,YSANWB(XLOW) ;NIW count since last gc (nb)
		ADD	X1,X1		; (2 * ng
		ADD	X1,X0		; + nb
		IMULI	X1,TSWAP	; * tswap)
		SUB	X1,X6		; - taugc
		LI	X2,2K		; Add 2K if negative,
		SKIPL	X1
		 MOVN	X2,X2		; Subtract if positive
		ADDB	X2,YSAL(XLOW)	; New YSAL value
		edit(276)
		L	X1,X2		;[276]
		ADD	X2,YSABOT(XLOW) ;[276]
		IF	;[276] YSAL would be too big for low seg
			CAIG	X2,377777-QSALIM
			GOTO	FALSE
		THEN	;Make it just small enough
			LI	X1,377777-QSALIM
			SUB	X1,YSABOT(XLOW)
			ST	X1,YSAL(XLOW)
		FI	;[276]
		L	X2,YSATOP(XLOW)
		ADD	X2,X0+YSASAV(XLOW)
		CAMG	X2,X1
		 L	X2,X1
		BRANCH	CHECK
	FI
>
;***AUEND


	;Compute all parameters needed for the calculation of a new
	; g.c. limit and a new step size.


	;F^
	; X0 := F = active memory in pool = YSATOP - YSABOT + X0(saved)

	L	X0,YSATOP(XLOW)
	ADD	X0,X0+YSASAV(XLOW)


	IFN QPROTE,<;Assemble this code if a fixed pool should be allocated
		ADDI	X0,1000		;Add at least 1P free pool area
		;Expand pool only if necessary
		IFN QSASTE,<
		L	X2,X0
		CAMLE	X2,YSALIM(XLOW)
		 EXEC	SANP1	;Ask for more core
		RETURN		;Pool area unchanged
		>

		IFE QSASTE,<
		CAMLE	X0,YSALIM(XLOW)
		GOTO	SANP1	;Ask for more core and return
		>

	>

	SUB	X0,YSABOT(XLOW)
	FLTR	X0,X0
	NEWEST	(F,X3)		;X3 := F^



	;R^
	; X0 := R = YSAR

	L	X0,YSAR(XLOW)
	NEWEST	(R,X5)		;X5 := R^

	;B^
	; X0 := B = TAUGC/F^ = X6/X3

	IF
		JUMPE	X6,FALSE	;B^ unchanged if TAUGC = 0
	THEN
		FLTR	X0,X6
		FDVR	X0,X3
		NEWEST	(B,X6)		;X6 := B^
	ELSE
		L	X6,YSABES(XLOW)
	FI

	;A
	;================== N O T E   !!!!!!!!!!!!!!  ========================;
	;== This code should be changed if the accounting algorithm is changed;
	;=====================================================================;
	COMMENT;

	A(L+Q) = K(L+Q)/K'(L+Q) - L

	where
	L = mean storage pool area = (YSAL + YSABOT +YSATOP)/2
	Q = memory in high segment + low segment area - L
	  = YSAHSZ  +  YSABOT

	K(r) is the cpu time dependent part of the accounting algorithm
		with R = L+Q = number of active pages in core

!!!!!!! Presently used K(R) = (1.1 + 0.005 R (R + 20)/50)

	where

	K'(R) =  0.0002(R + 10)

	A = ( 1.1 + 0.0001( (L+Q+10)**2 - 100 ))) / 0.0002(L+Q+10) - L

	  = 5450/(L+Q+10) + 5 + (Q-L)/2  pages

	where A, L and Q are expressed in number of pages

	Expressed in words we will get:

	A = (5450/((L+Q)/512 +10) + 5 + (Q-L)/(2*512) ) * 512

	  = 14.3E8/(Q+L+5120) + 2560 + (Q-L)/2   words

	;

	L	X0,YSAHSZ(XLOW)	;Q
	ADD	X0,YSABOT(XLOW)
	L	X2,X0
	L	X1,YSAL(XLOW)	;YSAL + YSATOP -YSABOT
	ADD	X1,YSATOP(XLOW)
	SUB	X1,YSABOT(XLOW)
	ASH	X1,-1		; / 2
	ST	X1,YSASTE(XLOW)	; =: L
	ADD	X0,X1		; (R:=) L + Q
	ADDI	X0,^D5120	; + 5120
	FLTR	X0,X0
	MOVSI	X1,14.3E8_-^D18
	FDVR	X1,X0
	FADRI	X1,(2560.0)
	SUB	X2,YSASTE(XLOW)
	ASH	X2,-1
	FLTR	X2,X2
	FADR	X1,X2
	ST	X1,YSAA(XLOW)		;X1 := A

	;=====================================================================;


	;L
	; IFN QSASTE,<
	; L := F^ ( 1 + SQRT( 2*B^ R^ (1 + A/F^))
	; L := X3 ( 1 + SQRT( 2*X6 X5 (1 +X1/X3))
	; >

	; IFE QSASTE,<
	; L := F^ ( 1 + SQRT( 1*B^ R^ (1 + A/F^))
	; L := X3 ( 1 + SQRT( 1*X6 X5 (1 +X1/X3))
	; >


	FDVR	X1,X3
	FADRI	X1,(1.0)
	FMPR	X1,X5
	FMPR	X1,X6

	IFN QSASTE,<
	FMPRI	X1,(2.0)
	>

	IF
		JUMPLE	X1,FALSE	;Neg or zero arg to SQRT
	THEN
		EXEC	SANPSQ		;X0 := SQRT(X1)
		FADRI	X0,(1.0)
		FMPR	X0,X3		;X0 := L
		FIX	X0,X0
;***AUBEG
IFN QKI10,<
edit(175)	;[175]
		L	X1,[-1,,.GTCVL]
		GETTAB	X1,
		 LI	X1,400
		LSH	X1,^D9
		LI	X1,QPOLMI(X1)
		SUB	X1,YSAHSZ(XLOW)
		CAML	X1,X0
	;!Preceding line may skip to ELSE branch; put nothing here!
>
;***AUEND
	ELSE
		FIX	X0,X3
		ADDI	X0,QPOLMI	;Add at least QPOLMI free pool
;***AUBEG
IFN QKI10,<
;[175]
		CAML	X1,X0
		 L	X0,X1	; To avoid going too much virtual
>
;***AUEND
	FI

	IFN	QDEBUG,<FIX	X0,X3		;******TEMPORARY DURING TEST
			ADDI	X0,20000>
	IFN QSASTE,<
	edit(276)	;[276]
	 MOVN	X1,YSABOT(XLOW)
	CAILE	X0,377777-QSALIM(X1)
	 LI	X0,377777-QSALIM(X1)
	ST	X0,YSAL(XLOW)	;Set limit for next garb.coll.
	>

	IFN QSASTE,<
;=============================================================================
;	N O T E  !!!!!!!!!!!!!!!!! Code to compute an optimal step size
;	should be changed if the accounting algorithm is changed
;=============================================================================
Comment;

		New step size  YSASTE :=

			     K     4A/W - U*U
		SQRT ( R^ * --- [ ------------ + (X+U) ] )
			     2        X + U


		where expressed in pages and seconds:

		R^ = YSARES = allocation rate   [pages/sec.]
		K  = time for a CORE UUO  approx.= 0.004  [sec.]
		X  = C0 + C1	[pages]
		C0 = YSATOP + YSAHSZ   [pages]
		C1 = YSABOT + YSAL + YSAHSZ   [pages]
		A, W and U are constants that can be evaluated from the
		 accounting  algorithm written on the form:

			TIME * [ A + W(M+U)*M]

		where M is the total number of 512 word pages allocated
		 to the job.


	Currently at our installation we have:

	TIME * [ 1.1 + 0.0001(M+20)*M ]

	thus
	A = 1.1    [1/sec.]
	W = 0.0001   [1/sec. * 1/pages*pages]
	U = 20       [pages]


	Expressed in words and milliseconds we will get:


	A = 1.1 * 10^-3	[1/ms.]
	W = 0.0001 * 10^-3 * 512^2	[1/ms. * 1/words^2]
	U = 20 * 512 		[words]

Step size := SQRT( R * 2 [( 1.143E10 / (X + 10240)) +X+10240])

	;

	L	X1,YSAL(XLOW)
	ADD	X1,YSABOT(XLOW)
	ADD	X1,YSATOP(XLOW)
	ADD	X1,YSAHSZ(XLOW)
	ADD	X1,YSAHSZ(XLOW)
	FLTR	X1,X1
	MOVSI	X2,1.143E10_-^D18
	L	X3,X1
	FADRI	X3,(10240.0)
	FDVR	X2,X3
	FADR	X3,X2
	L	X1,X3
	FMPR	X1,YSARES(XLOW)
	FMPRI	X1,(2.0)
	EXEC	SANPSQ
	FIX	X0,X0
	CAIGE	X0,QSAPMI
	 LI	X0,QSAPMI
	ST	X0,YSASTE(XLOW)

;===========================================================================


	L	X2,YSATOP(XLOW)
	ADD	X2,X0+YSASAV(XLOW)	;Min low seg to continue exec
	ADD	X2,YSASTE(XLOW)		;Add a step free pool
;***AUBEG
IFN QKI10,<
;[175]
CHECK:
>
;***AUEND
	EXEC	SANP1

		;If YSAL (g.c. limit) greater than allowed by CORMAX
		; limit, set YSAL to the maximal value obtained by the
		; return argument from the CORE UUO (X2=CORMAX
		; in number of K words).

	LSH	X2,^D10
	SUB	X2,YSAHSZ(XLOW)
	SUB	X2,YSABOT(XLOW)
	CAMGE	X2,YSAL(XLOW)
	 ST	X2,YSAL(XLOW)
	>

	IFE QSASTE,<

	ADD	X0,YSABOT(XLOW)




SANP1:		;Entry at storage pool initialization
	L	X1,.JBREL
	SUB	X1,X0
	MOVM	X1,X1
	IF
		CAIG	X1,QSALMI
		GOTO	FALSE
	THEN
		;The low seg. area needed has changed more than QSALMI
		; Make a core request for Min(X0,CORMAX - highseg.)

		IF
			L	X2,.JBREL
			CORE	X0,
			GOTO	FALSE
		THEN
		ELSE
			;CORE failed, CORMAX in X0 (in K words)
			LSH	X0,^D10		;Convert CORMAX to words
			SUB	X0,YSAHSZ(XLOW)	;Set X0 to CORMAX - high seg length
						; and try again
			CAMG	X0,.JBREL
			L	X0,.JBREL	;Get the truncated P
						; if CORMAX odd
			IF
				CORE	X0,
				GOTO	FALSE
			THEN
			ELSE
				L	XCB,XCB+YSASAV(XLOW)	;Restore XCB
				SAERR	1,Cannot get enough core for object pool
			FI
		FI
		IFN QZERO,<;[65]
		IF
			;Zero new core if expanded
			CAML	X2,.JBREL
			GOTO	FALSE
		THEN
			SETZM	(X2)
			HRL	X2,X2
			ADDI	X2,1
			BLT	X2,@.JBREL	;Just for sure
		FI
		>
	FI

		;Set .JBFF, YSALIM and YSAL and dump GC parameters if
		; debug version

SANP2:			;Entry at storage pool initialization if enough
			; core already allocated
	L	X1,.JBREL
	HRRM	X1,.JBFF
	SUBI	X1,QSALIM
	ST	X1,YSALIM(XLOW)
	SUB	X1,YSABOT(XLOW)
	ST	X1,YSAL(XLOW)
	>	;END IFE QSASTE

	IFN QDEBUG,<
		EXEC	SANPDU
	>

	RETURN

	EPROC
	IFN QDEBUG,<			;Reserve patch area
SAPATCH:	BLOCK	100
			>
	SUBTTL	LITERALS

	LIT
	END