	.TITLE *** REMOVE TDV FUNCTION ***
/
/ 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 #15
/
/
/ TDV FUNCTION -- REMOVE	26 SEP 71	R. MCLEAN
/	MODIFIED FOR BLOCK DIRECTED SYSTEM 6/3/72  DAVE MCMILLEN
/       MODIFIED FOR BATCH 3/1/73  MARK HEBENSTREIT
/	XVM VERSION 6/3/75 MARK HEBENSTREIT
/
/ TASK NAME  "REM..."   TO REMOVE A TASK FROM THE SYSTEM TASK LIST.
/
/ FOR THE "REMOVE" FUNCTION, THERE IS ONLY ONE LINE OF
/ COMMAND INPUT, AND IT'S SYNTAX IS AS FOLLOWS:
/
/	SYNTAX = 'REM'$<NBC><BREAK CHARACTER><TASK NAME>
/		(<CR>/<AM>)
/	<BREAK CHAR> = " "/","
/	<TASK NAME> = 1-6 ALPHANUMERIC CHARACTERS
/	<CR> = CAR RTN
/	<AM> = ALTMODE
/	<NBC> = NON BREAK CHARACTER
/	$ -- " ANY NUMBER OF "INCLUDING ZERO "
/
/	IF THE COMMAND INPUT LINE IS TERMINATED BY A CAR RTN,
/	THE RESIDENT TDV TASK IS REQUESTED, AND THE FUNCTION TASK
/	EXITS.
/
 .TITLE *** TDV FUNCTION 'REMOVE'
