.TITLE	MXSUBS	;MSX BUFFER AND I/O MGMT SUBS
;USED FOR HANDLING MSX QUEUES, ETC.
	TCBEVA=16	;EV ADDR OFFSET IN TCB
;MACROS FOR HANDLING MOVES TO/FROM OTHER SPACE (USUALLY OTHER SPACE
;IS USER SPACE)
	.MACRO	MOVK	SRC,DEST
	.IF	DF,SAXCL
	.IF	DIF,SRC,#0
	MOV	SRC,-(SP)
	.IFF
	CLR	-(SP)
	.ENDC
	MTPI	DEST
	.IFF
;NOTE RSX VERSIONS ARE ONE-SPACE VERSIONS, SO ONLY NORMAL MOV NEEDED.
	.IF	DIF,SRC,#0
	MOV	SRC,DEST
	.IFF
	CLR	DEST
	.ENDC
	.ENDC
	.ENDM
	.MACRO	KMOV	SRC,DEST
	.IF	DF,SAXCL
	MFPI	SRC
	MOV	(SP)+,DEST
	.IFF
	MOV	SRC,DEST
	.ENDC
	.ENDM
	.MACRO	KMOVK	SRC,DEST
	.IF	DF,SAXCL
	MFPI	SRC
	MTPI	DEST
	.IFF
	MOV	SRC,DEST
	.ENDC
	.ENDM
	.MACRO	ADRCHK ARG
	.IF	DF,CK.AD.
	MOV	ARG,-(SP)
	JSR	PC,CK.MAP	;SET (SP) ODD IF ILLEGAL
	MOV	(SP)+,ARG
	.ENDC
	.ENDM
;
TCBPR=2	;TCB FLAGS BYTE OFFSET
	.PSECT	MXSUBS,RW,CON

	.IF	NDF,$$DOS	;RSX VERSIONS ONLY...
;	ASTSET
;
;	ENTER A PSEUDO INTERRUPT FROM AN RSX AST ENTRY.
;CALL (FROM INSIDE AN AST):
;	MOV	#<INTERRUPT HANDLER ADDRESS>,-(SP)	;FAKE JSR RETURN
;	JMP	ASTSET
;
;	RETURNS FROM THE AST (ISSUES THE ASTX$S) AND RETURNS TO THE
;INTERRUPT HANDLER AFTER THE AST. THE INTERRUPT HANDLER WILL APPEAR TO
;HAVE JUST RECEIVED THE HARDWARE INTERRUPT. THE ASSUMPTION (VALID IN
;RSX11M V3.1) IS THAT THE AST STACK IS:
;	E.F. WORD #1
;	E.F. WORD #2
;	E.F. WORD #3
;	E.F. WORD #4
;	AST PSW
;	AST PC OF TASK
; SP:	OLD $DSW
;
;WE MOVE THE AST-RELATED STUFF DOWN THE STACK, COPY THE AST PS,PC PAIR TO
;THE TOP, AND CAUSE THE AST TO RETURN TO THE INTERRUPT HANDLER WITH
;THE TASK STACK THEN CONTAINING THE ORIGINAL AST PS,PC PAIR.
	.MCALL	ASTX$S
	.GLOBL	ASTSET
ASTSET:
;FIRST BE SURE WE HAVE AN EVEN, NONZERO ADDRESS TO GO TO.
	TST	(SP)		;RETURN ADDR ZERO?
	BNE	1$		;NO, LOOKS OK.
2$:	TST	(SP)+
	BR	100$		;SOMETHING WRONG. JUST EXIT THE AST.
1$:	BIT	#1,(SP)		;IS ADDRESS EVEN
	BNE	2$		;NO, EXIT AST.
	MOV	2(SP),-(SP)	;COPY NEW $DSW INTO PLACE
	MOV	6(SP),4(SP)	;MOVE THE OLD PC DOWN
	MOV	10(SP),6(SP)	;MOVE DOWN OLD PS
	MOV	12(SP),10(SP)	;...OLD STATUS 4...
	MOV	14(SP),12(SP)	;...3...
	MOV	16(SP),14(SP)	;...2...
	MOV	20(SP),16(SP)	;...AND 1 ...
;NOW WE HAVE FREED THE TOP WORD OF THE STACK AND MOVED THE AST STACK
;DOWN 1 WORD. FILL IT IN AND MOVE DOWN THE OTHER WORD.
	MOV	6(SP),20(SP)	;PUT AST PS INTO PLACE
	MOV	10(SP),6(SP)	;MOVE DOWN STATUS 4
	MOV	12(SP),10(SP)	;...3...
	MOV	14(SP),12(SP)	;...2...
	MOV	16(SP),14(SP)	;...AND 1, TO MOVE ALL THESE DOWN.
;NOW 16(SP) MAY BE FILLED IN WITH THE AST PC
	MOV	4(SP),16(SP)	;FILL IN THE AST PC FOR INT. HANDLER.
	MOV	20(SP),4(SP)	;AND LET THE OLD PS APPLY TO THE INT HANDLER
100$:	ASTX$S			;NOW OFF TO THE INTERRUPT HANDLER.
	.ENDC


	.IF	DF,SAXCL	;
;MQTRP - RECOVER ERRORS DUE TO ADDRESSING TROUBLE DURING TASK
;ABORTS (STANDALONE ONLY)
MQTRP:	MOV	#MQDN,(SP)	;SET RETURN FROM TRAP TO MQDN
	RTI			;OFF TO IT!
MQSP:	.WORD	0		;STORAGE FOR SP DURING ERR-PRONE CODE
	.ENDC
;
;MQDRAN - DRAIN MESSAGE QUEUE OF TASKS. PERFORMS DUMMY DEQUEUE
;	TO NOTIFY SENDERS THAT MSG WAS RECEIVED, THEN ZAPS TASK
;	BITMAP TO FREE ALL MESSAGE SPACES.
	.GLOBL	MQDRAN,QXTAST,MQSET,DQXST,FREDAT
MQDRAN:
	JSR	R5,S.RSAV	;PRESERVE REGS
	MOV	#-4,MX.ERR	;SET ERR AS ABORT
	.IF	DF,SAXCL	;IF S/A
	MOV	@#4,-(SP)
	MOV	@#10,-(SP)	;SAVE ERROR VECTORS
	MOV	@#350,-(SP)	;INCLUDING MEM MGT ERROR
	MOV	#MQTRP,@#4
	MOV	#MQTRP,@#10	;FILL IN WITH MQTRP
	MOV	#MQTRP,@#350
	MOV	SP,MQSP		;SAVE SP IN CASE IT IS CLOBBERED
	.ENDC
;HERE TRY TO DEQUEUE ALL MESSAGES LEFT OVER TO NOTIFY THE SENDERS
;THEY ARRIVED, THOUGH WITH AN ERROR.
MQLP:	JSR	PC,DQMSGI	;GET A MESSAGE
	BCS	MQDN		;IF CS NO MORE THERE
	JSR	PC,EVNFY	;TELL SENDER WE GOT IT SOMEHOW
	ADD	#2,SP		;FIX UP STACK AFTER RETURN
	BR	MQLP
MQDN:
	.IF	DF,SAXCL
;CLEAR OUT DEVICE QUEUES FOR STANDALONE VERSION.
	MOV	@#PS,-(SP)
	MOVB	#340,@#PS	;;;TO PRI 7
;REMOVE I/O QUEUE ELEMENTS TO ABORTED/EXITING TASK AS PART OF TASK CLEANUP.
;ASSUMES DRIVER  CLOSE ENTRY FUNCTIONS AS ABORT POINT IF THERE.
	MOV	#MX.LUT,R4	;;;POINT TO LINKBLK POINTERS
	MOV	(R4)+,R3	;;;GET NO. OF LUNS TO LOOP OVER
1$:	MOV	(R4)+,R2	;;;R2=LINKBLK ADDRESS
	BEQ	2$		;;;IF NONE, LUN NOT AVAILABLE HERE.
	MOV	R2,R1
	ADD	#12,R1		;;;GET QUEUE HDR ADDRESS
	MOV	R1,R0
	TST	@R0		;;;SEE IF LINKBLK HAS A QUEUE
	BEQ	3$		;;;IF NONE TEST CURRENT ELEMENT
5$:	MOV	R1,R0		;;;SAVE "LAST" QUEUE ELEMENT SEEN.
	MOV	@R1,R1		;;;GET CURRENT QUEUE ELEMENT
	BEQ	3$		;;;IF NONE, DONE
	CMP	14(R1),MX.TCB	;;;THIS Q ELEMENT FOR THIS TASK?
	BNE	4$		;;;IF NOT, LEAVE IT ALONE.
	MOV	@R1,@R0		;;;IF SO, POINT QUEUE LINK PAST THIS ELEMENT
	MOV	MX.FSL,@R1	;;;ADD NODE TO FREE LIST AT HEAD
	MOV	R1,MX.FSL
4$:	BR	5$		;;;GO BACK FOR MORE
3$:	CMP	10(R2),MX.TCB	;;;NOW IS CURRENT ELEMENT FOR THIS TASK?
	BNE	2$		;;;IF NOT, LEAVE IT ALONE
	MOV	@R2,R0		;;;IF SO, HAVE TO GET THE DDB
	CLR	@R0		;;;...AND FREE THE DDB...
	MOV	-2(R0),R1	;;;POINT AT THE DRIVER NOW
	MOVB	12(R1),R5	;;;NOW GET OFFSET TO CLOSE ENTRY
	BEQ	2$		;;;IF NO ENTRY, NO CALL
	ADD	R5,R1		;;;(OFFSET BETTER BE EVEN)
	JSR	R5,S.RSAV	;;;FREE REGS FOR DRIVER USE
	JSR	PC,@R1		;;;CALL CLOSE ENTRY TO ABORT I/O
	JSR	R5,S.RRES	;;;GET BACK OUR REGISTERS
2$:	DEC	R3		;;;SEE IF DONE ALL LUNS
	BGT	1$		;;;IF NOT, GO BACK FOR MORE.
;;;DONE, SO RESTORE STUFF & GO.
	MOV	(SP)+,@#PS	;TO PRI 0
	.ENDC
	MOV	#1,MX.ERR	;RESET ERROR FLAG TO OK
	.IF	DF,SAXCL
	MOV	MQSP,SP		;RESET SP IN CASE GONE
	MOV	(SP)+,@#350
	MOV	(SP)+,@#10
	MOV	(SP)+,@#4	;RESET TRAPS
	.ENDC
	JSR	R5,S.RRES	;GET BACK REGS
MQSET:	JSR	R5,S.RSAV
;AT THIS POINT R0 = TCB ADDR OF TASK TO SET UP NODES IN
	MOV	TCBSCB(R0),R1	;R1 = SCRATCH CONTROL AREA
	MOV	(R1),R2		;PERMANENT MAP CONTROL AREA
	MOV	2(R1),R3	;WORK AREA
;FIRST COPY PERMANENT (INITIAL) MAP CONTROL AREA TO WORK AREA.
;THEN ZERO BITMAP.
	MOV	R1,R4		;SAVE SCB POINTER
	ADD	#4,R4		;POINT TO LISTHEAD
;HAVE TO SET UP THE NODE LISTHEAD AS EMPTY FIRST
	MOV	R4,4(R1)	;HEAD
	MOV	R4,6(R1)	;TAIL
	MOV	TCBMQB(R0),R4	;MSG QUEUE BLOCK
	CLR	@R4		;SET NO INPUT MESSAGES
	CLR	6(R4)		;AND NONE OUT...
	MOV	R4,2(R4)	;
	MOV	R4,4(R4)
	ADD	#2,2(R4)	;REGENERATE IN MSG QUEUE HDR
	ADD	#2,4(R4)
	MOV	R4,10(R4)
	MOV	R4,12(R4)
	ADD	#10,10(R4)
	ADD	#10,12(R4)	;REGENERATE OUT MSG QUEUE HDR
;	MOV	TCBAQB(R0),R4	;NOW DISALLOW AST'S...
;	CLR	@R4		;...FOR MESSAGES IN
	MOV	#PX.WDS,R4	;NO. WORDS IN PERMANENT LIST
1$:	MOV	(R2)+,(R3)+	;COPY MAP CONTROL FROM PERM TO WORK
	SOB	R4,1$		;FOR ALL OF IT
	MOV	-6(R2),R3	;BITMAP START ADDRESS
	MOV	-4(R2),R4	;BITMAP END ADDRESS
	CMP	R3,R4		;BE SURE THERE IS ONE...
	BHIS	3$		;IF NOT, NO TRIAL CLEARING OF IT.
;THE ABOVE MAPS IN THE TASK IF NEEDED FOR S/A OR RSX MAPPED VERSIONS
;NOTE BITMAPS ARE IN KERNEL SPACE IN ALL CASES, AS MAP CONTROL LOGIC
;WORKS FOR ONE SPACE ONLY.
2$:	CLR	(R3)+		;ZERO A WORD
	CMP	R3,R4		;PAST END?
	BLO	2$		;IF NOT, KEEP CLEARING
3$:	JSR	R5,S.RRES	;RESTORE REGS FOR CALLER
	RTS	PC
;
;QXTAST - QUEUE EXIT AST TO TASK. R0=TCB ON ENTRY; R2=CALLER TCB
;R0 POINTS TO TCB OF TASK CALLED (I.E., THAT EXITED). R2 IS CALLER'S TCB
QXTAST:	JSR	R5,S.RSAV	;SAVE REGS (AS USUAL)
;SET A BIT IN THE TCB TO TELL DIRECTIVE PROCESSING THAT WE
;ALREADY SENT THE CALLER NOTICE FOR THIS CALLED TASK. USE 4 BIT.
	BITB	#4,TCBPR(R0)	;WAS CALLER ALREADY TOLD?
	BNE	QXAX		;IF SO, DON'T RE-TELL HIM.
	BISB	#4,TCBPR(R0)	;I.E., WE TELL THE CALLER HERE
;				;BY EV AND AST QUEUE
	JSR	PC,GETNOD	;FIND A SCRATCH NODE FOR AST
	TST	R1		;SEE IF IT WORKED
	BEQ	QXAX		;NO, FAILED SO CAN'T DO IT.
;EXIT AST MEANS TELL CALLER TASK A SPAWNED TASK EXITED...
	MOV	TCBAQB(R2),R3	;AST CONTROL BLK HAS QUEUE HEADS
	ADD	#10,R3		;POINT AT EXIT QUEUES
	INC	2(R3)		;COUNT UP NUMBER OF AST'S PENDING
	MOV	#12,R4		;LOCATION OF PRIO IN QUEUE ELEMENTS
	MOV	#1,R0		;AST PRIO ALWAYS 1 (NO REAL PRIORITY)
	JSR	PC,P.INS	;INSERT NODE IN QUEUE
	MOV	(SP),R4		;GET INITIAL TCB (CALLER R0)
	MOV	R1,2(SP)	;SAVE R1 (NODE ADDR) FOR AFTER RRES
;BUMP EV IF ANY IN CALLER TASK
	MOV	R2,R0		;POINT AT CALLER TCB
	.IIF	DF,SAXCL,JSR PC,U.LDR ;MAP IN TASK (STD ALONE)
	.IIF	DF,M$GE, JSR PC,U.ALD ;MAP IN TASK (RSX MEM MGT)
	MOV	TCBKEV(R4),R1	;EV ADDR TO BUMP IN CALLER TASK
	BIT	#1,R1		;MAKE SURE NOT AN ODD ADDRESS
	BEQ	2$		;IF EVEN, GO AHEAD
	MOV	2(SP),R5	;ELSE GET NODE ADDRESS
	SUB	#4,R5		;POINT AT HEADER STUFF
	JSR	PC,FRENOD	;AND FREE THE NODE
	BR	QXAX		;AND SCRAM BEFORE DOING ANY HARM
2$:	;
	.IF	DF,SAXCL
	MFPI	@R1
	INC	@SP		;BUMP THE EVENT VARIABLE
	MTPI	@R1
	.IFF
	INC	@R1
	.ENDC
	MOV	2(SP),R1	;NODE ADDRESS (AFTER POINTERS)
