.TITLE *** AUTO-REMOVE ***
/
/ COPYRIGHT (C) 1975
/ DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/ THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
/ ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
/ THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS
/ SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO-
/ VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
/ EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO
/ THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/ SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/ THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE
/ WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-
/ MITMENT BY DIGITAL EQUIPMENT CORPORATION.
/
/ DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/ OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
/ DEC.
/
	.EJECT
/ EDIT #6
/
/ 
/ DATE OF LAST EDIT: JUNE 3 75		M. HEBENSTREIT
/
/ THIS TASK IS USED TO IMPLEMENT THE 'EXECUTE' CAL OR DIRECTIVE.
/ 
/ AUTORM REMOVES TASKS IN THE STL WHICH MEET THE FOLLOWING REQUIREMENTS
/	1. THE TASK MUST HAVE THE 'DONE' BIT SET
/	2. THE TASK MUST HAVE THE 'REMOVE ON EXIT' BIT SET
/	3. THE TASK MUST NOT BE ACTIVE
/
 .TITLE *** AUTO-REMOVE TASK ***
/
MCRRI=171
FAC=174
SNAM=123
.ENB=705521
.INH=705522
POOL=240
NADD=107
NDEL=112
R1=101
R2=102
STKL=242
X10=10
P.TC=47
REMBLK=311	/FIRST BLOCK FOR REMOVE CHAIN
IDX=ISZ
ECLA=641000
/
BEGIN	LAC	(START	/GET THE XR ADJUSTMENT
	AND	(070000
	DAC	XRPAGE
	TCA
	DAC	XRADJ
START	LAC	(STKL	/PREPARE TO SCAN THE STL
	JMS	SETXR
	DZM	REMNAM+2	/ZERO THE TASK NAME
	DZM	REMNAM+3
NEXTN	LAC	0,X	/END OF STL?
	SAD	(STKL
	JMP	EXIT	/YES -- EXIT
	JMS	SETXR	/NO -- ACCESS NEXT NODE
	LAC	4,X	/GET THE FLAGS WORD
	SPA		/IS THE TASK ACTIVE?
	JMP	NEXTN	/YES -- CONSIDER NEXT NODE
	AND	(204000	/NO --
	SAD	(204000	/ARE THE ROE AND DONE BITS SET?
	SKP
	JMP	NEXTN	/NO -- EXAMINE NEXT NODE
	LAC	2,X	/YES -- SET THE NAME UP FOR REMOVEAL
	DAC	REMNAM+2
	LAC	3,X
	DAC	REMNAM+3
	PXA		/GET THE ADDRESS OF THE NODE
	TAD	XRPAGE
	JMP	REM	/GO REMOVE THE TASK IF IT'S NOT ACTIVE
/ 
EXIT	CAL	(10	/EXIT
XRPAGE	0
XRADJ	0
/ 
/ SUBROUTINE SETXR -- ADJUST THE INDEX REGISTER
/ 
/ 	CONTENTS OF THE AC AND XR ARE LOST
/ 
SETXR	0
	TAD	XRADJ
	PAX
	JMP*	SETXR
/ 
REM	DAC	STLNOD	/SAVE STKL NODE ADDRESS
	AAC	4	/ADD 4 TO PICK UP FLAGS
	DAC	FLAGS	/SAVE POINTER TO FLAGS
	IAC
	DAC	PARBA	/PARTITION BLOCK ADDRESS
	IAC
	DAC	CNT	/SAVE DISK ADDRESS POINTER
	LAC	(400002)	/RAISE TO LEVEL 6 TO PREVENT EXIT
	ISA		/DURING CANCEL
	.INH		/INHIBIT INTERRUPTS WHILE MODIFYING FLAGS
	LAC*	FLAGS	/PICK UP FLAGS
	.ENB		/ENABLE INTERRUPTS
	AND	(040000)	/MASK OFF FIXED IN CORE BITS
	SNA		/IS IT FIXED IN CORE?
	JMP	NOTFIX	/NO DON'T FREE PARTITION
	LAC*	PARBA	/PICK UP THE PARTITION BLOCK POINTER
	AAC	P.TC	/MOVE POINTER TO THE PARTITION BUSY FLAG
	DAC	PARBA
	LAC*	PARBA	/PICK UP THE FLAGS WORD
	AAC	-1	/FREE PARTITION
	DAC*	PARBA
NOTFIX	CAL	REMNAM	/ISSUE CANCEL DIRECTIVE
	LAC	STLNOD	/NO -- DELETE NODE FROM STKL
	DAC*	(R1)
	JMS*	(NDEL)	/DELETE NODE
	LAC*	FLAGS	/IS TASK BUFY
	DBK
	LAC*	CNT	/PICK UP DISK ADDRESS
	ADD	(400\777777)	/SUBTRACT 400 IN ONE'S COMP. ARITHMETIC
	AND	(000377)	/MASK OFF UNIT NUMBER
	DAC	CNTRLU	/SAVE IT IN CPB
	LAC*	CNT	/PICK UP DISK ADDRESS AGAIN
	ADD	(400\777777)	/SUBTRACT AGAIN
	AND	(777400)	/MASK OFF ADDRESS
	DAC	CNTRLA	/SAVE IT IN CPB FOR DEALLOCATE
	CAL	GETSIZ	/PICK UP THE SIZE OF THE STORAGE
	CAL	WAITEV
	LAC	EV	/CHECK TO SEE IF OK
	SPA
	JMP	DSKERR	/NOT OK DISK ERROR
	CAL	DEALOC	/DEALLOCATE DISK SPACE
	CAL	WAITEV	/WAIT FOR DEALLOCATE TO COMPLETE
	LAC	EV	/CHECK TO SEE IF OK
	SPA
	JMP	DSKERR	/NO OK DISK ERRROR
	LAC*	(REMBLK
	LMQ
	LLSS!ECLA 10
	DAC	REMCTA
	LACQ
	DAC	REMCTA+1
	CAL	GETREM	/GET THE REMOVE BLOCK
	CAL	WAITEV
	LAC	EV	/WERE THERE ANY ERRORS?
	SPA
	JMP	DSKERR	/YES
REM1	LAC	BUFF+376	/NO -- IS THERE ROOM IN THIS BLOCK?
	SAD	(376
	JMP	GETSOM	/NO -- ALLOCATE ANOTHER BLOCK
	TAD	(BUFF	/YES
	DAC	TEMP
	LAC	REMNAM+2	/ENTER NAME INTO BLOCK
	DAC*	TEMP
	IDX	TEMP
	LAC	REMNAM+3
	DAC*	TEMP
	IDX	BUFF+376
	IDX	BUFF+376
	CAL	PUTREM
	CAL	WAITEV	/THE BLOCK HAS BEEN WRITTEN OUT
	LAC	EV
	SPA
	JMP	DSKERR	/THER WAS AN ERROR ON THE DISK PUT
	JMP	REMNOD	/NO ERROR -- GO REMOVE THE NODE
GETSOM	CAL	ALLO	/ALLOCATE A BLOCK
	CAL	WAITEV
	LAC	EV	/WERE THERE ANY ERRORS?
	SPA
	JMP	FILERR	/YES
	LAC	ALLCTA+2	/NO -- WHATS THE BLOCK NUMBER
	LMQ
	LAC	ALLCTA+1
	AND	(7777
	LRSS	10
	LACQ
	DAC	BUFF+377	/SAVE THE NEXT BLOCK NUMBER
	CAL	PUTREM	/WRITE OUT THE BLOCK
	CAL	WAITEV
	LAC	EV	/ANY ERRORS?
	SPA
	JMP	DSKERR	/YES
	LAC	(BUFF-1	/NO -- ZERO THE BLOCK
	DAC*	(X10
	DZM*	X10
	LAC*	(X10
	SAD	(BUFF+376
	SKP
	JMP	.-4
	LAW	-1
	DAC	BUFF+377
	LAC	ALLCTA+2
	DAC	REMCTA+1
	LAC	ALLCTA+1
	DAC	REMCTA
	JMP	REM1
REMNOD	LAC	STLNOD	/ADD NODE TO EMPTY POOL
	DAC*	(R2)
	LAC	(POOL)
	DAC*	(R1)
	JMS*	(NADD)	/ADD NODE TO EMPTY POOL
	JMP	START	/SCAN THE STL AGAIN TO SEE IF THERE'S MORE TO DO.
ERRTY	CAL	TYPCPB	/MAKE TYPE CPB REQUEST
	CAL	WAITEV	/WAIT FOR ERROR MESSAGE TO BE PRINTED
	JMP	START	/FINISHED WITH THIS TASK -- LOOK FOR ANOTHER
/
DSKERR	LAC	(MES4)
	DAC	TYPCPB+4	/PUT MESSAGE IN BUFFER POINTER
	JMP	ERRTY	/AND TYPE  MESSAGE
/
FILERR	LAC	(MES6
	DAC	TYPCPB+4
	CAL	TYPCPB
	CAL	WAITEV
	JMP	REMNOD
/ 
REMNAM	4	/CANCEL DIRECTIVE
	EV	/EVENT VARIABLE ADDRESS
	0	/TASK NAME (FIRST HALF)
	0	/TASK NAME (SECOND HALF)
	.BLOCK	3
FLAGS	0
PARBA	0
STLNOD	0
/
DEALOC	1600	/DEALLOCATE CPB
	EV	/EVENT VARIABLE ADDRESS
	1	/LOGICAL UNIT NUMBER
	CNTRLT	/CONTROL TABLE ADDRESS
/
GETSIZ	3000	/GET A WORD FROM THE DISK
	EV	/EVENT VARIABLE ADDRESS
	1	/LUN NUMBER
	CNTRLU	/CONTROL TABLE ADDRESS
/
GETREM	3000
	EV
	1
	REMCTA
/ 
PUTREM	3100
	EV
	1
	REMCTA
/ 
REMCTA	0
	0
	BUFF
	400
/
ALLO	1500
	EV
	1
	ALLCTA
/
ALLCTA	400
	XX
	XX
/
CNTRLT	0	/NUMBER OF WORDS TO BE DELETED
CNTRLU	0	/UNIT NUMBER
CNTRLA	0	/DISK ADDRESS
CNTCD	CNTRLT	/CORE ADDRESS FOR GET
	1	/WORD COUNT FOR GET
/
TYPCPB	2700
	EV
	3
	2
	XX
EV	0
/
WAITEV	20	/WAIT FOR
	EV	/EVENT VARIABLE ADDRESS
/
MES4	MES6-MES4/2*1000+2
	0
	.ASCII	'REM-DISK ERR'<15>
MES6	MES7-MES6/2*1000
	0
	.ASCII "ALLOCATE ERROR"<15>
MES7=.
/
/
/
SVBKCH	0
CNT	0
TEMP	0
BUFF	.BLOCK 400
	.END	BEGIN