/
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
IDX=ISZ
ECLA=641000
/
REM	LAW	-7	/SET UP TO FETCH TASK NAME AND STORE
	DAC	CNT	/SIX CHARACTERS (ZERO RIGHT FILL) 
	LAC*	(REMCTA+3	/IS A REM BLK ALLOCATED?
	SAD	(400
	JMP	.+3
	LAC	(MES7	/NO -- ERROR
	JMP	DSKERR+1
/
        CAL     RDTDV   /READ FROM TDV
        LAC     EV
        SPA
        JMP     ERR2
        LAC     (REMNAM+1)
        DAC*    (X10
REMN5   JMS     FAC     /CHECK FOR FIRST SPACE OR CR AM
        SAD     (40
        JMP     REMN1
        SAD     (15
        JMP     ERR1
        SAD     (175
        JMP     ERR1
        JMP     REMN5
/
/
REMN1   JMS     FAC     /FETCH A CHAR.
        SAD     (54     /COMMA?
        JMP     ERR1    /YES -- ERROR
        SAD     (40    /SPACE?
        JMP     ERR1     /YES -- ERROR
        SAD     (15     /CR?
        JMP     ENDCRA   /YES -- END OF LINE
        SAD     (175    /ALTMODE?
        JMP     ENDCRA   /YES -- END OF LINE
        DAC*    X10     /NO -- STORE CHAR
        ISZ     CNT      /LAST CHAR OF TASK NAME?
        JMP     REMN1     /NO -- GET NEXT CHAR
ERR1    LAC     (MES2    /SYNTAX ERROR
        DAC     TYPCPB+4
        JMP     ERRTY
/
ERR2    LAC     (MES5
        DAC     TYPCPB+4
        JMP     ERRTY
/
ENDCRA	DAC	SVBKCH	/SAVE CAR RTN OR ALTMODE
REMN2	DZM*	X10	/FILL REMAINING CHARACTERS WITH ZERO
	ISZ	CNT
	JMP	REMN2
/
	LAC	REMNAM+4	/FORM FIRST HALF OF TASK NAME
	LRS	6
	LAC	REMNAM+3
	LRS	6
	LAC	REMNAM+2
	SNA		/IS THIS A NULL NAME?
	JMP	ERR1	/YES EXIT WITH ERROR
	LLS	14
	DAC	REMNAM+2	/STORE FIRST HALF OF WORD IN REMNAM
	LAC	REMNAM+7	/FORM SECOND HALF OF TASK NAME
	LRS	6
	LAC	REMNAM+6
	LRS	6
	LAC	REMNAM+5
	LLS	14
	DAC	REMNAM+3
	LAC	(REMNAM+2)	/PICK UP POINTER TO TASK NAME
	DAC*	(R2)	/SAVE IT IN R2 FOR SNAM
	LAC	(STKL)	/PICK UP POINTER TO SYSTEM TASK LIST HEAD
	DAC*	(R1)	/SAVE IT ALSO
	JMS*	(SNAM)	/LOOK FOR PROGRAM IN SYSTEM TASK LIST
	JMP	ERTTYA	/TASK NOT IN SYSTEM ERROR
	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
////////////////////////////////////////////////////////////////
//
//  DELETE ON EXIT NOT IMPLEMENTED SO EXIT WITH ERROR
//    IF TASK ACTIVE
//
////////////////////////////////////////////////////////////////
	SPA
	JMP	ACTIVE
	AND	(577777)	/MASK OFF DISARM AND REMOVE ON EXIT BITS
	XOR	(200000)	/YES SET REMOVE ON EXIT FLAGS
	.ENB		/ENABLE INTERRUPTS
	DAC*	FLAGS	/RESTORE FLAGS
	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
/////////
//    CHECK FOR TASK ACTIVE GOES HERE
/////////
	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	EXT1A	/EXIT
ERTTYA	LAC	(MES3)
	DAC	TYPCPB+4	/PRINT TASK NOT IN SYSTEM ERROR
ERRTY	CAL	TYPCPB	/MAKE TYPE CPB REQUEST
	CAL	WAITEV	/WAIT FOR ERROR MESSAGE TO BE PRINTED
	JMP	EXT2	/FINISHED EXIT
/
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
/ 
///////
ACTIVE	.ENB		/ENABLE INTERRUPTS
	DBK		/DEBREAK FROM LEVEL 6
	LAC	(MES1)
	DAC	TYPCPB+4	/PUT MESAGE IN BUFFER
	JMP	ERRTY
/////////
EXT1A=.
	LAC	SVBKCH
	SAD	(15
EXT2    CAL     REQTDV
	CAL	(10)	/RETURN
/
REQTDV	1		/CALL TDV DIRECTIVE
	0
	.SIXBT	"TDV"
	.SIXBT	"..."
	0
/  
/   FAC -- SUBROUTINE TO FETCH A CHAR FROM 5/7 ASCII LINE BUFFER
/   FACLB.  CHARS ARE NOT FETCHED BEYOND TERMINATOR.
/
FAC     0
        LAC*    FACCBX    /FETCH NEXT UNPACKED CHAR FROM FACCB
        SMA             /WAS BUFFER EMPTY?
        JMP     FAC2    /NO -- TEST FOR TERMINATOR
        LAC     (FACCB-1   /YES -- REFILL FACCB
        DAC     FACCBX
        LAC*    FACLBX   /1ST HALF OF WORD PAIR
        ISZ     FACLBX
        LMQ
        CLA!CLL
        JMS     FACUPS   /1ST CHAR
        JMS     FACUPS   /2ND CHAR
        JMS     FACUPS   /START OF 3RD CHAR
        LAC*    FACLBX
        ISZ     FACLBX
        LRS     17
        XOR*    FACCBX
        DAC*    FACCBX
        CLA
        JMS     FACUPS   /4TH CHAR
        JMS     FACUPS   /5TH CHAR
        LAC     (FACCB   /RESET CHAR BUFF INDEX
        DAC     FACCBX
        LAC*    FACCBX   /GET 1ST CHAR FROM BUFFER
FAC2    SAD     (15    /TEST FOR CR OR ALT.
        JMP*    FAC
        SAD     (175
        JMP*    FAC
/
        ISZ     FACCBX
        JMP*    FAC
/  
FACUPS  0         /UNPACKING S.R.    AC AND LINK MUST BE
        LLS     7   /CLEARED, NEXT CHAR MUST BE IN HIGH ORDER 
        ISZ     FACCBX  /MQ, FACCBX MUST POINT TO WORD PRECEEDING
        DAC*    FACCBX  /CHAR TO BE STORED.
        CLA
        JMP*    FACUPS
FACLBX  FACLB+2
FACCBX  FACCB+5
FACCB   .BLOCK   5
        -1
/
FACLB   .BLOCK   22
        .ASCII <15>
/
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
	0
	0
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
	15
	2
	MES3
EV	0
RDTDV   37       /READ TDV BUFFER
        EV
        FACLB
        22
/
/
WAITEV	20	/WAIT FOR
	EV	/EVENT VARIABLE ADDRESS
/
MES1	MES2-MES1/2*1000+2
	0
	.ASCII	"REM-TASK ACTIVE"<15>
MES2	MES3-MES2/2*1000+2
	0
	.ASCII	"REM-SYNTAX ERR"<15>
MES3	MES4-MES3/2*1000+2
	0
	.ASCII	"REM-TASK NOT IN SYSTEM"<15>
MES4	MES5-MES4/2*1000+2
	0
	.ASCII	'REM-DISK ERR'<15>
MES5    MES6-MES5/2*1000+2
        0
        .ASCII "REM-TDV ERROR"<15>
MES6	MES7-MES6/2*1000
	0
	.ASCII "ALLOCATE ERROR"<15>
MES7=.
/
/
/
SVBKCH	0
CNT	0
TEMP	0
BUFF	.BLOCK 400
	.END	REM