;NOTE GETNOD RETURNS 3RD WORD ADDR OF NODE AFTER SIZE AND FWD,BACK POINTERS
;NOW SET UP THE MESSAGE NODE TO EMIT.
	MOV	TCBKEV(R4),(R1)+ ;EV ADDR
	MOV	(R4),(R1)+	;TASK NAME
	MOV	TCBCPU(R4),(R1)+ ;TASK CPU/BUS (NOTE WORD ALIGNED!!!!!)
	MOV	#1,(R1)+	;PRIO = 1 . (BASICALLY IGNORE PRIO)
	MOV	TCBSTT(R4),(R1)+ ;EXIT STATUS
QXAX:	JSR	R5,S.RRES	;RETURN REGS
	RTS	PC
R1SAV:	.WORD	0	;SAVE FOR R1 ACROSS DQXST AND DQMSGI CALLS.
;
;DQXST - DEQUEUE EXIT AST NODE.
;
DQXST:
	MOVB	#340,@#PS	;NO INTERRUPTS HERE...HAVE TO SAVE R1
	MOV	R1,R1SAV	;IMPURE SAVE!!!
	MOV	TCBAQB(R0),R1	;ENTRY R0 = TCB. GET AST CTL WITH LISTHEADS
	ADD	#10,R1		;POINT AT EXIT AST NODE LISTHEAD
	JMP	DQCM		;DO COMMON WITH DQMSGI STUFF
;

;
;MNDALO - ALLOCATE A MESSAGE NODE FROM A TASK'S NODE AREA
;AND RETURN THE ADDRESS OF THE NODE'S 4TH WORD IN R5. RETURNS
;R5=0 IF NO NODE IS FOUND.
	.GLOBL	MNDALO
;ENTRY: R1=SCRATCH CTL BLK ADDR
;R3=DATA LENGTH, BYTES
;R2=TCB ADDR
MNDALO:
	JSR	R5,S.RSAV
;FIRST FIND HOW BIG THE NODE MUST BE. GRANULARITY IS IN BITMAP CTL BLK
;START
	CLR	R4		;COUNTER OF NODES TO ALLOCATE
	MOV	@0(R1),R5	;SIZE OF A NODE, WORDS
	ASL	R5		;NODE SIZE IN BYTES
1$:	INC	R4		;COUNT SIZE TO USE
	SUB	R5,R3		;SUBTRACT NNODE SIZE...
	BGT	1$		;KEEP GOING TILL NEGATIVE
;R4 IS NOW NUMBER OF NODES TO ALLOCATE. R3=GARBAGE.
;NEXT, COPY THE WORKING AREA MAP CONTROL TO THE BITMAP ALLOCATOR AREA
	MOV	#MX.NSZ,R3	;SYS WORK AREA
	MOV	2(R1),R5	;WORK BITMAP CTL BLK
	MOV	#PX.WDS,R0	;NO. WORDS...
2$:	MOV	(R5)+,(R3)+	;COPY...
	SOB	R0,2$		;...WORK MAPCTL TO SYS
;NOW ACTUALLY ALLOCATE <R4> NODES.
	JSR	R5,S.RSAV
	MOV	R4,-(SP)	;NO. BUFFERS...
	JSR	R5,S.BFA
	MOV	(SP)+,R5	;GET ADDRESS OF ALLOCATED NODE
	BEQ	3$		;LEAVE ZERO ALONE
	MOV	10(SP),@R5	;SAVE NO. NODES IN FIRST NODE WORD
	ADD	#6,R5		;POINT AT 3RD WORD
3$:	MOV	R5,12(SP)	;RESTORE R5 AS MODIFIED
	JSR	R5,S.RRES
;NOW RECOPY THE WORKING AREA TO THE SYSTEMM AREA
	MOV	2(R1),R2	;GET WORK MAP AREA
	MOV	#PX.WDS,R0
	MOV	#MX.NSZ,R3
4$:	MOV	(R3)+,(R2)+	;COPY SYS MAP CONTROL BACK TO WORK AREA
	SOB	R0,4$
	MOV	R5,12(SP)	;SAVE R5 ACROSS CALL
	JSR	R5,S.RRES
	RTS	PC
;
;
;NODCHN - CHAIN NODE ALLOCATED INTO CHAIN POINTED AT BY R4
; ASSUMES NODE ADDRESSED BY R5 AND NODE IN TASK SPACE. ASSUMES TOO
; THAT R2 IS TCB OF TASK TO GET THE MESSAGE.
	.GLOBL	NODCHN
NODCHN:	JSR	R5,S.RSAV	;COMMONLY SAVE REGISTERS
;NOTE THAT MESSAGE PRIORITY IS IN AST QUEUE WHERE P.INS INSERTS IT BY
;PRIORITY. THE CHAINING HERE IS STRICTLY FIFO.
	MOV	R2,R0		;ARRANGE TO REMAP TASK WE NEED
	.IIF	DF,M$GE, JSR PC,U.ALD
	.IIF	DF,SAXCL,JSR PC,U.LDR	;MAP TASK INTO SPACE IF NEEDED
	JSR	R5,S.RRES
	.IF	DF,SAF.T	;*** N.B. - MSG CHAIN UNUSED!!! ***
;MSG CHAIN ALSO REALLY A MESS SINCE HDR IN KNL SPACE, CHAIN IN TASK SPACE!
	JSR	R5,S.RSAV
	SUB	#4,R5		;POINT R5 AT NODE PHYSICAL START AFTER SIZE
	MOV	4(R4),R1	;QUEUE TAIL
	MOV	R4,R2		;CONSTRUCT ADDR OF QUEUE HEAD
	ADD	#2,R2		;IN R2
	MOV	R2,(R5)		;PUT QUEUE TAIL ADDRESS IN THE NODE
	MOV	@R1,2(R5)	;SET PREVIOUS NODE IN NODE
	MOV	R5,@R2		;THIS FILLS IN NODE. NOTE THAT WITH CHAIN
	MOV	@R5,R2		;POINTING TO CHAIN POINTERS WITHOUT OFFSET,
	MOV	R5,2(R2)	;THE NODE HEADER IS NO LONGER A SPECIAL CASE.
;
;NOW ALL SET UP...
;
	JSR	R5,S.RRES
	.ENDC	;SAF.T
	RTS	PC

;
;P.INS - INSERT AST NODE BY PRIORITY IN CHAIN.
;
;ENTRY: -
;	R3=QUEUE HEADER ADDR
;	R4=OFFSET IN NODES TO PRIO
;	R0=THIS MSG PRIORITY
;	R1=NODE ADDRESS
; ...MUST PRESERVE R1 AND R5...
	.GLOBL	P.INS
P.INS:
	JSR	R5,S.RSAV
	MOV	4(R3),R2	;QUEUE HEADER
	MOV	6(R3),R3	;QUEUE TAIL
;NOTE THAT NODE IS TO BE INSERTED WITH LISTHEAD POINTING AT REAL QUEUE
;ELEMENT LIST CONTROL (3RD WORD...)
	SUB	#4,R1		;POINT AT AREA FOR LISTHEAD
	ADD	#4,R4		;ALSO ADJUST OFFSET TO PRIO IN NODES
;SCAN THE QUEUE FROM THE BOTTOM UP SO NODES OF EQUAL PRIORITY GET
;INSERTED FIFO INSTEAD OF LIFO
1$:	CMP	R3,R2		;CURRENT END OF QUEUE THE SAME AS HEAD?
	BEQ	2$		;IF SO, DONE WITH SCAN. INSERT AFTER CURRENT 
				;END.
	MOV	R3,R5		;R5=WORK AC
	ADD	R4,R5		;ADDR OF PRIO ENTRY
	CMP	@R5,R0		;THE LAST NODE PRIO >= THIS ONE?
	BGE	2$		;YES, INSERT THIS ONE NEXT AFTER.
	MOV	2(R3),R3	;NO, GET PREDECESSOR NODE
	BR	1$		;AND TRY AGAIN...
2$:	MOV	R3,2(R1)	;OLD LAST NODE IS THIS ONE'S PREDECESSOR
	MOV	(R3),(R1)	;ALSO LAST ONE'S NEXT BECOMES THIS ONE'S NEXT
	MOV	(R3),R5		;SAVE OLD NODE'S SUCCESSOR (OUR SUCCESSOR NXT)
	MOV	R1,(R3)		;THIS ONE BECOMES LAST ONE'S NEXT
	MOV	R1,2(R5)	;AND THIS ONE BECOMES NEXT'S PREDECESSOR
	JSR	R5,S.RRES
	RTS	PC
;
;
;NODFRE - FREE UP NODE ALLOCATED BY MNDALO AND CHAINED BY NODCHN.
;
;ENTRY R5 HAS NODE ADDRESS, R2=TCB, AND R4=MSG QUEUE BLK ADDRESS
;
;USED TO RECOVER FROM ERROR ALLOCATING AN AST NODE...
	.GLOBL	NODFRE
NODFRE:	JSR	R5,S.RSAV
;FIRST UNCHAIN THE NODE SO WE CAN GET RID OF IT...
	.IF	DF,SAF.T	;*** UNUSED CHAIN! ****
	MOV	-4(R5),R0	;CHAIN LINK ADDRESSES IN NODE
	MOV	@R0,R1		;NEXT NODE IN THIS ONE
	MOV	2(R0),R3	;PREVIOUS NODE...
	MOV	R1,@R3		;RESET PREVIOUS'S NEXT
	MOV	R3,2(R1)	;AND NEXT'S PREVIOUS
;THIS REMOVES THE NODE FROM THE CHAIN, SO IT CAN NOW BE FREED.
	.ENDC	;SAF.T ***
	SUB	#6,R5
;NOW GET THE TASK'S STORAGE WORK MAP INT SYSTEM AREA AND FREE THE SPACE.
	MOV	TCBSCB(R2),R1	;GET SCRATCH AREA
	MOV	#PX.WDS,R0	;WORDS TO MOVE
	MOV	#MX.NSZ,R3	;SYS AREA
	MOV	2(R1),R4	;WORK AREA
1$:	MOV	(R4)+,(R3)+	;MOVE CONTROL AREA FOR SUB
	SOB	R0,1$
	MOV	R5,-(SP)	;ADDRESS OF DATA
	MOV	@R5,-(SP)	;SIZE TO FREE IN NODES (SAVED AT NODE
				;ALLOCATION...)
	JSR	R5,S.BRL	;FREE THE BUFFER (IGNORE ERRORS...)
;ALL SET NOW...
	JSR	R5,S.RRES
	RTS	PC
;

;
;FREDAT - FREE NODE ON STACK.
; CALLED FROM AST PROCESSING. STACK HAS
;	STATUS
;	MSG ADDRESS
;	MSG LENGTH
;	OLD PS
;  SP:  OLD PC
FREDAT:	JSR	R5,S.RSAV
	;ALLOW 2 REG SAVES PLUS POSSIBLE APR SAVE ON STACK
	;ABOVE THE CALL.
	;ALSO, WILL HAVE 2 (PS,PC) PAIRS, ONE FROM AST AND ONE
	;FROM AST EXIT TRAP.
;NOTE A$PROF=0 IN STANDALONE CASE. HOWEVER, REG SAVE NOT ON STACK
;THERE, SO OFFSET DOWN
S.SPO=0
	.IIF DF,SAXCL,S.SPO=-14	;SIZE OF 1 REG SAVE
	MOV	S.SPO+30+14+A$PROF(SP),R2	;MESSAGE ADDRESS
;R0 HAS TCB OF THIS TASK ON ENTRY.
;MUST FILL IN BITMAPS
	MOV	TCBSCB(R0),R3		;SCRATCH CTL AREA
	MOV	2(R3),R3		;TABLE OF WORKING AREA
	MOV	#MX.NSZ,R4		;SIZE OF NODE ADDRESS
	MOV	#PX.WDS,R5		;NO. WORDS
1$:	MOV	(R3)+,(R4)+		;COPY DATA IN TO BITMAP CTL
	SOB	R5,1$
	SUB	#<2*PX.WDS>,R3		;BACK UP TO POINT R3 AT WORK PTR
;NODE DATA IN THE MESSAGE NODE IS AFTER CALLER-TSKNAM,PRIO,RCV-TSKNAM,
;MSG-LENGTH,CALLER-EVA, BUT THERE ARE 3 HEADER WORDS PER NODE FOR
;SIZE IN BLOCKS AND FORWARD, BACKWARD LINKS SO TOTAL OFFSET TO FIRST
;NODE WORD (CONTAINING NODE SIZE) IS 20=12+6.
	SUB	#20,R2			;POINT AT NODE ACTUAL START
;(ALLOWS FOR HEADER INFO IN NODE)
;
;MESSAGES NOW LINK TO LISTHEAD.
	MOV	(R2),R0			;NO. NODES IN BUFFER
	.IF	DF,SAF.T	;*** UNUSED CHAIN!!! ***
	MOV	2(R2),R1		;NEXT NODE
	MOV	4(R2),R4		;R4=LAST NODE
	MOV	R1,@R4			;OUR NEXT IS LAST'S NEXT
	MOV	R4,2(R1)		;NEXT'S LAST IS OUR LAST
;THE ABOVE REMOVES OUR NODE (IN R2) FROM THE QUEUE
	.ENDC	;SAF.T 	;***
	JSR	R5,S.RSAV
	MOV	R2,-(SP)		;MSG ADDRESS
	MOV	R0,-(SP)		;NUMBER OF NODES TO FREE
	JSR	R5,S.BRL		;FREE THE NODES (NOTE BITMAP IN KNL)
	JSR	R5,S.RRES		;GET BACK REGS WE USED
	MOV	#MX.NSZ,R4		;NOW COPY WORK AREA BACK SAFELY AGAIN
	MOV	#PX.WDS,R5
2$:	MOV	(R4)+,(R3)+		;COPY BITMAP PGM AREA TO TSK WORK.
	SOB	R5,2$
	JSR	R5,S.RRES
	RTS	PC
;

;
;	GETNOD - FIND NODE FOR AST IN SYSTEM BITMAP.
;LOCATES NODE AND SAVES ADDRESS IN R1. NOTHING ELSE IS
;ASSUMED.
;NOTE R1 WILL BE 0 IF NO NODE FOUND. NODES ALWAYS ARE
;16 WORDS LONG. 1ST WORD IS NO. OF 16 WORD BLOCKS AND
;R1 POINTS AT 2ND.
	.GLOBL	GETNOD
GETNOD:
	JSR	R5,S.RSAV	;SAVE REGS HERE FOR OUR USE
	CLR	2(SP)		;INITIALLY ZERO R1 ON RETURN
	MOV	#PX.NSZ,R0	;COPY PERM. BUF TO WORKING ONE
	MOV	#MX.NSZ,R1	;
	MOV	#PX.WDS,R2	;NO. WORDS TO COPY
1$:	MOV	(R0)+,(R1)+	;COPY BUF CTL
	SOB	R2,1$
	MOV	#1,-(SP)	;NOW LOCATE A BUFFER
	JSR	R5,S.BFA	;USING COMMON BUFFER ALLOCATOR
	MOV	(SP)+,R1	;GET BUFFER ADDRESS
	BEQ	2$		;IF ZERO FORGET THIS
	MOV	#1,(R1)+	;IF NONZERO SAVE THAT WE ALLOCATED 1 BUF
	MOV	R1,2(SP)	;RETURN CLEAR AREA TO CALLER
	BR	4$
2$:
	.IF	DF,SE$K
	.IF	DF,MX$CLK
