COMMENT ⊗   VALID 00005 PAGES VERSION 16(6)
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	HISTORY
 00003 00003	EXECS FOR SPROUT
 00006 00004	AN EXEC TO SET UP A KILL LIST VAR -- IF NEED ONE 
 00008 00005	EXECS FOR EVENTS
 00009 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  002000000006  ⊗;


COMMENT ⊗
VERSION 16(6) 10-4-72 BY RHT BUG #JM# BLOCK GETTING CONFUSED BY TBITS WORD LOSSAGE
VERSION 16(5) 9-25-72 BY RHT BUG #IY# LIMIT CASES IN WHICH BLOCK GETS A KILL SET
VERSION 16(4) 9-25-72 
VERSION 16(3) 9-25-72 
VERSION 16(2) 9-25-72 
VERSION 16(1) 9-25-72 

⊗;
COMMENT ⊗EXECS FOR SPROUT⊗

BEGIN PROCSS

↑STDOPT:	MOVEI	A,0		;STANDARD CASE IS ALL ZERO
	PUSHJ	P,CREINT	;
	GENMOV(STACK,GETD)	;STACK IT
	POPJ	P,

↑SPRIT:	XCALL	(SPROUT)
	SETZM	ADEPTH		;PRETTY ARBITRARY
	SETZM	SDEPTH		;
	FREBLK	GENLEF+1
	POPJ	P,

↑FPREM:	GETBLK	GENRIG+1
	MOVE	PNT,GENLEF+1	;THE PROCEDURE ID
	HRRM	PNT,$VAL2(LPSA)	;REMEMBER THE PROC WE FORKED
	POPJ	P,

↑SPRPD:	MOVE	LPSA,GENLEF+2
	HLRZ	LPSA,%TLINK(LPSA)	;PROCEDURE SEMBLK
	HRRZ	PNT,$VAL(LPSA)		;PD SEMBLK
	MOVS	C,$ADR(PNT)
	MOVE	A,[HRRZI TEMP,NOUSAC!JSFIX]
	TRNE	C,-1			;OUT YET???
	MOVE	A,[HRRZI TEMP,NOUSAC!USADDR]
	PUSHJ	P,EMITER
	HRLI	C,TEMP
	EMIT	<PUSH	RP,NOUSAC!NORLC!USADDR>
	AOS	ADEPTH
	POPJ	P,

STDKL1:	SKIPA	PNT,GENLEF+2
↑STDKLL:				;STANDARD KILL LIST
	MOVE	PNT,GENLEF+1		;FORK SEMBLK
	HRRZ	PNT2,$VAL2(PNT)		;THE PROCEDURE WE FORKED
	HLRZ	LPSA,%TLINK(PNT2)	;THE SECOND BLOCK
	HLRZ	LPSA,%SAVET(LPSA)	;OLD TTOP
;;#JM# RHT MOVE KILL SET PTR (10-4-72) ↓ (1 OF 3)
	HRRZ	PNT,$ACNO(LPSA)	;THE KILL LIST
	TRNN	PNT,-1			;WE BETTER HAVE ONE
	ERR	<THERE IS NO DEFAULT KILL SET FOR THIS PROCEDURE>
	EMIT	<HRRZI TEMP,NOUSAC>
	HRLI	C,TEMP
	EMIT	<PUSH RP,NOUSAC!USADDR!NORLC>
	AOS	ADEPTH
	POPJ	P,

↑BNKLL:
	ERR 	<KILL LIST BY BLOCK NAME NOT IMPLEMENTED>,1
	JRST	STDKLL

↑EKLL:	
	MOVE	PNT,GENLEF		;PICK UP THE SET
	PUSHJ	P,GETAD			;GET SEMANTICS
	TLNN	TBITS,SET		;MUST BE A SET
	JRST	KSER
	TLNE	TBITS,SAFE
	TRNN	TBITS,INTEGR		;BE SURE KILL SET
KSER:	ERR	<NOT A KILL SET>,1
	GENMOV 	(STACK,0)		;STACK IT
	POPJ	P,

↑STKOPT:
	MOVE	PNT,GENLEF+1
	GENMOV	(STACK,GETD)
	POPJ	P,





COMMENT ⊗AN EXEC TO SET UP A KILL LIST VAR -- IF NEED ONE ⊗

KLNAM:	XWD	0,6
	POINT	7,.+1
	ASCII	/KLST../	;KILL LIST VARIABLE
↑KLSET:				;DECLARE KILL LIST VARIABLE
	MOVE	TBITS,BITS	;IS THE NEW PROCEDURE SIMPLE?
;;#IY# RHT (9-25-72) RESTRICT CIRCUMSTANCES IN WHICH KILL SET GOES OUT
	TLNN	TBITS,SIMPLE!EXTRNL ;OR EXTERNAL
	SKIPE	SIMPSW		;OR INSIDE A SIMPLE PROC
	POPJ	P,		;YES
;;#IY#
	MOVE	PNT,GENLEF+2	;LOOK AT THE BEGIN
;;#JM# RHT 10-4-72 ↓ MOVE KILL SET IN BLOCK SEMBLK (2 OF 3)
	MOVE	TEMP,$ACNO(PNT) ;DO WE HAVE ONE???
	TRNE	TEMP,-1
	POPJ	P,		;THERE IS ONE ALREADY
	PUSH	P,PNAME
	PUSH	P,PNAME+1	;SAVE MUCH CRUFT
	PUSH	P,HPNT
	PUSH	P,BITS
	PUSH	P,NEWSYM
	SETZM	NEWSYM
	HRROI	TEMP,KLNAM+1
	POP	TEMP,PNAME+1
	POP	TEMP,PNAME
	MOVE	TEMP,[XWD SAFE,SET!INTEGR]
	MOVEM	TEMP,BITS
	MOVE	LPSA,SYMTAB
	PUSHJ	P,SHASH
	PUSHJ	P,ENTERS
	MOVE	TEMP,NEWSYM
	MOVE	PNT,GENLEF+2
;;#JM# RHT 10-4-72 ↓ MOVE KILL SET IN BLOCK SEMBLK (3 OF 3)
	HRRM	TEMP,$ACNO(PNT)
	POP	P,NEWSYM	;PUT EM BACK
	POP	P,BITS		;THE WAY THEY WAS
	POP	P,HPNT
	POP	P,PNAME+1
	POP	P,PNAME
	POPJ	P,		;RETURN -- NO PERMANENT DAMAGE (I HOPE)

COMMENT ⊗EXECS FOR EVENTS⊗

↑CSIT:  PUSHJ P,ALLSTO
	XCALL	(CAUSE)
	MOVNI	A,3
	ADDM	A,ADEPTH
	POPJ	P,

↑STKIRG: MOVE 	TBITS,@LEAPSK
	TLNN	TBITS,LPITM
	JRST	BNDLST			;IT BETTER BE A LIST OR THE LIKE
	JRST	BNDITM			;AN ITEM

↑IRIT:	PUSHJ	P,ALLSTO
	XCALL	(INTERROGATE)
	MOVNI	A,2
	ADDM	A,ADEPTH
	POPJ	P,

↑TYPIRG: MOVEI	TBITS,ITMVAR
	MOVEI	SBITS,0
	MOVEI	D,A
	GENMOV	(MARK,0)
	MOVEM	PNT,GENRIG
	MOVE	A,[XWD CLSIDX,TITV]
	MOVEM	A,PARRIG
	POPJ	P,

BEND PROCSS