;PLACE TASK IN WAIT IF WE RUN OUT OF NODES, TO REDUCE COVERT COMM. PATH
;BANDWIDTH TO 1 BIT PER TICK.
	MOV	MX.TCB,R0	;GET CURRENT TCB ADDR
	BEQ	4$		;IF IN SCANNER, NO TASK...
	MOV	TCBSCB(R0),R1	;GET CLK DATA ADDRESS
	ADD	#10,R1
	MOV	R1,TCBEVA(R0)	;SAY KWAIT STATE FOR CLOCK
	MOVB	#6,TCBST(R0)	;SET KWAIT STATE
	CLR	@R1		;CLEAR TIMER EV NOW. CLOCK WILL BUMP IT.
	.ENDC
	.ENDC
4$:	MOV	#PX.NSZ,R0	;NOW COPY CONTROL TO WORK AREA
	MOV	#MX.NSZ,R1
	MOV	#PX.WDS,R2
3$:	MOV	(R1)+,(R0)+	;GET IT ALL
	SOB	R2,3$		;TO WORK AREA (ALLOWS MAIN ONE TO BE REUSED)
	JSR	R5,S.RRES	;GET REGS BACK
;NOTE THAT RETURN R1 IS BUFFER ADDRESS FOR USE. 15 WORDS AVAILABLE.
	ADD	#4,R1		;ADJUST ADDRESS FOR LINKAGE WORDS AT NODE STRT
	RTS	PC
;

;

;
;DQMSGI	-	DEQUEUE INPUT MESSAGE AST.
;
;	AST FORMAT OF NODE IS
;NODE:	# WORDS IN NODE (=1)
;	FWD POINTER (ADDRESS LINKED TO)
;	BACK POINTER
;	EV ADDR
;	MSG DATA ADDRESS (TASK VIRTUAL)
;	MSG SIZE IN BYTES (SHOULD BE EVEN). COUNTS DATA ONLY.
;	MSG PRIORITY
;	MESSAGE HEADER ADDR (PRECEDES DATA  BY 6 WORD HDR)
;
;MSG FORMAT OF HDR IS TYPE,CALLER TSK NAME, MSG PRIO, RECEIVE TSK NAME,
;MSG LENGTH, EV ADDR, DATA. DATA NOT OVER 512. BYTES LONG.
;
	.GLOBL	DQMSGI
DQMSGI:
	MOVB	#340,@#PS	;NO INTS.
	MOV	R1,R1SAV	;SAVE R1 ACROSS THE CALL (IMPURE!!)
;MUST HERE GET MESSAGE AND FREE THE MESSAGE NODE. IF NO MESSAGE
;RETURN WITH C BIT SET.
;ASSUME MESSAGE WAS INSERTED IN PRIO ORDER.
;R0 = TCB OF TASK WITH AST QUEUED TO IT (MAYBE...)
	MOV	TCBAQB(R0),R1	;POINT AT AST BLOCK
;DECOUNT THE MESSAGES IN ALSO AT THIS POINT.
	DEC	@TCBMQB(R0)	;COUNT DOWN MESSAGES IN.
;USER CAN MAINTAIN THE DATA IN HIS TASK SPACE HIMSELF.
DQCM:	TST	2(R1)		;ANY AST'S PENDING?
	BGT	1$		;YES, PROCESS ONE.
2$:
	MOV	R1SAV,R1	;RESTORE CALLER'S R1
	SEC
	RTS	PC		;NO AST'S PENDING... TELL CALLER NO DICE
20$:	TST	(SP)+		;RESTORE STACK
	BR	2$		;AND GO IF NO QUEUE THERE (SHOULDN'T HAPPEN)
1$:	MOV	(SP),-(SP)	;COPY RETURN DOWN
;RETURN TOS IS CALLER TASK NAME
;NOW FIND A MESSAGE
	DEC	2(R1)		;COUNT DOWN PENDING MESSAGES
	MOV	R1,R2		;FORM QUEUE HEAD ADDRESS
				;AND TAIL ADDRESS IN R2,R3
	CMP	(R2)+,(R2)+	;POINT AT QUEUE HEAD
	MOV	R2,R3		;AND TAIL ADDRESS
	TST	(R3)+		;POINT R3 AT QUEUE TAIL TOO.
	CMP	R2,@R2		;ERROR CHECK...IS QUEUE EMPTY?
	BEQ	20$		;IF SO CALL ERROR
	MOV	(R2),R4		;POINT AT 1ST MSG IN LIST
	MOV	(R4),4(R1)	;POINT LISTHEAD AROUND 1ST MSG
	MOV	(R4),R5		;POINT AT NEXT ONE PAST OURS
	MOV	R2,2(R5)	;SET LISTHEAD AS PREDECESSOR
;NOW LIST ELEMENT ADDRESSED BY R4 IS OUT OF LIST.
	CMP	TCBAQB(R0),R1	;SEE IF THIS IS A MESSAGE DEQUEUE
	BEQ	23$		;IF SO, TASK HAS A HEADER
;EXIT AST DEQUEUE.
; FOR EXIT AST'S, THE TASK DOES NOT HAVE ANY HEADER. THE TASK
;EXIT NODE IS FROM QXTAST OF FORM
;
;EV ADDR TO BUMP
;TASK NAME EXITED
;TASK CPU/BUS #
;PRIO
;STATUS
;	SO GET TASK NAME FROM THERE.
	MOV	6(R4),R3	;EXITED TASK'S NAME (FOR EV INCREMENT)
	MOV	@R0,2(SP)	;FILL IN OUR TASK NAME FOR EV BUMP
	MOV	14(R4),R2	;GET STATUS
	MOV	4(R4),-(SP)	;SAVE EV TO BUMP
	MOV	R4,R5		;GET NODE ADDRESS TO FREE
	.IF	DF,SAXCL
	JSR	PC,U.LDR
	MFPI	4(R4)		;BUMP THE EV HERE (KNOW THIS IS THE CPU)
	INC	@SP
	MTPI	4(R4)
	.IFF
	.IIF DF,M$GE, JSR PC,U.ALD
	INC	@4(R4)
	.ENDC
	MOV	10(R4),R4	;GET CPU/BUS
	JSR	PC,FRENOD	;AND FREE THE NODE POINTED AT BY R5
	BR	24$		;THEN  FILL THINGS IN
23$:
	.IIF	DF,SAXCL, JSR PC,U.LDR
	.IIF DF,M$GE, JSR PC,U.ALD	;MAP IN TASK APR'S
	MOV	14(R4),R5	;GET ADDRESS OF MSG HEADER IN TASK
	KMOV	(R5),R2		;GET CALLER TASK NAME
	MOV	R2,2(SP)	;FILL IN FOR OUR CALLER (EV BUMP USES)
	MOV	6(R4),R3	;DATA ADDR IN TASK SPACE
	MOV	R4,R5		;SAVE NODE ADDR FOR FRENOD
	MOV	10(R4),R4	;DATA SIZE IN TASK SPACE
;NOW WE ARE ALL SET EXCEPT THAT NODE MUST BE FREED. DO SO.
;R5 = NODE ADDRESS TO FREE. SYSTEM OFFSET OF 1 WORD HANDLED BY FRENOD.
;SAVE EV ADDR TO BUMP
	MOV	4(R5),-(SP)
	JSR	PC,FRENOD	;FREE UP THE NODE
;NOW FILL IN R5 WITH EV ADDR TO BUMP.
24$:	MOV	(SP)+,R5
	MOV	R1SAV,R1	;RESTORE CALLER'S R1
	CCC
	RTS	PC
;

;
;FRENOD - FREE NODE POINTED AT BY R5. 1ST NODE WORD IS NO. BLKS THERE.
;ASSUMES SYSTEM BITMAP.
	.GLOBL	FRENOD	;CALLED FROM MXCONN
FRENOD:	JSR	R5,S.RSAV	;MUST PRESERVE ALL REGS HERE!
	MOV	#MX.NSZ,R0
	MOV	#PX.NSZ,R1
	MOV	#PX.WRD,R2
1$:	MOV	(R1)+,(R0)+	;COPY WORK AREA TO SCRATCH FOR S.BFA/S.BFR
	SOB	R2,1$
;	SUB	#4,R5		;PASS NODE HEADER POINTERS
	MOV	-(R5),R4	;GET NO. BUFFERS (AND POINT TO REAL BUF START)
	MOV	R5,-(SP)	;PUSH BUFFER ADDRESS NOW
	MOV	R4,-(SP)	;PUSH NO. BUFFERS (USUALLY 1)
	JSR	R5,S.BRL	;FREE THE BUFFERS
;NOW COPY WORK AREA BACK
	MOV	#MX.NSZ,R1
	MOV	#PX.NSZ,R0
	MOV	#PX.WRD,R2
2$:	MOV	(R1)+,(R0)+	;COPY SCRATCH TO WORK
	SOB	R2,2$
	JSR	R5,S.RRES	;RESTORE CALLER'S REGISTERS
	RTS	PC
;


;
; BUFFER ALLOCATE/FREE SUBS ARE USED TO HANDLE THE SYSTEM
;NODE POOL OR TASK NODE POOLS.
	.PSECT	$PPOL$,RW,CON,D
PX.NSZ:	.WORD	20	;NUMBER WORDS IN A NODE
PX.TOA:	.WORD	MX.TOB	;ADDR OF BUF POINTER
PX.TOB:	.WORD	POOL	;CURRENT HIGHEST USED BUFFER
PX.EOM:	.WORD	POOL	;START OF BUFFERS (UNCHANGING)
PX.BFS:	.WORD	MX.BMP	;POOL CONTROL BITMAP START
PX.BFE:	.WORD	MX.MPE	;END OF CONTROL BITMAP
PX.PLA:	.WORD	PLA	;END OF POOL
PX.WDS=<.-PX.NSZ>/2	;NO. WORDS IN PERM. MAP
PX.WRD=PX.WDS
	.PSECT	$POOL$,RW,CON,D
;POOL CONTROL FOLLOWED BY POOL ITSELF. POOL CONTROL MAY BE
;DUPLICATED FOR USE BY THIS SET OF ROUTINES. BUFFERS ARE
;NOMINALLY 16 WORDS LONG BUT THE CONSTANT IS IN THE POOL
;CONTROL AREA.
;  ENTRY POINTS USING THIS SUB ARE EXPECTED TO KEEP THE
;POOL CONTROL AREA IN A SINGLE CPU SO IT CAN BE ALTERED
;AS NEEDED.
	.GLOBL	MX.MPE,MX.NSZ,PX.NSZ,PX.WRD
	.GLOBL	MX.BMP
MX.NSZ:	.WORD	20	;NUMBER WORDS IN A NODE
MX.TOA:	.WORD	MX.TOB	;ADDR OF BUF POINTER
MX.TOB:	.WORD	POOL	;CURRENT HIGHEST USED BUFFER
MX.EOM:	.WORD	POOL	;START OF BUFFERS (UNCHANGING)
MX.BFS:	.WORD	MX.BMP	;POOL CONTROL BITMAP START
MX.BFE:	.WORD	MX.MPE	;END OF CONTROL BITMAP
MX.PLA:	.WORD	PLA	;END OF POOL
MPSZ=3	;NO. WORDS IN BITMAP
MX.BMP:	;BITMAP
	.REPT	MPSZ
	.WORD	0	;ALL NODES INITIALLY ARE FREE
	.ENDR
MX.MPE:
	.WORD	0	;GUARD BETW NODE AND MAP
POLSZ=MPSZ*20*40	;SIZE OF NODE POOL IN BYTES
POOL:	.BLKW	POLSZ
PLA:
	.PSECT	MXSUBS,RW
M.MMP=0;THIS IS A MULTIPROCESSOR MONITOR!
;BUFFER ALLOCATE & RELEASE ROUTINES:
R0=%0
R1=%1
R2=%2
R3=%3
R4=%4
R5=%5
SP=%6
PC=%7
;  BUFFER ALLOCATE:
;CALLED BY:-
;		MOV	#N,-(SP)
;		JSR	R5,S.BFA
;
;	WHERE 'N' IS THE NUMBER OF CONTIGUOUS
;		16-WORD BUFFERS REQUIRED.
;
;ON RETURN, STARTING ADDRESS OF BUFFER WILL BE
;	ON TOP OF THE STACK. IF NONE AVAILABLE,
;	0 WILL REPLACE THIS ADDRESS.
;
	.GLOBL	S.BFA,S.RSAV,S.RRES,MX.EOM,MX.BFS,MX.BFE,MX.TOB
	.GLOBL	S.BRL
;
;SET UP CHECK:
S.BFA:	JSR	R5,S.RSAV	;SAVE CALLER REGISTERS
	MOV	MX.EOM,-(SP)	;GET START OF BUFFERS
	MOV	MX.NSZ,R0		;SET MAGIC CONSTANT
	MOV	SP,R5		;GET CALL ARGUMENT PTR
	ADD	#20,R5		;PASS SAVED REGISTERS
	ASL	R0		;NOW GET CONSTANT 40
	MOV	MX.BFS,R4		;GET ALLOC TABLE START
	MOV	@R5,R3		;SET BUFFER NO. CNT
	MOV	#1,R2		;.... & BIT MASK
;LOOK FOR FREE BUFFER:
BFALA:	MOV	(R4)+,R1	;GET TABLE ENTRY 
BFALB:	ADD	R0,@SP		;TRACK END OF BUFFER
;	CMP	@SP,SP		;STACK TOO LOW?
;	BHIS	BFGTX		;IF SO ERROR!!
	BIT	R2,R1		;APPROP. BUFFER FREE?
	BEQ	BFALD		;IF SO LOOK FOR CONTIGUITY
	MOV	@R5,R3		;RESET COUNT (= NEW CHAIN)
BFALC:	ASL	R2		;ADJUST MASK
	BCC	BFALB		;CONTINUE UNLESS NEW TABLE WD
	ROL	R2		;OTHERWISE RESET MASK
	CMP	R4,MX.BFE		;AT TABLE END?
	BLO	BFALA
;NO BUFFER AVAILABLE:
BFGTX:	CLR	@SP		;IF SO NO BUFFER AVAILABLE
	BR	BFALF		;EXIT NOW!
;CHECK FOR REQUIRED CONTIGUITY:
BFALD:	DEC	R3		;REQD. NO. OF BUFFER UNITS?
	BNE	BFALC		;IF NOT CONTINUE SEARCH
	TST	-(R4)		;GO BACK TO LAST TABLE ENTRY
;ADJUST TOP OF BUFFER MARK IF NECESSARY:
	CMP	MX.PLA,@SP
	BLOS	BFGTX
1$:	MOV	MX.TOA,R3		;GET CURRENT TOP ADDRESS
	CMP	@SP,@R3		;NEW BUFFER BEYOND?
	BLO	BFALE
	MOV	@SP,R1		;IF SO GET NEW TOP
	ADD	R0,R1
	MOV	@(R3)+,@R1	;SET NEW STOPPER.... 
	MOV	@#PS,-(SP)
	BIS	#340,@#PS	;GUARANTEE NO INTERRUPTS HERE
	CLR	@-(R3)		;.... & CLEAR OLD
	MOV	R1,@R3		;STORE NEW TOP ADDRESS
	MOV	(SP)+,@#PS
;ALLOCATE BUFFER UNITS:
BFALE:	CLC			;PLAY SAFE WHILE ....
	BIS	R2,@R4		;ALLOCATE BUFFER UNIT
	ROR	R2		;ADJUST BIT MASK
	BCC	1$
	ROR	R2		;IF NEXT TABLE WORD....
	TST	-(R4)		;... ADJUST ACCORDINGLY
1$:	SUB	R0,@SP		;BUILD BUFFER START ADDR
	DEC	@R5		;MORE ALLOCATIONS?
	BNE	BFALE
;ALLOCATION COMPLETE - EXIT:
BFALF:	MOV	(SP)+,@R5	;GIVE START ADDR TO CALLER
	JSR	R5,S.RRES	;RESTORE HIS REGS.
	RTS	R5		;... & EXIT
;

;
;  BUFFER RELEASE:
;CALLED BY:-
;		MOV	#ADDR,-(SP)
;		MOV	#N,-(SP)
;		JSR	R5,S.BRL
;
;	WHERE 'ADDR' IS THE STARTING ADDRESS OF
;		THE BUFFER AND 'N' IS THE NO. OF
;		CONTIGUOUS 16-WORD UNITS IN THE BUFFER
;
;ON RETURN THE ARGUMENTS WILL BE REMOVED FROM THE
;	STACK. NO ACTION WILL HAVE BEEN TAKEN IF
;	THE ARGUMENTS PROVIDE INVALID REFS.
;
;
;FIND TOP OF BUFFER:
S.BRL:	JSR	R5,S.RSAV	;SAVE CALLER REGS.
	MOV	MX.NSZ,R5		;SET MAGIC CONSTANT
	MOV	SP,R0		;SET PTR TO CALL ARGS
	ADD	#20,R0		;PASS SAVED REGISTERS
	MOV	@R0,R1		;GET BUFF START ADDR
	MOV	MX.EOM,R2	;... STRT ADDR OF BUFF AREA
	SUB	R2,R1		;SET UP FOR TABLE PTR
	BMI	BRLEX		;IF TOO LOW IGNORE CALL
	ASL	R5		;NOW GET 40
	ADD	R5,R2		;GET TOP OF BUFFER COUNTER
	MOV	-(R0),R3	;GET COUNT OF BUFFER UNITS
	BLE	BRLEX		;AGAIN IGNORE IF INVALID
2$:	ADD	R5,R1		;GO TO TOP UNIT
	DEC	R3
	BNE	2$
	ADD	R1,R2		;COMPLETE T.O.B. ADDR
	SUB	R5,R1		;ADJUST TOP UNIT PTR (START)
;DETERMINE BIT IN ALLOCATION MAP:
	INC	R3		;SET BIT MASK
	MOV	R1,R4		;HOLD TOP UNIT PTR
	MOV	R0,-(SP)	;NEED A REGISTER
	MOV	R5,-(SP)
	CLR	R5		;NEED MASK TO ZERO LOW ADDR WITH
	MOV	MX.NSZ,R0	;GET NODE SIZE
	CLC
	ROR	R0		;SET TO DIVIDE BY WORD GRANULARITY
	ASL	R0
	ASL	R0
	ASL	R0
	ASL	R0		;BY SHIFTING
	ASL	R0	;ACCOUNT FOR LOW BIT WE ZERO VIA EXTRA SHIFT
	BIS	R0,R5	;R0 HAS 1 BIT SINCE BUFFERS ARE POWER OF 2 LONG
	CLC
	ROR	R0
	CLC
5$:	ROR	R1		;SHIFT ADDR DOWN TO DIVIDE
	BIS	R0,R5		;ZAP BIT IN HIGH PART
	ROR	R0		;SHIFTING ADJUSTED SIZE DOWN TOO
	BCC	5$		;UNTIL R1 IS DIVIDED BY SIZE*16
	COM	R5		;MASK OFF ALL BUT WHAT WE SET INTO R5
	BIC	R5,R4		;THEN AND THE TWO REGS SO R4 HI PART MASKED OFF
	MOV	(SP)+,R5
	MOV	(SP)+,R0
;	CLRB	R1		;FIND WORD IN TABLE
;	SWAB	R1		;(I.E. DIVIDE BY 256X2)
	BIC	R3,R1		;CLR LOW BIT
	ADD	MX.BFS,R1		;USE TO SET TABLE PTR
;	BIC	#177000,R4	;FIND BIT IN WORD
;	BEQ	BFRLA		;I.E. DIVIDE BY 16X2 ...
	TST	R4	;NOW SEE IF AT START OR END
	BEQ	BFRLA
3$:	ASL	R3		;...& SHIFT BIT TO POSITION)
	SUB	R5,R4
	BGT	3$
	BLT	BRLEX		;IF REMAINDER ADDR INVALID
;CHECK TOP OF BUFFER:
BFRLA:	CMP	R2,MX.TOB		;LAST BUFFER ALLOCATED?
	BHI	BRLEX		;IF TOO HIGH ADDR ERROR
	BLO	BFRLB
	MOV	MX.TOA,R4		;SET SWITCH FOR LATER
;RELEASE BUFFER:
BFRLB:	BIC	R3,@R1		;FREE BUFFER UNIT
	SUB	R5,R2		;REDUCE MX.TOB PTR
	ROR	R3		;ADJUST BIT MASK
	BCC	BFRLC
	ROR	R3		;GO TO NEXT TABLE WORD
	TST	-(R1)		;... WHEN NECESSARY
BFRLC:	DEC	@R0		;FREED ALL UNITS?
	BGT	BFRLB
;DE-ALLOCATE FURTHER IF POSSIBLE:
	TST	R4		;THIS LAST BUFFER?
	BEQ	BRLEX		;IF SO EXIT NOW
	CMP	R1,MX.BFS	;ALL BUFFERS GONE?
	BLO	BFRLD
	BIT	R3,@R1		;IF NOT NEXT UNIT FREE?
	BEQ	BFRLB+2		;IF SO GO TO NEXT
;ALL DONE - ADJSUT MX.TOB MARKER & EXIT:
BFRLD:	MOV	@(R4)+,@R2	;SET NEW STOP MARK
	CLR	@-(R4)		;... & CLEAR OLD
	MOV	R2,@R4		;SET NEW LIMIT
BRLEX:
	JSR	R5,S.RRES	;RESTORE CALLER REGS.
	MOV	(SP)+,@SP	;CLEAR ARGS OFF STACK
	MOV	(SP)+,@SP
	RTS	R5
;

;
;
;ENTAST - ENTER AST ON TASK STACK. CALLED FROM SCANNER IN SYSTEM STATE.
;
;NOTE THAT AT THIS POINT, THE TASK'S STATUS IS SAVED AND THE STACK
;MUST LOOK LIKE:
;
;CONTENTS OF CALL 6(SP)	=STATUS
;CONTENTS OF CALL 4(SP)	=TCB ADDR (EXIT AST CASE)
;CONTENTS OF CALL 2(SP)	=CPU NO.
;OLD PS
;OLD PC
;
;THE AST IS EXITED VIA AN AST EXIT TRAP FOR MESSAGE AST AND AN EXIT FOR EXIT
;AST.
;
;ENTRY R1 IS ADDRESS TO ENTER AT.
;
	.GLOBL	ENTAST
ENTAST:
;ON ENTRY R0 POINTS TO TCB OF TASK IN USE.
	MOV	(SP)+,R2	;COLLECT RETURN
;NOTE STACK IN USE IS NOT TASK'S STACK BUT SYSTEM'S. WE MANIPULATE TASK STK
;AS WE LIKE.
;GUARANTEE MAPPED TO TASK ONCE FOR ALL...
	.IIF DF,SAXCL, JSR PC,U.LDR
	.IIF DF,M$GE,  JSR PC,U.ALD
;NOW PUT RETURN BELOW CALLING ARGUMENTS (WHICH WE WILL  GET RID OF)
	MOV	(SP),-(SP)	;COPY TOS
	MOV	4(SP),2(SP)	;COPY TCB ADDR
	MOV	6(SP),4(SP)	;COPY STATUS
	MOV	R2,6(SP)	;MOVE RETURN WHERE IT BELONGS NOW.
;NOW WE CAN POP ARGS OFF STACK AS NEEDED.
	MOV	TCBDSP(R0),R2	;GET TASK SP
	BNE	1$		;IF NONZERO ALL OK
	ADD	#6,SP		;ELSE FLUSH STACK
	SEC
	RTS	PC		;RETURN ERROR
1$:			;LOOKS LIKE ALL IS WELL. GO ON.
	.IF	DF,SAXCL	;IF DUAL MODE STANDALONE THIS IS RATHER EASY.
	SUB	#12,TCBDSP(R0)	;MAKE ROOM FOR AST ENTRY ON TASK STACK
	MTPI	-6(R2)		;STORE CPU NO AND POP STACK
	MTPI	-4(R2)		;STORE TCB ADDR
	MTPI	-2(R2)		;STORE STATUS WORD
	MOVK	TCBDPC(R0),-12(R2) ;COPY OLD PC
	MOVK	TCBDPS(R0),-10(R2) ;AND OLD PS
	MOV	R1,TCBDPC(R0)	;SAVE AST ENTRY ADDRESS AS NEW PC
;DUAL MODE NOW COMPLETE. INDICATE SUCCESS BY CCC INSTRUCTIONS
	.IFF
;SINGLE MODE (DOS AND RSX VERSIONS) COME HERE. STATUS IS ON TASK'S STACK
;SO WE MUST MOVE IT DOWN AND STASH NEW STUFF WHERE BEST DESERVED.
;NOTE HOWEVER THAT TASK'S STACK IS IN ITS SPACE AND TAKE PRECAUTIONS
;AS NEEDED.
	A$PROF=0
	.IIF	DF,M$GE, A$PROF=16
;A$PROF IS STACK OFFSET DUE TO APR SAVE/RESTORE INFO ON STACK
;MUST FIRST ADJUST TASK STACK TO POP OFF ANY EXTRA WORDS ON IT.
	MOVB	17+A$PROF(R2),R3	;GET NUMBER EXTRA WORDS
	BIC	#177400,R3		;(NO SIGN EXTEND)
	MOV	R2,R4
	MOV	R2,R5
	ADD	R3,R5			;R5 IS END OF NEW STACK,R4 IS END OF OLD
	MOV	#16+A$PROF,-(SP)	;REGS + APRS CONTEXT SAVED+PS,PC
	ADD	(SP),R4
	ADD	(SP),R5			;LOOK AT TOP OF STACK
	CMP	(R4)+,(R5)+		;ADJUST FOR LATER AUTODEC
	ASR	(SP)			;ALSO MAKE STACK HAVE A WORD COUNTER
20$:	MOV	-(R4),-(R5)
	DEC	(SP)			;MOVE UP STACK
	BGE	20$	;(BGE DOES ONE MORE TO ACCOUNT FOR STARTING AT 0)
	TST	(SP)+			;DO WHOLE STACK
	ADD	R3,TCBDSP(R0)		;ADJUST DYNAMIC VALUE
	ADD	R3,R2			;AND ADJUST LOCAL STACK POINTER
	CLRB	17+A$PROF(R2)		;ALSO CLEAR COUNT TO POP EXTRA
;NOW THE TASK STACK HAS ALL EXTRA WORDS POPPED OFF AND WE CAN MOVE
;OUR NEW 5 WORDS TO THE STACK ATOP THE STATUS.
	MOV	#<10+<A$PROF/2>>,R3	;NO. WORDS ON STACK
	MOV	R2,R4			;COPY TASK SP
	SUB	#10.,TCBDSP(R0) ;ADJUST TASK STACK POINTER
;COPY DOWN TASK STACK
	MOV	R2,R5			;COPY TASK STACK AGAIN
	SUB	#10.,R2			;PREPARE TO MOVE DOWN
2$:	MOV	(R5)+,(R2)+		;FILL IN FROM BELOW
	SOB	R3,2$			;UNTIL DONE WORDS TO DO.
	SUB	#10.,R4			;ADJUST SAVED SP COPY TOO
;STACK IS NOW MOVED DOWN...WE CAN STICK THE STUFF ON TOP NOW.
	MOV	14+A$PROF(R4),20+A$PROF(R4)		;COPY OLD PC OF TASK
	MOV	16+A$PROF(R4),22+A$PROF(R4)		;COPY OLD PS OF TASK	
	CLRB	17+A$PROF(R4)		;ENSURE NO EXTRA STACK POPS AT START
	MOV	R1,14+A$PROF(R4)		;COPY AST PC INTO STACK
;NOTE RSX VERSIONS ALL ARE ONE-SPACE VERSIONS SO NO CONDITIONS ON M$GE
	MOV	(SP)+,24+A$PROF(R4)
	MOV	(SP)+,26+A$PROF(R4)
	MOV	(SP)+,30+A$PROF(R4)		;SAVE CPU, TCB, STATUS INFO
;DONE NON-STANDALONE CASE.
	.ENDC
	CCC
	RTS	PC
;
;A WORD TO THE WISE!!!
;	THE STATUS OF A TASK SHOULD NOT BE STORED LIKE THIS IN A DATA
;STRUCTURE IN TASK SPACE...ESPECIALLY WHERE THE STRUCTURE IS FIFO AND
;NOT RANDOM ACCESS. IT CAN BE HANDLED BUT IS MESSY AS SEEN ABOVE. THE
;STAND-ALONE CASE HAS MUCH BETTER PROPERTIES. IF I WERE DOING THE WHOLE
;THING OVER, BOTH WOULD WORK THIS WAY AND IT'D BE JUST TOO BAD IF THE
;TASK TABLES WERE A LITTLE LARGER (THE ORIGINAL REASON FOR KEEPING
;REGISTERS ON THE STACK WAS THAT THE TCB ENTRY COULD BE KEPT SMALL AND
;STACK USED EFFICIENTLY, BUT THE INTRODUCTION OF ERROR RECOVERY AND
;SPECIAL CONTROL TRANSFER PATHS, AND OF NEW SPACES, HAS MADE THIS
;UNWIELDY.	... GLENN C. EVERHART
;
;

	.IF	DF,SE$K
;FUNDAMENTAL MULTILEVEL SECURITY CHECKING ROUTINES.
;(LOW LEVELS FIRST...)
;
;MLSLVL - CHECK MLS SECURITY LEVELS ACCESS.
; (NOTE: CLASSIFICATION BLOCK HAS 1 BYTE LEVEL
;	FOLLOWED BY 15 BYTES OF SPECIAL CATEGORIES.)
;(NOTE BHIS=BCC)
;	INPUTS TO THE FOLLOWING:
;	R4=ADDRESS OF CLASSIF BLK OF DATA SENDER
;	R5=ADDRESS OF CLASSIF BLK OF DATA RECEIVER
;	RETURN C SET IF INVALID CLASSIFICATION, CC OTHERWISE.
	.GLOBL	MLSLVL
MLSLVL:	;CLC
2$:	CMPB	@R5,@R4		;DEST CLASSIF => SRC CLASSIF?
;	BHIS	1$		;IF HGHER OR SAME (CARRY CLR) OK
;	SEC
;	RTS	PC
;1$:	CLC			;IF OK CLR CARRY
	RTS	PC		;NOTE Z SET IF EQUAL TOO.
;
;MLSINT - CHECK DATA INTEGRITY (NO WRITE UP) PROPERTY
	.GLOBL	MLSINT
MLSINT:	;CLC
2$:	CMPB	@R4,@R5		;SRC .GE. DEST CLASSIF?
;CARRY NOW CLEAR IF ALL RIGHT. COMMENT OUT CODE OTHERWISE NEEDED
;	BHIS	1$
;	SEC
;	RTS	PC
;1$:	CLC
	RTS	PC
;
;MLSCLS - CHECK CATEGORY LISTS.
;	THE RULE HERE IS THAT EVERY CATEGORY IN THE SENDER'S SPECIAL
;CATEGORY LIST MUST APPEAR IN THE DESTINATION'S SPECIAL CATEGORY LIST.
;ALSO NOTE THAT 0 IS THE PUBLIC CATEGORY AND IS IGNORED HERE.
;	INPUTS AS FOR MLSLVL AND MLSINT
	.GLOBL	MLSCLS
MLSCLS:	;CLC
22$:	JSR	R5,S.RSAV	;NEED REGISTERS HERE
	MOV	#15.,R0		;SET UP LOOP COUNT OVER SENDER CATEGORIES
	CMPB	(R4)+,(R5)+	;PASS SECURITY LEVELS (1ST BYTES)
MLX1$:	MOVB	(R5)+,R1	;***OUTER LOOP*** GET A SENDER'S CATEGORY
	BEQ	MLX3$		;IF 0 (PUBLIC), NO CHECK FOR RECEIVER MATCH
	MOV	R4,R2		;POINT TO START OF RECEIVE CATEGORY LIST
	MOV	#15.,R3		;SET UP LOOP OVER RCVR CATS
2$:	CMPB	(R2)+,R1	;***INNER LOOP*** FOUND MATCH?
	BEQ	MLX3$		;IF SO TRY NEXT SENDER SPECIAL CATEGORY
	SOB	R3,2$		;ELSE LOOK FOR MORE MATCHES
;FAILURE IF FALL THRU...RESTORE REGS AND SET CARRY AS ERROR FLAG
MLSNG:	JSR	R5,S.RRES
	SEC			;WE LOSE!
	RTS	PC
MLX3$:	SOB	R0,MLX1$	;GET NEXT SENDER CATEGORY
;WHEN WE EXIT HERE, ALL WAS WELL. EXIT WITH CC TO FLAG ALL OK
MLSOK:	JSR	R5,S.RRES
	CLC
	RTS	PC
;
;MLSFIL - FILL IN CLASSIFICATION DATA FOR 7 WORDS IN TASK ACTIVATE MESSAGE
; INPUT R1=MSG POINTER, R0=TCB ADDRESS. R1 POINTS AT AREA FOR DATA TO
; BE STORED IN (GUARANTEED EVEN).
	.GLOBL	MLSFIL,SETCAT
MLSFIL:	JSR	R5,S.RSAV
	MOV	TCBSCB(R0),R2	;SCB POINTS AT NAMEBLK
	MOV	16(R2),R2	;IF NAMEBLK EXISTS
	BEQ	MLSNG		;IF 0, BAD
	ADD	#24,R2		;POINT AT CLASSIF BLK
	MOV	#6,R3		;MOVE 6 WORDS (NOT ALL OF CLASSIF SO USE ONLY
				;1ST 6 WORDS WORTH OF CATEGORIES)
	TST	2(R1)		;DOES ANY CLASSIF LEVEL EXIST NOW?
	BNE	MLSOK		;IF SO LEAVE THE STUFF IN.
	MOV	-4(R2),(R1)+	;SAVE CLASSIFICATION PRIVS.
1$:	MOV	(R2)+,(R1)+	;COPY CLASSIF OR SPEC CATEGORY
	SOB	R3,1$
	BR	MLSOK		;RETURN ALL WELL
;
;SETCAT - SET UP MLS CATEGORIES IN TASK TO BE STARTED.
SETCAT:	JSR	R5,S.RSAV
	ADD	#12,R0		;POINT AT CLASSIF DATA. (R0+12=MSG DATA FROM MLSFIL)
	MOV	TCBSCB(R2),R1	;GET TASK'S SCB
	BEQ	MLSNG		;(BETTER BE ONE!)
	MOV	16(R1),R1	;GET NAME BLK
	BEQ	MLSNG		;BETTER BE THERE
	ADD	#22,R1		;POINT AT DEFAULT CLASSIFICATION
	CMPB	@R0,@R1		;OUR LEVEL GREATER THAN DEFAULT? (ERROR IF SO)
	BHI	MLSNG		;RETURN LOSE IF SO
	TSTB	2(R1)		;IS THERE AN EXISTING CLASSIFICATION?
	BEQ	3$		;IF NOT, ALL WELL
	CMP	@R0,-4(R1)	;CLASSIF PRIVS SAME?
	BNE	MLSNG		;IF NOT, LOSE
	MOV	R1,R3
	TST	(R3)+
	MOV	#6,R4
	MOV	R0,R5
4$:	CMP	(R5)+,(R3)+
	BNE	MLSNG
	SOB	R4,4$		;ALLOW MOVE ONLY IF IT CHANGES NOTHING
3$:	TST	(R1)+		;POINT R1 AT CLASSIF BLK NOW
	MOV	(R0)+,-4(R1)	;FILL IN CLASSIF PRIVS
	MOV	#6,R3		;RESTORE WHAT MLSFIL SAVED
1$:	MOV	(R0)+,(R1)+	;FILL IN CLASSIFICATION
	SOB	R3,1$		;FOR LEVEL + 13 SPECIAL CATEGORY BYTES
	JMP	MLSOK		;THEN RETURN ALL WELL SIGNAL
	.GLOBL	MMLSCK,MLSPWN,TWCHK,SETCLA,TWSET,DMLSCK
	.GLOBL	WTSET
;
;MMLSCK - CHECK MLS CONSIDERATIONS FOR MESSAGES.
; INPUTS: R0=CALLER TCB ADDRESS
;	  R2=CALLED TCB ADDRESS
;PRESERVE REGISTERS, RETURN C BIT IF FAIL CHECK
MMLSCK:	JSR	R5,S.RSAV	;PRESERVE REGS ACROSS CALL
	JSR	PC,CLSGET	;GET CLASSIF BLK ADDRS IN R4,R5 (IN,OUT)
;NOTE: 4 BEFORE CLASSIF BLK IS CLASSIF PRIV WORDS.
	JSR	PC,MLSLVL	;SEE IF SECURITY LEVELS ARE OK
	BCS	2$		;IF CS, BAD SECURITY
;SECURITY OK FOR DISCLOSURE. SEE IF INTEGRITY IS ALL RIGHT.
	JSR	PC,MLSINT	;CHECK INTEGRITY RULE
	BCC	3$		;IF ALL WELL, NO TEST ON READ/WRITE ACROSS LVL
	BIT	#100000,-4(R5)	;SEE IF EITHER HAS IGNORE MLS PRIV
	BNE	1$		;IF SO LET HIM GO
	BIT	#100000,-4(R4)
	BNE	1$		;SO IF EITHER END OF A MSG HAS MLS-VIOL. PRIV
				;THE MSG IS OK.
	BIT	#100002,-4(R4)	;SEE IF CALLER MAY SEND UP
	BEQ	MLSNG		;IF NOT, FAIL HIM
	BIT	#100001,-4(R5)	;SEE IF RECEIVER MAY READ FROM LOWER
	BEQ	MLSNG		;IF NOT, LOSE
;LOOKS LIKE MSG IS OK FOR LEVEL. SEE IF SPECIAL CLASS IS OK.
3$:	JSR	PC,MLSCLS	;SEE IF SPEC. CATS OK
	BCC	4$
;SPECIAL CATEGORIES ARE VIOLATED.
	BIT	#100400,-4(R4)	;OK FOR SENDER TO VIOLATE SPEC CATS?
	BNE	4$		;YES, SO GO ALLOW IT
	BIT	#100400,-4(R5)	;OK FOR RCVR TO VIOLATE TOO?
	BEQ	MLSNG		;LOSE IF NOT.
;FALL THRU WHERE ALL SEEMS TO BE WELL.
; SPECIAL CATEGORIES ARE OK (OR IGNORABLE).
4$:	JMP	MLSOK		;GO TO SAY ALL IS WELL
2$:			;HERE SECURITY LEVELS ARE VIOLATED.
;MUST ONLY ALLOW TRANSACTION IF ALL NEEDED PRIV BITS EXIST.
	BIT	#100000,-4(R5)	;IF EITHER IS SUPER PRIVILEGED LET IT BY
	BNE	37$
	BIT	#100000,-4(R4)
	BNE	37$
;IF NOBODY HAS SUPER PRIVILEGE, THEN REQUIRE BOTH TO BE OK
	BIT	#100020,-4(R5)	;MAY RCVR RCV FROM HIGHER?
	BEQ	MLSNG		;IF NOT, LOSE
	BIT	#100040,-4(R4)	;MAY SENDER SEND LOWER?
	BEQ	MLSNG		;IF NOT, LOSE
;LOOKS LIKE THE PRIVS ALLOW MSG TO LOWER CLASSIF.
;CHECK MLS CLASSES.
37$:
	JSR	PC,MLSCLS	;SEE IF SPEC COMPARTMENTS OK
	BCC	1$		;IF THEY ARE, LET HIM DO IT.
;SPEC. CATS ARE OFF.
	BIT	#101000,-4(R4)	;SO SEE IF SPEC CATS MAY BE IGNORED TOO
	BNE	1$		;IF SO, LET IT BY
	BIT	#101000,-4(R5)	;SEE IF EITHER MAY IGNORE SPECIAL CLASSES
	BEQ	M.LSN		;(CHECK BOTH)
1$:	JMP	MLSOK		;RETURN "ALL OK" TO CALLER
;
;MLSPWN - SEE IF TASK IS OK TO SPAWN (TASK DEFAULT CLASSIFICATION
;					.GE. SPAWNER CLASSIF.)
;IN:	R0=CALLER TCB
;	R2=CALLED TCB
;OUT:	C SET IF BAD, CLEAR IF ALL LOOKS WELL
MLSPWN:	JSR	R5,S.RSAV
	JSR	PC,CLSGET	;GET CLASSIF BLK ADDRS IN R4,R5 (IN,OUT)
	BIT	#100000,-2(R4)	;SENDER MAY IGNORE MLS?
	BNE	1$		;IF SO LET IT BY.
	BIT	#100000,-2(R5)	;IF SPAWNED TSK MAY IGNORE MLS ALREADY
	BNE	1$		;IF EITHER CAN IGNORE MLS, LET THRU
3$:	CMPB	-2(R5),@R4	;
;C BIT NOW SET IF RCVR DEFAULT CLASSIF [R5] < CALLER ACTUAL CLASSIF
	BLO	2$		;IF LESS, RETURN ERROR
1$:	JMP	MLSOK
2$:
M.LSN:	JMP	MLSNG
;
;TWCHK - CHECK TF TASK MAY AWAIT THE TASK IN A TWAIT BLOCK.
;	R0=INPUT TASK TCB ADDRESS (ISSUING THE TWAIT)
;	R1 POINTS TO TBL. 2(TBL) IS NAME OF TASK TO AWAIT
TWCHK:	JSR	R5,S.RSAV
4$:	ADRCHK	R1		;BE SURE TBL REALLY IS LEGAL
	BIT	#1,R1		;BE SURE EVEN
	BNE	2$
	KMOV	2(R1),R3	;GET TASK NAME
	JSR	PC,ATLOOK	;FIND IT IF POSSIBLE
	BEQ	2$		;FAILURE MEANS LOSE
;NOW R2=TCB TO AWAIT.
;	TREAT A TWAIT AS A SEND FROM TASK [R2] TO TASK [R0]
	MOV	R0,-(SP)
	MOV	R2,R0
	MOV	(SP)+,R2	;EXCHANGE ROLES OF R2, R0
	JSR	PC,MMLSCK	;SEE IF MSG IS OK
	BCS	2$		;IF RETURNS ERROR, RETURN ERR TO OUR CALLER
	.IF	DF,MULT15	;IF TWAIT BLOCK MAY BE MORE THAN 1 LONG
	ADD	#10,R1		;PASS OLD TWAIT BLOCK ENTRY
	KMOV	@R1,R3		;GET NEXT WORD (0 AT END OF LIST)
	BNE	4$		;IF NONZERO, TEST IT.
	.ENDC
1$:	JMP	MLSOK
2$:	JMP	MLSNG
;
;SETCLA - SET CLASSIFICATION TO MIN (CALLER'S, DEFAULT).
;	RETURN CS IF CAN'T.
;IN: R0=CALLER TCB, R2=CALLED TCB
;NOTE: SET "IGNORE MLS" BIT IF A PREMANENT TASK AND IT WAS SET BEFORE.
SETCLA:	JSR	R5,S.RSAV
	JSR	PC,CLSGET	;GET CLASSIF BLK ADDRS IN R4,R5 (IN,OUT)
	MOVB	-2(R5),R3	;LOAD DEFAULT CLASSIFICATION
	CMPB	@R4,R3		;SEE IF CALLER'S IS LESS OR EQUAL
	BHI	3$		;IF NOT, SKIP UPDATE
	MOVB	@R4,R3		;IF SO, DO THE UPDATE
	TSTB	@R5		;IS THERE A CLASSIFICATION THERE ALREADY?
	BNE	1$		;IF SO, NO RECLASSIFICATION
3$:	MOVB	R3,@R5		;SET CALLED CLASSIF TO NEW VALUE
	MOV	-4(R5),R3	;GET OLD MASK
	BIC	#^C110000,R3	;LEAVE "IGNORE MLS" AND "ASYNC I/O" BITS
	MOV	-4(R4),-4(R5)
	BIS	R3,-4(R5)	;COPY PRIV MASK NOW
	CMPB	(R4)+,(R5)+	;BUMP PAST CLASSIF LEVEL BYTES
	MOV	#11.,R3		;BYTES OF SPECIAL CATEGORIES
;NOTE THAT THOUGH 16 BYTES ARE RESERVED, ONLY 11 ACTUALLY CAN GET
;PASSED ACROSS CPU'S, SO ONLY TREAT 11 ANY TIME.
4$:	MOVB	(R4)+,(R5)+	;COPY SPEC CAT LIST
	DEC	R3
	BGT	4$		;DO ALL 11 BYTES
1$:	JMP	MLSOK
;2$:	JMP	MLSNG
;
;TWSET - SET TASK INTO TWAIT. R2=TCB OF TASK TO END WAIT ON EXIT OF,
;	R0=TCB OF TASK TO PUT INTO TWAIT.
TWSET:	JSR	R5,S.RSAV
;NOTE THAT WE USE TASK STACK SPACE FOR TWAIT BLOCKS. THIS DOES NOT DEPEND
;ON TASK STRUCTURE. EV IS IN MSG HDR
	KMOV	@R1,R4		;LOCATE MSG HDR
	KMOV	SP,R5		;GET TSK SP
	SUB	#12.,R5		;POINT TO AN AREA FOR TWAIT BLOCK
	KMOV	12(R4),R3	;SEE IF THERE IS AV EV TO AWAIT
	BEQ	3$		;IF NONE, FILL IN OURS
	ADRCHK	R3		;ENSURE LEGALITY
	BIT	#1,R3
	BEQ	4$		;IF NOT, USE OURS
3$:	MOV	R5,R3
	SUB	#2,R3		;USE STACKED EVA
4$:	MOVK	R3,(R5)
	MOV	R5,R1
	TST	(R5)+
	MOVK	@R2,(R5)+	;SAVE TSK NAME WAITED ON
	MOVK	#-1,(R5)+	;WAIT FOR NONZERO EV
	MOVK	#0,(R5)+
	MOV	R1,TCBEVA(R0)	;SET TWAIT
	MOVB	#15,TCBST(R0)	;ADDR AND STATE
	JSR	R5,S.RSAV	;NOW SEE IF IT WILL FAIL AT ONCE TOO
	JSR	PC,MMLSCK	;BY MLS CHECK
	BCS	7$
	JSR	R5,S.RRES
1$:	JMP	MLSOK
2$:	JMP	MLSNG
7$:	JSR	R5,S.RRES
	.IIF DF,SAXCL,JSR PC,U.LDR
	.IIF DF,M$GE,JSR PC,U.ALD
	MOVK	#-7,@R3		;FILL IN HIS EV
	BR	2$		;WAIT WILL FAIL
;
;DMLSCK - CHECK MLS AND I/O ON DEVICE.
;IN: R3=LUN NO
;	R0=TCB
;	R1 POINTS TO USER ARG LIST FOR QTRAN
MLSNGJ:	JMP	MLSNG
MLSOKJ:	JMP	MLSOK	;TRANSFER VECTORS
DMLSCK:	JSR	R5,S.RSAV
	;HERE GET R4=INPUT SOURCE, R5=OUTPUT SOURCE CLASSIF BLKS
;	ALSO SET R3 NONZERO IF READ, 0 IF WRITE
	CLR	R3
	KMOV	(R1),R5	;GET LUN NO.
	DEC	R5	;MAP TO 0 THRU MAXLUN-1
	ASL	R5	;GET AS INDEX
	KMOV	2(R1),R4	;GET QBLK ADDRESS
	ADRCHK	R4	;BE SURE LEGAL QBLK
	BIT	#1,R4	;ODD LOSES
	BNE	MLSNGJ	;
	.IF	DF,SAXCL
;DPB FORMAT IS
;	BLK NO.
;	START VIRT ADDR
;	NO. BYTES
;	FUNCT (4=READ,2=WRITE,6=SPEC)
;	SPARE
	KMOV	6(R4),R3	;GET FUNCT IN R3
	SUB	#2,R3		;LEAVE 0 IF A WRITE, ELSE NONZERO
	.IFF
;DPB FORMAT IS QIO BLK, IO.RVB OR IO.WVB FIRST
	KMOV	(R4),R3		;GET FUNCT IN R3
	SUB	#IO.WVB,R3	;LEAVE 0 ON WRITE
	.ENDC
	BEQ	40$		;IF WRITE, BRANCH
;READ. TASK IS RECEIVER, DEV IS SENDER
	MOV	CLADEV(R5),R4	;R4=SENDER (DEVICE) CLASSIF BLK
	MOV	TCBSCB(R0),R5	;GET TSK CLASSIF BLK
	BEQ	MLSNGJ
	MOV	16(R5),R5	;GET NAME ADDR
	BEQ	MLSNGJ
	ADD	#24,R5		;POINT AT CLASSIF BLK
	BR	42$
40$:
;WRITE. TASK IS SENDER, DEV IS RECEIVER.
	MOV	CLADEV(R5),R5	;R5=RECEIVER (DEVICE) CLASSIF BLK
	MOV	TCBSCB(R0),R4	;GET SCB, THEN CLASSIF BLK
	BEQ	MLSNGJ
	MOV	16(R4),R4	;GET NAME BLK
	BEQ	MLSNGJ
	ADD	#24,R4		;POINT AT CLASSIF BLK
42$:
;THEN CHECK LEGAL I/O BOUNDARIES
;
; NOTE: I/O LEGALITY MUST BE CHECKED HERE.
;	SAME CHECK FOR READ OR WRITE.
; THIS IS DONE EVEN FOR NON-DMA DEVICES SINCE THE DRIVERS SHOULD NOT HAVE
;TO BE TRUSTED AS FULLY AS WOULD BE NECESSARY IF THEY INCLUDED THE TEST
;CODE. USERS WILL PROBABLY ADD DRIVERS, SO THE ADDRESS CHECKS SHOULD
;BE DONE OUTSIDE FREQUENTLY-CHANGED CODE AS MUCH AS MAY BE.
;
	.IF	DF,SAXCL
;ONLY CHECK I/O IN STAND ALONE VERSIONS.
	JSR	R5,S.RSAV
	KMOV	2(R1),R4	;GET I/O D.P.B. ADDRESS
;R0 = TCB ADDRESS
	KMOV	2(R4),R2	;R2=VIRTUAL ADDR OF START
	KMOV	4(R4),R3	;R3=NO. BYTES
	MOV	R2,R5		;SEE IF VIRT ADDR ENDS PAST 32K
	CLC
	ADD	R3,R5		;IF SO MUST SET CARRY
	BCS	35$		;LOSE...MAX VIRT ADDRESS OVER 32K!
;COULD STILL HAVE NONCONTIGUOUS APRS, SO SEE WHERE MIN AND MAX APR ARE NOW.
	ASH	#-12.,R5	;GET END APR
	ASH	#-12.,R2	;AND FIRST APR
;MASK OFF NONSENSE
	BIC	#^C16,R2	;LEAVE ONLY VALID OFFSETS
	BIC	#^C16,R5
	SUB	R2,R5		;GET INDEX OF NO. APRS
	MOV	R5,R3
	ASR	R3		;LEAVE NO. APRS USED
	INC	R3		;R3 IS NUMBER OF APRS
	ADD	TCBAP1(R0),R2	;POINT R3 AT APR TBL
	MOV	(R2)+,R5	;GET VALUE IN THE APR
36$:	DEC	R3		;COUNT DOWN APRS
	BLE	34$		;IF USED UP, ALL SET
	MOV	(R2)+,R1	;GET NEXT APR
	ADD	#200,R5		;SEE IF 4K MORE
	CMP	R1,R5
	BEQ	36$		;IF CONTIG PHYS MEM, GO SEE IF MORE
35$:	JSR	R5,S.RRES
	JMP	MLSNG		;FAIL ON BAD I/O
34$:	JSR	R5,S.RRES
	.ENDC
;
;NOTE: 4 BEFORE CLASSIF BLK IS CLASSIF PRIV WORDS.
	JSR	PC,MLSLVL	;SEE IF SECURITY LEVELS ARE OK
	BCS	2$		;IF CS, BAD SECURITY
;SECURITY OK FOR DISCLOSURE. SEE IF INTEGRITY IS ALL RIGHT.
	JSR	PC,MLSINT	;CHECK INTEGRITY RULE
	BCC	3$		;IF ALL WELL, NO TEST ON READ/WRITE ACROSS LVL
	TST	R3	;TASK READING? (NON-0)
	BNE	12$	;IF SO TEST RECEIVER ONLY
	BIT	#100010,-4(R4)	;SEE IF CALLER MAY SEND UP
	BEQ	MLSNGJ		;IF NOT, FAIL HIM
	BR	3$		;GO CHECK SPEC CATS
12$:	BIT	#100004,-4(R5)	;SEE IF RECEIVER MAY READ FROM LOWER
	BEQ	MLSNGJ		;IF NOT, LOSE
;LOOKS LIKE MSG IS OK FOR LEVEL. SEE IF SPECIAL CLASS IS OK.
3$:	JSR	PC,MLSCLS	;SEE IF SPEC. CATS OK
	BCC	4$
	TST	R3	;TASK READING (NON-0)
	BNE	13$	;IF SO, ONLY TEST RCVR
	BIT	#102000,-4(R4)	;OK FOR SENDER TO VIOLATE SPEC CATS?
	BEQ	MLSNGJ		;NO, CAN'T DO IT.
	BR	1$
13$:	BIT	#102000,-4(R5)	;OK FOR RCVR TO VIOLATE TOO?
	BEQ	MLSNGJ		;LOSE IF NOT.
;FALL THRU WHERE ALL SEEMS TO BE WELL.
4$:	BR	1$		;GO TO SAY ALL IS WELL
2$:			;HERE SECURITY LEVELS ARE VIOLATED.
;MUST ONLY ALLOW TRANSACTION IF ALL NEEDED PRIV BITS EXIST.
	TST	R3		;TASK READING?(NON-0)
	BEQ	14$		;IF NOT, TEST SENDER ONLY
	BIT	#100100,-4(R5)	;MAY RCVR RCV FROM HIGHER?
	BEQ	MLSNGJ		;IF NOT, LOSE
	BR	15$
14$:	BIT	#100200,-4(R4)	;MAY SENDER SEND LOWER?
	BEQ	MLSNGJ		;IF NOT, LOSE
;LOOKS LIKE THE PRIVS ALLOW MSG TO LOWER CLASSIF.
;CHECK MLS CLASSES.
15$:	JSR	PC,MLSCLS	;SEE IF SPEC COMPARTMENTS OK
	BCC	1$		;IF THEY ARE, LET HIM DO IT.
;SPEC. CATS ARE OFF.
	TST	R3		;TASK READING (NON-0)?
	BNE	16$		;IF SO, CHK RCVR
	BIT	#101000,-4(R4)	;SO SEE IF SPEC CATS MAY BE IGNORED TOO
	BEQ	MLSNGJ		;IF NOT, LOSE
	BR	1$
16$:	BIT	#101000,-4(R5)
	BEQ	MLSNGJ
1$:	JMP	MLSOK
;
;WTSET - SET TASK INTO A WAIT ON EV IF EITHER CLASSIFS NOT SAME
;	OR NO PRIV TO DO ASYNCH I/O
;IN:	R0=TCB ADDR
;	R2=EV ADDRESS ADDRESS IN USER SPACE (USE MFPI @R2 TO GET)
;N.B. - USE 10000 BIT IN CLASSIF PRIV MASK AS ASYNCH I/O PRIVILEGE.
WTSET:	JSR	R5,S.RSAV
	MOV	TCBSCB(R0),R4
	BEQ	2$
	MOV	16(R4),R4	;GET NAMEBLK
	BEQ	2$
	ADD	#24,R4		;GET CLASSIF BLK
	MOV	R4,R2		;SAVE ADDR IN R2 FOR LATER
	KMOV	@R1,R3		;GET LUN NO.
;(KNOW EV OK BY NOW)
	DEC	R3
	ASL	R3
	MOV	CLADEV(R3),R5	;R5 GETS DEVICE CLASSIF BLK
	CMPB	@R5,@R4		;SAME CLASSIFICATIONS?
	BNE	3$		;NO, MUST WAIT
	JSR	PC,MLSCLS	;SPEC CATS SAME?
	BCS	3$
	MOV	R4,R3
	MOV	R5,R4
	MOV	R3,R5		;EXCHANGE ROLES
	JSR	PC,MLSCLS
	BCS	3$		;SPEC CATS NOT ALIKE, CAUSE WAIT.
4$:	BIT	#10000,-2(R2)	;MAY HE DO ASYNCH I/O?
	BNE	1$		;YES, LET IT BY
3$:	BIT	#100000,-2(R2)	;IGNORE MLS PRIV HERE?
	BNE	4$		;IF SO, MAYBE CAN LEAVE HIM ALONE
;PLACE TASK IN WAIT. R0=TCB.
	ADRCHK	R2		;BE SURE EVA OK
	BIT	#1,R2
	BNE	2$		;IF NOT, LOSE
	KMOV	(R2),R2		;GET EVA FROM ARG LIST
	ADRCHK	R2
	BIT	#1,R2
	BNE	2$		;TEST EVA NOW
	MOV	R2,TCBEVA(R0)	;SET EV ADDR TO AWAIT
	MOVB	#2,TCBST(R0)	;SET TASK WAITING FOR EV
1$:	JMP	MLSOK
2$:	JMP	MLSNG
;
;CLSGET - GET CLASSIFICATION BLOCK.
;USED BY OTHER SUBS HERE. ASSUMES R0, R2 ARE TCB ADDRESSES (IGNORES IF 0)
;AND GETS CLASSIF BLK FROM R0 TCB (SRC) INTO R4; CLASSIF BLK FROM
;R2 (DST) INTO R5. ASSUMES ALL REGISTERS MAY BE BASHED.
CLSGET:	TST	R0	;R0 A LEGAL TCB?
	BEQ	1$	;IF NOT, FORGET R4
	MOV	TCBSCB(R0),R4	;IF SO GET THE SCB
	MOV	16(R4),R4	;GET NAME BLK
	BEQ	1$		;SKIP IF NONE
	ADD	#24,R4	;POINT R4 AT CLASSIF BLK
1$:	TST	R2	;(ANY TCB?)
	BEQ	2$	;IF NOT, SKIP
	MOV	TCBSCB(R2),R5	;GET SCB
	MOV	16(R5),R5	;THEN NAME BLK
	BEQ	2$		;SKIP IF MISSING
	ADD	#24,R5		;POINT AT CLASSIF. BLK
2$:	RTS	PC
;
	.ENDC

	.IF	DF,DY$MEM	;DYNAMIC MEM ALLOCATION ONLY
;MSX-11 DYNAMIC MEMORY ALLOCATION/DEALLOCATION PRIMITIVES.
;
;	THE PHILOSOPHY OF TASK MEMORY ALLOCATION IS THAT MEMORY
;IS ALLOCATED AT TASK REQUEST IN 4K SEGMENTS, AND THAT TCB
;ENTRIES ARE ALLOCATED ALSO. MEMORY ALLOCATION OCCURS ONLY
;WHERE THE TASK ACTUALLY IS STARTED, BUT TCB ALLOCATION OCCURS
;VIA THE "TCBALO" SUBROUTINE AT TASK SETUP. THE "TCBCLR" SUBROUTINE
;DEALLOCATES THE TCB AGAIN, BASICALLY BY CLEARING ITS TASK NAME
;TO A PREDEFINED NULL NAME (NOT BINARY ZERO, BUT A RECOGNIZABLE
;PATTERN NOT AVAILABLE IN RAD50 TO PREVENT ITS ACCIDENTAL USE).
;THE TCBALO ROUTINE MUST  SET UP ALL NEEDED LINKS POSSIBLE, AND
;FINAL LINKING WILL BE DONE BY THE LOADER. THERE WILL BE ANOTHER
;SERVICE ROUTINE NAMED "NAMSRV" WHICH WILL BE CALLED VIA JSR PC
;AND WILL JUST DO RTS PC WHERE THE REQUESTED TASK CANNOT BE
;LOADED. IF THE TASK CAN BE LOADED, IT WILL ARRANGE FOR THAT
;LOAD TO TAKE PLACE AND RETURN WITH CARRY CLEAR. IF  CARRY IS
;SET, IT WILL MEAN THE CALLER SHOULD SET THE REQUESTOR'S EV
;HIMSELF TO FLAG AN ERROR (BY WHATEVER MEANS NECESSARY). WHEN A
;TASK CANNOT BE RUN AS REQUIRED DUE TO NO RESOURCES (NO MORE TCB
;ENTRIES FREE OR NOT ENOUGH MEMORY FOR THE TASK), THE DESTINATION
;CPU SHOULD BROADCAST A NOTIFICATION TO THAT EFFECT TO ALL OTHERS
;INDICATING TASK ABORT WITH AN "OUT OF RESOURCES" CODE. NORMALLY
;THE ACTIV8 ALGORITHM SHOULD ENSURE THIS CANNOT HAPPEN, BUT IT
;MUST BE ALLOWED FOR.
;	MEMORY WILL BE MAINTAINED BY A BITMAP OF PHYSICAL MEMORY
;WITH EACH BIT REPRESENTING 4K WORDS (4096 WORDS OR 8192. BYTES)
;OF MEMORY (=MAX FOR 1 APR). THE MSX KERNEL WILL BE REPRESENTED
;HERE, AND AVAILABLE MEMORY MUST BE INITIALIZED TO THE SPACE
;AVAILABLE ABOVE MSX. THIS MUST BE DONE MANUALLY BEFORE MSX
;IS ASSEMBLED.
;
	.IIF	NDF,NPERM,NPERM=7	;NUMBER OF PERMANENT TCB
					;ENTRIES, NOT MANAGED HERE.
;
	.IF	DF,SAXCL
APR.TK=10	;8 APR'S PER TASK IN S/A
	.IFF
APR.TK=6	;6 APR'S PER TASK IN RSX/IAS
	.ENDC
;TCB ALLOCATOR
	.GLOBL	TCBALO
;ENTRY R3=TASK NAME (RAD50). EXIT R0=TCB ADDR IF CC, UNCHANGED IF CS
TCBALO:
	JSR	R5,S.RSAV
15$:	MOV	#MX.TBL,R0	;POINT AT TABLE
;FIRST BE SURE TASK NOT IN TCB NOW
	JSR	PC,ATLOOK	;TRY TO FIND THE TASK
	BEQ	3$		;IF NOT THERE, LOOK SOME MORE
	MOV	R2,@SP		;IF THERE, RETURN TCB ADDR AND CC
	BR	2$		;RETURN CC
3$:	CMP	@R0,#-2		;EMPTY SLOT?
	BNE	4$		;NO, FORGET IT.
;BE SURE R0 NOT POINTING AT A "PERMANENT" ENTRY (NPERM IS NO. PERMANENT
;TASKS, I.E., ASSEMBLED IN...)
	CMP	R0,#<MX.TBL+<MX.TBS*NPERM>>
	BLO	4$		;IF A PERMANENT TASK, IGNORE THE -2.
	MOV	R3,@R0		;YES, CLAIM IT NOW.
	MOV	R0,@SP		;AND RETURN IT
	BR	2$		;RETURN OK
4$:	TST	@R0		;END OF LIST?
	BNE	14$		;IF NOT, ALL RIGHT
;GOT TO THE END OF THE LIST. SEE IF WE CAN FREE UP A TCB BY REMOVING
;AN EXITED TASK.
	CMP	MX.MUH+2,#MX.MUH	;IS THE MUL EMPTY?
	BEQ	1$		;YES, CANNOT ALLOCATE MORE SPACE
	JSR	PC,FRETSK	;NO, SO FREE UP A TASK (AND TCB).
	BR	15$		;IT WORKED, SO RESTART THE SEARCH.
14$:	ADD	#MX.TBS,R0	;IF NOT, KEEP GOING
	BR	3$
1$:
	JSR	R5,S.RRES
	SEC		;SAY NO MORE TCB SLOTS AVAILABLE
	RTS	PC
2$:
	JSR	R5,S.RRES
	CLC
	RTS	PC
;
;TCB FREEUP ROUTINE
	.GLOBL	TCBCLR
;ENTRY R0=TCB ADDRESS TO FREE
TCBCLR:
	CMP	R0,#<MX.TBL+<NPERM*MX.TBS>>
	BLO	2$		;DO NOT FREE PERMANENT TASKS
	MOV	R0,-(SP)
	MOV	TCBAP1(R0),R0	;POINT AT APR ADDRESSES
	MOV	R1,-(SP)
	MOV	#APR.TK,R1		;NO. APR'S TO DO
	MOV	R5,-(SP)
1$:	MOV	(R0)+,R5
	JSR	PC,FREAPR	;FREE THE MEMORY IN THIS TCB IF ANY
	DEC	R1
	BGT	1$		;DO ALL OF IT.
	MOV	(SP)+,R5
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	MOV	#-2,@R0		;FREE THE TCB BY PUTTING -2 IN NAME SLOT
2$:	RTS	PC
;
	.GLOBL	NAMSRV	;NAME SERVER
;ENTRY R3=NAME TO LOOK FOR
NAMSRV:
	JSR	R5,S.RSAV
	MOV	#NAMES,R1	;POINT AT NAME LIST
10$:	MOV	(R1),R4		;GET A NAME
	BEQ	1$		;IF WE CANNOT FIND ONE, FORGET IT
	CMP	R4,R3		;IS THIS IT?
	BEQ	2$		;YES, REJOICE.
	ADD	#NAMSZ,R1	;LOOK AT NEXT NAME.
	BR	10$
1$:	JSR	R5,S.RRES
	SEC		;SAY CANNOT FIND A NAME
	RTS	PC	;BACK
2$:
	JSR	PC,TCBALO	;GET A TCB TO FILL IN. RETURN ITS ADDR IN R2
	TST	R0		;DID WE FIND ONE?
	BEQ	1$		;NO, FORGET IT!
	MOV	R0,4(SP)	;COPY R0 TO RETURN R2
	CLR	12(R1)		;SET FLAG FOR LOADER TO KNOW
				;TO ONLY LINK TCB AND SET TO ACTUAL APR NEEDED
				;COUNT.
	MOV	R0,6(R1)	;SAVE TCB ADDRESS IN NAMELIST
	BISB	#200,TCBST(R0)	;DISABLE TASK DURING LOAD
	JSR	PC,MX.LDG	;QUEUE COMMAND TO LOADER TASK
	BCC	4$		;IF CC, COMMAND QUEUED OK
;NO ROOM ON LOADER QUEUE; HAVE TO FAIL THIS ONE AND RETRACT
	JSR	PC,TCBCLR	;SO DEALLOCATE TCB
	BR	1$		;AND TELL OUR CALLER
4$:	MOV	TCBSCB(R0),R2	;IF OK, SET UP SCB+16 AS NAMELIST ADDRESS
	MOV	R1,16(R2)	;SO IT CAN BE ACCESSED FROM TCB.
;N.B.- THIS SHOULD BE THE CASE FOR ALL TASKS NUMBERED ABOVE "NPERM"
;AND FOR NONE OF THE OTHERS.
	JSR	R5,S.RRES
	CLC
	RTS	PC
;TASK NAME LIST. CONTAINS INFO ON DISK-RESIDENT TASKS.
;(DUMMY FOR NOW)
	.IFTF
	.PSECT	MX.NMS,RW,CON
	.GLOBL	MX.NML
MX.NML:
NAMES:	.RAD50	/FOO/	;TASK NAME
	.WORD	0,0	;DISK BLOCK NUMBER (LOW, HIGH)
	.WORD	0	;TCB ADDRESS
	.WORD	1	;NO. APR'S ACTUALLY NEEDED FOR TASK
	.WORD	0	;USE FLAG. 0 IF TCB SETUP, NONZERO FOR TCB
	.WORD	0,0	;SPARES
	.WORD	0,0	;CLASSIFICATION PRIVILEGE, DEFAULT CLASSIF.
;WORD 1 BITS:	AS FOLLOWS:
;	1	READ LOWER CLASSIF MSG
;	2	WRITE HIGHER CLASSIF MSG
;	4	READ LOWER CLASSIF DEVICE
;	10	WRITE HIGHER CLASSIF DEVICE
;	20	READ HIGHER CLASSIF MSG
;	40	WRITE LOWER MSG
;	100	READ HIGHER DEV
;	200	WRITE LOWER DEV
;	400	VIOLATE SPEC CATS ON MLS OK, MSG
;	1000	VIOLATE SPEC CATS ON MLS BAD, MSG
;	2000	VIOLATE SPEC CATS, MLS OK, DEV
;	4000	VIOLATE SPEC. CATS, MLS BAD, DEV
;	100000	IGNORE MLS
;
;NOTE CLASSIFICATIONS NEGATIVE IMPLY NO ACCESS RESTRAINTS
	.BYTE	0,0	;CLASSIFICATION/SPECIAL CATEGORY
	.BLKW	7	;SPEC. CATEGORY LIST HERE.
	.BYTE	0,0	;LO/HI CLASSIFICATION
;NOTE: A TASK MAY SEND MESSAGES TO TASKS OF CLASSIFICATION AT OR ABOVE
;ITS LO CLASSIFICATION AND MAY RECEIVE MESSAGES FROM TASKS OF CLASSIFICATION
;AT OR BELOW ITS HIGH CLASSIFICATION. THIS IS CHECKED AT BOTH SEND AND RECEIVE
;TIME IN A CLASSIFIED KERNEL MSX-11.
; A TASK MAY NOT SEND MESSAGES TO ANY TASK WITH A DIFFERENT SPECIAL CATEGORY
;(AS AN ADDITIONAL RESTRICTION) IF THE SPECIAL CATEGORY IS NONZERO. THIS DATA
;IS STORED HERE TO INHIBIT THE MODSTT DIRECTIVE FROM GETTING AT IT.
NAMSZ=.-NAMES
	.IIF NDF,NNML,NNML=8. ;NUMBER OF SPARE ENTRIES FOR NAMELIST
;(WHICH CORRESPONDS TO "INSTALLED" TASKS IN MSX. STL IS FOR ACTIVE TASKS.)
	.BLKB	NNML*NAMSZ	;BLANK ENTRIES FOR NAMES KNOWN TO MSX.
	.WORD	0	;LIST TERMINATOR
	.WORD	0	;LIST TERMINATOR
	.PSECT
	.IFT
;

;
;LOADER INTERFACE ROUTINES.
;MX.LDG IS CALLED TO ESTABLISH TCB LINKAGE FIRST FROM THE TASK HEADER
;ON DISK. IT FILLS IN TCB LINKS AND COMPUTES AND STORES IN THE NAMELIST
;AREA FOR THE TASK THE NUMBER OF APR'S NEEDED FOR THE TASK IF ZERO. IF THIS
;WORD IS NONZERO, THE LOADER LOADS THE TASK INTO THE MEMORY THAT IS
;ALLOCATED IN THE TCB AREA FOR INITIAL APR'S AND THEN CLEARS THE 200 BIT
;IN THE TASK STATUS AND IN THE SAVED STATUSES FOR THE AST STATES (SCB+14
;AND SCB+15). MX.LDG RETURNS CC IF IT WORKED AND CS OTHERWISE.
;	MX.LDQ IS CALLABLE FROM THE LOADER AND REMOVES A QUEUE
;ENTRY OR SUSPENDS THE TASK AND TRIES AGAIN. MX.LDG RESUMES THE LOADER
;TASK, WHICH IS ASSUMED TO BE TASK #1 (PARAMETRIZED AS "LDRTKN"). LQHD
;AND LDQ ARE THE QUEUE IN AND OUT POINTERS AND THE QUEUE ITSELF,
;CONSISTING OF POINTERS TO THE BLOCK IN MX.NML USED FOR THE TASK.
;THE HEADER IN LQHD IS JUST OFFSETS INTO LDQ (IN WORDS).
	.GLOBL	LQHD,LDQ,MX.LDG,MX.LDQ
LQHD:	.WORD	0,0	;IN, OUT OFFSETS
LDQ:	.BLKW	32.	;QUEUE POINTERS
MX.LDG:	MOV	R2,-(SP)
	INC	LQHD	;POINT TO NEXT INPUT AREA
	BIC	#^C37,LQHD ;MASK TO 32 WORD AREA ONLY
	CMP	LQHD,LQHD+2 ;DID WE PASS OUTPUT?
	BNE	2$	;IF NE, NO
	DEC	LQHD	;IF EQ, MUST BACK OFF AND LOSE
	BIC	#^C37,LQHD
	MOV	(SP)+,R2
	SEC
	RTS	PC
2$:	MOV	LQHD,R2	;GET NAME LIST OFFSET
	ASL	R2	;MAKE A BYTE OFFSET
	MOV	R1,LDQ(R2) ;SAVE NAME LIST ADDRESS
	.IIF NDF,LDRTKN,LDRTKN=0
	TSTB	TCBST+MX.TBL+<MX.TBS*LDRTKN>
	BEQ	3$	;IF EXITED, OK TO START (MUST BE ALWAYS THERE)
	CMPB	TCBST+MX.TBL+<MX.TBS*LDRTKN>,#1	;SUSPENDED?
	BNE	4$	;IF NOT, DO NOT RESUME HERE.
3$:	MOVB	#4,TCBST+MX.TBL+<MX.TBS*LDRTKN> ;SET TASK STATE TO RUNNING
4$:	MOV	(SP)+,R2
	CLC		;SAY ALL WAS WELL
	RTS	PC	;THEN DONE
;
;DEQUEUE QUEUE ELEMENT. MUST BE CALLED FROM A TASK!
;
;RETURNS ADDRESS OF NAMELIST ELEMENT IN R2.
;
MX.LDQ:	CMP	LQHD,LQHD+2	;IS THERE ANY INPUT THERE?
	BNE	1$		;IF NE IT SEEMS SO
	MOVB	#1,MX.TBL+TCBST+<MX.TBS*LDRTKN> ;SET TASK SUSPENDED IF NOT
	.IF	DF,TP$ALL
	TRAP	375	;DECLARE SIG EVENT
	.WORD	7	;IF USING TRAP 375 CODES
	.IFF
	TRAP	7	;DECLARE SIG EVENT, USING TRAP VARIOUS CODES
	.ENDC
	BR	MX.LDQ	;GO LOOK AGAIN FOR INPUT
1$:	INC	LQHD+2	;POINT AT THE INPUT NOW
	BIC	#^C37,LQHD+2	;MASK TO A WORD OFFSET
	MOV	LQHD+2,R2	;GET THE OFFSET
	ASL	R2	;ENBYTE IT
	MOV	LDQ(R2),R2	;GET THE NAMELIST ADDRESS
	CLC		;SET NO ERROR RETURN
	RTS	PC	;THEN DONE.
;
;
;TASK HEADER ON DISK MUST HAVE THE FOLLOWING INFO:
;	.RAD50	/NAM/	;TASK NAME
;	.WORD	LOADDRESS ;TASK LOW VIRTUAL ADDR
;	.WORD	HIADDRESS ;TASK HIGH VIRTUAL ADDR
;	.WORD	STARTADDRESS ;TASK VIRTUAL START ADDR
;	.WORD	STACK	;TOP OF STACK (LDR SHOULD START STACK 1 LOWER)
;	.WORD	MSGPOOL ;MESSAGE POOL AREA ADDRESS IN TASK
;	.WORD	POOLSIZE ;(LESS THAN SOME LIMIT, SO BITMAPS CAN BE ALLOCATED
;				;INSIDE TCB AREAS AND MASKED BY LOADER)
;	.WORD	BPTADDR
;	.WORD	IOTADDR
;	.WORD	EMTADDR
;	.WORD	TRPADDR		;TASK TRAP HANDLERS FOR BPT,IOT,EMT, TRAP
;	.WORD	ERRAST		;ERROR AST ENTRY
;	.WORD	MSGAST		;MSG-IN AST ENTRY
;	.WORD	SPNXITAST	;SPAWNED-TASK-EXIT AST ENTRY
;	.WORD	MSGEVIN		;MSG-IN EV ADDR
;	.WORD	BLKL,BLKH	;DISK BLK OF TSK IMAGE (OVERLAYS NEED)
;

;
;MSX-11 MEMORY MAP
	.GLOBL	MX.MMP,MX.MME
.IIF NDF,MMCT,MMCT=4	;32K WORDS PER BYTE, DEFAULT 128K WORDS IN MACHINE
..$$=4	;FREE APR AREAS
MX.MMP:	.BYTE	17	;RESERVE 16K WORDS FOR MSX EXEC INITIALLY
	.REPT	MMCT-1
	.BYTE	0	;NULL FOR FREE MEMORY
	..$$=..$$+8.	;ADD IN FREE MEMORY BLOCKS
	.ENDR
MX.MME:
	.EVEN
	.WORD	0	;SAFETY
BITS:	.BYTE	1,2,4,10,20,40,100,200	;BIT ORDER IN MAP
;
;MX.MAV IS AMOUNT OF MEMORY FREE
	.GLOBL	MX.MAV
MX.MAV:	.WORD	..$$
;
;BITMAP CONTROL INFO FOR USE ON MX.MMP IF TASKS NEED CONTIGUOUS APR'S.
MM.BCB:	.WORD	1	;1 WORD PER APR (BECAUSE UNUSED...)
	.WORD	MX.TOB
	.WORD	0,0	;"BUFFERS" START AT 0
	.WORD	MX.MMP	;BITMAP IS MEMORY BITMAP
	.WORD	MX.MME	;HERE IS MAP END
	.WORD	4096.	;BIGGER THAN MAX POSSIBLE APR NUMBER IN MAP.
;
;
;GETAPR - FIND A FREE 4K AREA AND RETURN ITS ADDRESS IN R5. RETURN 0
;IF NO AREA AVAILABLE.
;
	.GLOBL	GETAPR
GETAPR:	JSR	R5,S.RSAV
	CLR	R0	;R0 = MAJOR INDEX
GA.1:	CMPB	MX.MMP(R0),#377	;ARE ALL BITS USED HERE?
	BNE	GA.2		;NO, FIND THE ONE (MAYBE OF MORE) NOT USED
	INC	R0		;YES, SO LOOK AT THE NEXT BYTE
	CMP	R0,#<MX.MME-MX.MMP> ;IF THERE IS A NEXT BYTE. TEST
	BLO	GA.1		;IF THERE IS ONE, TRY AGAIN
;NO MEMORY LEFT. FLAG IT AND GO AWAY
	CLR	12(SP)		;RETURN R5=0
	BR	GA.X
GA.2:	CLR	R2		;R2=MINOR INDEX
	MOV	#10,R3		;8 BITS PER BYTE
GA.4:	BITB	MX.MMP(R0),BITS(R2) ;SEE IF THIS BIT IS FREE
	BEQ	GA.3		;IF SO, GOT ONE
	INC	R2		;IF NOT TEST THE NEXT
	DEC	R3		;WHILE THERE IS A NEXT
	BGT	GA.4		;LOOK. WE ARE SURE OF FINDING ONE.
;N.B.  WE'D HAVE TO INTERLOCK THIS IF MORE THAN 1 CPU COULD USE THIS
;ROUTINE.
GA.3:	BISB	BITS(R2),MX.MMP(R0) ;MARK THE MEMORY USED
	DEC	MX.MAV		;FLAG 1 LESS BLOCK FREE
	ASH	#3,R0		;MOVE THE INDEX OVER TO MAKE
	ADD	R2,R0		;APR 4K INDEX IN R0
	ASH	#7,R0		;NOW SHIFT TO MAKE A BLOCK INDEX FOR AN APR
;13.-6.=7 = COUNT TO SHIFT. 20000=4K=13 SHIFTS.
	MOV	R0,12(SP)	;RETURN IT IN R5
GA.X:	JSR	R5,S.RRES
	RTS	PC
;
;FREAPR - FREE AN APR. NOTE WE USE THESE ROUTINES FOR CORE ALLOCATION
;SINCE THERE SHOULD BE NO REQUIREMENT THAT TASK MEMORY BE CONTIGUOUS
;AND THESE ARE FASTER THAN THE GENERAL ROUTINES USED FOR MANAGING THE
;SYSTEM'S POOL SPACE.
	.GLOBL	FREAPR
FREAPR:	JSR	R5,S.RSAV	;ENTRY R5=APR TO FREE
	ASH	#-7,R5		;MAKE INDEX TO BITMAP
	BIC	#^C777,R5	;MASK OFF HIGH STUFF
	MOV	R5,R1		;COPY THE APR
	BEQ	1$		;DON'T FREE IF IT WAS 0
	ASH	#-3,R5		;MAKE BYTE IN MAP UP
	BIC	#^C7,R1		;AND BIT IN THE BYTE
;MAINTAIN FREE BLOCK COUNT
	BITB	BITS(R1),MX.MMP(R5) ;WAS BIT IN USE?
	BEQ	2$		;IF NOT, NO MORE ROOM BY FREE-UP NOW
	INC	MX.MAV		;IF SO, CAN GET THE SPACE
2$:	BICB	BITS(R1),MX.MMP(R0) ;FREE THE MEMORY
1$:	JSR	R5,S.RRES	;GIVE BACK CALLER'S REGISTERS
	RTS	PC
;
;MEMORY USE LIST.
;	IN MSX, THE TASKS AS THEY EXIT ARE STRUNG ONTO A MEMORY USE
;LIST AT THE HEAD. THEY ARE REMOVED IF RE-ACTIVATED. THE TAIL OF THE
;LIST IS THUS ALWAYS THE OLDEST TASKS THAT WERE IN MEMORY, AND TASK
;SPACE IS RECLAIMED AS NEEDED FROM THESE. THE MEMLNK ROUTINE GRABS
;TASK SPACE IF NEEDED IN THIS WAY. IT FIRST SEEKS THE TASK ON THE
;MUL AND UNLINKS IT IF PRESENT, THEN RETURNS. IF THE TASK WAS NOT ON
;THE MUL, IT FREES SPACE AND SETS UP THE TASK'S INITIAL APRS VIA CALLS
;TO GETAPR. IT CALLS THE "FRETSK" ROUTINE TO UNLINK A TASK TO RECLAIM
;ITS MEMORY FROM THE BOTTOM OF THE QUEUE.
;;

;NOTE THAT THIS IS DISABLED (TO FORCE RELOADS OF TASKS) IF SE$K IS DEFINED
;SINCE A TASK MUST BE REWRITTEN IF IT IS TO HAVE A NEW CLEARANCE.
;
	.GLOBL	MX.MUH,MX.MUL	;LISTHEAD, LIST
;NOTE: A LIST ENTRY IS
;	FWD-POINTER
;	BACK-POINTER
;	TCB ADDRESS OF TASK
;	SPARE
;AND MX.MUH POINTS TO THE LIST. THE LINKS ARE IN THE SAME ORDER AS THE
;STL IS AND ARE STATICALLY ALLOCATED AS THE TCB
.IIF NDF,NTSKS,NTSKS=20.
;NTSKS=NUMBER OF STL ENTRIES
MX.MUH:	.WORD	MX.MUH,MX.MUH	;LIST HEADER
MX.MUL:	.BLKW	4*NTSKS		;LIST
;SET UP OR REMOVED DYNAMICALLY.
;NOTE THAT EXIT SETS UP THE LINK ENTRY.
	.GLOBL	MEMLNK
;	ENTRY R0=TCB ADDRESS, R1=NO. 4K CHUNKS NEEDED.
MLK.XJ:	JMP	MLK.X
MEMLNK:	JSR	R5,S.RSAV	;SAVE CALLER REGS
	CMP	R0,#MX.TBL+<NPERM*MX.TBS>
	BLO	MLK.XJ		;PERMANENT TCB ENTRIES ARE NOT ALTERED.
;FIRST LOOK FOR THE TASK ON THE MUL.
	MOV	MX.MUH,R2	;SCAN USING R2
	.IF	NDF,SE$K
10$:	CMP	R2,#MX.MUH	;AT END?
	BEQ	11$		;YES, NO TASK THERE NOW.
	CMP	R0,4(R2)	;GOT THIS TCB?
	BEQ	12$		;YES, BR AND REMOVE FROM LIST
	MOV	@R2,R2		;LINK TO THE NEXT ENTRY
	BR	10$		;LOOK TILL END
12$:	;TASK IS ON THE LIST. REMOVE IT AND RETURN...ALL SET UP THEN.
	MOV	@R2,R3		;OUR FWD LINK
	MOV	2(R2),R4	;OUR BACK LINK
	MOV	R3,@R4		;SET BACK'S FWD LINK
	MOV	R4,2(R3)	;SET FWD'S BACK LINK
;NOW THE QUEUE LINK IS REMOVED FROM THE CHAIN
; SINCE WE ARE RESTARTING THE TASK JUST REUSE THE MEMORY
	BR	MLK.XJ
	.ENDC	;SE$K
11$:	;NOT ON THIS LIST
;FIND NAMELIST ENTRY FOR THE TASK AND THENCE THE NUMBER OF APR'S NEEDED
;FOR IT.
	MOV	TCBSCB(R0),R1	;SCB HAS NAMELIST
	MOV	16(R1),R1	;GET NO. APR'S NEEDED
	BEQ	30$		;(USUALLY WILL BE 0 1ST TIME THRU)
	MOV	R1,R3		;KEEP THE POINTER FOR CONTIG. APR TEST
	MOV	10(R1),R1	;GET # APR'S (MAY BE 0 1ST TIME THRU)
30$:
	MOV	TCBAP1(R0),R2	;GET INITIAL APR TBL
.IIF NDF,AL$APR, .ERROR ;MUST ALLOW ALL APR'S TO BE DEFINED FOR LOADING
	BIT	#1,12(R3)	;SEE IF NAME LIST HAS FLAG FOR CONTIGUOUS APRS
	BNE	27$		;IF SO, ALLOCATE APR'S CONTIGUOUSLY.
	MOV	#APR.TK,R3	;32K = 8 APR.S
2$:	JSR	PC,GETAPR	;TRY TO GET SOME CORE
	TST	R5		;SEE IF WE DID
	BNE	1$		;IF SO ALL'S PEACE & LIGHT
	MOV	MX.MAV,-(SP)	;SAVE SPACE LEFT
	JSR	PC,FRETSK	;IF NOT, GOTTA CLEAR SOMEBODY
	CMP	(SP)+,MX.MAV	;DID FREE SPACE INCREASE?
	BHI	2$		;IF SO, CAN TRY AGAIN
115$:	MOV	TCBAP1(R0),R2	;FAILED. DEALLOCATE OUR SPACE
	NEG	R3
	ADD	#APR.TK,R3	;GET NO. APR'S TO FREE UP
114$:	MOV	(R2)+,R5	;GET AN APR
	JSR	PC,FREAPR	;FREE IT
	CLR	-2(R2)		;AND NULL THE RECORD OF IT
	DEC	R3
	BGT	114$		;DO ALL WE ALLOCATED SO FAR
122$:	MOV	#-5,TCBSTT(R0)	;SAY NO MEM.
	MOVB	#10,TCBST(R0)	;AND MARK FOR ABORT
	JMP	MLK.X
1$:
	TST	@R2		;IS APR THERE NOW?
	BNE	25$		;IF SO LEAVE IT!
	MOV	R5,(R2)+	;SAVE THE APR FOUND
25$:	DEC	R3		;COUNT IT DOWN
	DEC	R1		;COUNT DOWN PHYS. SIZE NEEDED
	BGT	2$		;IF NEED MORE, TRY AGAIN.
	BR	3$
27$:	;HERE CONTIGUOUSLY ALLOCATE APR'S. CLEARLY, R1=NO. APR'S.
;
	MOV	#APR.TK,R3	;32K = 8 APR.S
	JSR	R5,S.RSAV
	MOV	#MM.BCB,R0
	MOV	#7,R1
	MOV	#MX.NSZ,R2
35$:	MOV	(R0)+,(R2)+	;COPY CONTROL DATA
	SOB	R1,35$
	JSR	R5,S.RRES
	JSR	R5,S.RSAV
36$:
	JSR	R5,S.RSAV
	MOV	R1,-(SP)	;NUMBER OF APR'S NEEDED
	JSR	R5,S.BFA	;ALLOCATE REGS
	MOV	(SP)+,R5	;NOW FIND OUT WHERE
	BNE	37$		;IF NE, OK NOW
	CMP	MX.MUH+2,#MX.MUH	;HEADER ONLY?
	BNE	38$		;IF NOT, TRY TO FREE SPACE
	ADD	#14,SP		;FAKE REG REESTORE
	JSR	R5,S.RRES	;REAL RESTORE
	BR	122$		;GO SAY NO SOAP.
38$:
	JSR	PC,FRETSK	;REMOVE THE OLDEST TSK
	JSR	R5,S.RRES	;THEN TRY AGAIN
	BR	36$		;TO ALLOCATE ROOM
37$:	MOV	R5,12+14(SP)	;KEEP R5 ACROSS RRES
	JSR	R5,S.RRES
	JSR	R5,S.RRES
	SUB	R1,R3		;SAY <R3> APR'S LEFT
	;NOW WE HAVE 2 * A NUMBER OF A 4K BLOCK. SHIFT BY 6
;	TO GET TO A 4K INDEX (13.-6.=7.-1=6.)
	ASH	#6,R5		;R5 IS NOW AN APR OFFSET NUMBER
;R2=TCBAP1 AREA...FILL IT IN.
39$:	MOV	R5,(R2)+	;FILL IN A MAPPING VALUE
	ADD	#200,R5		;POINT AT THE NEXT 4K
	DEC	R1		;DO AS MANY APR'S AS WERE NEEDED
	BGT	39$
	SUB	#200,R5		;LEAVE R5 POINTING AS AT THE LAST APR USED.
	JSR	R5,S.RSAV
;RESTORE  THE BITMAP IN SYSTEM.
	MOV	#MM.BCB,R0
	MOV	#7,R1
	MOV	#MX.NSZ,R2
43$:	MOV	(R2)+,(R0)+
	SOB	R1,43$
	JSR	R5,S.RRES
;NOW FILL IN APR'S FOR THE REST OF TASK WITH COPIES OF THE LAST.
;(MAY MODIFY TO GIVE EXTRA ACCESS FOR MESSAGES LATER)
3$:	MOV	R5,(R2)+	;FILL IN LAST APR VALUE
	DEC	R3		;FOR WHATEVER APR'S ARE NEEDED
	BGT	3$		;TILL DONE
;NOW ARRANGE FOR THE TASK LOAD
	MOV	TCBSCB(R0),R1	;GET SCB
	MOV	16(R1),R1	;AND THENCE NAMELIST (FROM TCB SETUP)
	BEQ	MLK.X		;IF NONE, HOPE ALL IS WELL
	CLR	TCBDSP(R0)	;AND FORCE (AS LOADER MUST TOO) A NEW STARTUP
	BISB	#200,TCBST(R0)	;INHIBIT THE TASK
	JSR	PC,MX.LDG	;SET FOR A TASK LOAD
	BCC	MLK.X		;IF ALL OK, EXIT NOW
	CLR	12(R1)		;IF IT FAILED, SAY NO MEM USED (FOR NEXT LOAD)
	BR	115$		;AND REMOVE ANY SPACE ALLOCATIONS
MLK.X:	JSR	R5,S.RRES
	RTS	PC
	.GLOBL	FRETSK
FRETSK:	JSR	R5,S.RSAV
	MOV	MX.MUH+2,R0	;GET LAST TASK
	CMP	R0,#MX.MUH	;IS THIS JUST THE HEADER?
	BEQ	2$		;IF SO, NOTHING MORE POSSIBLE.
	MOV	2(R0),R1	;BACK LINK
	MOV	@R0,@R1		;COPY ITS FWD LINK TO LAST'S FWD LINK
	MOV	R1,MX.MUH+2	;MAKE IT THE NEW END
	MOV	4(R0),R0	;GET THE TCB ADDRESS NOW
;NOTE: SOME TASKS MUST STAY ALWAYS PRESENT, SO ALLOW NPERM TASKS TO BE
;THERE ALWAYS. THIS PERMITS CALLS BY TASK NUMBER TO THINGS LIKE CONSOLE
;INPUT CONTROL ROUTINES, WHERE NOTHING MAY FAKE THE TASK ID, AND PREVENTS
;ANYTHING FROM TRYING TO MESS UP THE TASK'S MEMORY.
	CMP	R0,#MX.TBL+<NPERM*MX.TBS>
	BLO	2$		;IF A PERMANENT ENTRY, NO CHANGES!
	JSR	PC,TCBCLR	;REMOVE THE TCB FROM USED LISTS
	MOV	TCBAP1(R0),R2	;GET INITIAL APR ARREA
	MOV	#APR.TK,R3	;8 APR'S
1$:	MOV	(R2)+,R5	;GRAB THEM ONE AT A TIME
	CLR	-2(R2)		;MARK FREED
	JSR	PC,FREAPR	;FREE THEM
	DEC	R3
	BGT	1$		;DO ALL THEM APR'S
	MOV	TCBSCB(R0),R5	;GET SCB
	MOV	16(R5),R5	;AND NAMELIST ADDRESS
	BEQ	2$		;IF NONE, NO COUNT TO CLEAR
	CLR	10(R5)		;CLEAR # REQUIRED APR'S FOR NEXT LOAD.
2$:	JSR	R5,S.RRES
	RTS	PC
;
;MULADD - ADD TASK NODE TO MUL. CALLED FROM TASK EXITS. ADDS TASK'S
;NODE TO THE MUL FROM THE START.
	.GLOBL	MULADD
MULADD:	JSR	R5,S.RSAV
	CMP	R0,#MX.TBL+<MX.TBS*NPERM>
	BLO	100$		;LEAVE PERMANENT ENTRIES ALONE
	MOV	MX.MUH,R1	;SEE WE ARE NOT IN LIST NOW
1$:	CMP	R1,#MX.MUH	;AT END?
	BEQ	2$		;YES
	CMP	4(R1),R0	;OUR TCB?
	BEQ	100$		;YES, NO ADDING HERE
	MOV	@R1,R1		;CHAIN TO NEXT
	BR	1$
2$:	MOV	R0,R1		;COPY TCB ADDR
	SUB	#MX.TBL,R1	;MAKE OFFSET
	ASH	#3-MX.CNT,R1	;MAKE OFFSET FROM THIS LIST
	ADD	#MX.MUL,R1	;AND POINT AT THIS LIST'S AREA
	MOV	R0,4(R1)	;FILL IN OUR TCB ADDRESS
	MOV	MX.MUH,R2	;GET HEADER'S 1ST NODE
	MOV	R2,@R1		;FILL IN FWD POINTER FROM OLD FWD POINTER
	MOV	#MX.MUH,2(R1)	;LISTHEAD IS OUR BACK POINTER
	MOV	R1,2(R2)	;OUR NODE IS NEXT'S BACK
	MOV	R1,MX.MUH	;AND POINT INTO OUR NODE NOW.
;NODE ENTRY IS NOW ALL INCLUDED. AHA!
	.IF	DF,SE$K
	JSR	PC,FRETSK	;IF SECURE KNL REMOVE THE TASK NOW
	.ENDC
100$:	JSR	R5,S.RRES
	RTS	PC
	.ENDC
;
	.END