.TITLE	ACL
 
	.MCALL	HWDDF$,TCBDF$,UCBDF$,DCBDF$,PKTDF$
	.MCALL	FSRSZ$,FDBDF$,FDAT$A,FDRC$A,FDOP$A,NMBLK$
	.MCALL	FINIT$,OPEN$W,CLOSE$,OFID$A,PUT$
	.MCALL	MRKT$S,WTLO$S,RDAF$S,CLEF$S,GTIM$S,EXIT$S
	.MCALL	QIOW$S
 
	HWDDF$
	TCBDF$
	UCBDF$
	DCBDF$
	PKTDF$
;
; ASSEMBLY PARAMETERS
;
ACBMX=24				;MAXIMUM NUMBER OF ACB
DSRZ=ICEND-ICBEG+<ACBMX*ACBZ>		;SIZE OF DSR BLOCK TO ALLOCATE

	.SBTTL	I/O DEFINITIONS
;
; LUN ASSIGNMENTS
;
ACLUN=1					;ACCOUNT FILE LUN
ERLUN=2					;ERROR MESSAGE LUN
;
; ACCOUNT FILE DESCRIPTION
;
	FSRSZ$	1			;ALLOCATE SPACE FOR OUTPUT FILE
ACFDB:	FDBDF$				;ALLOCATE SPACE FOR FDB
	FDAT$A	R.FIX,FD.BLK,ACRCDZ
	FDRC$A	,ACRCD,ACRCDZ
	FDOP$A	ACLUN,ACDSPT
 
ACDSPT:	.WORD	ACDEVZ,ACDEV
	.WORD	ACDIRZ,ACDIR
	.WORD	ACNAMZ,ACNAM
 
ACDEV:	.ASCII	/SY0:/
ACDEVZ=.-ACDEV
ACDIR:	.ASCII	/[1,6]/
ACDIRZ=.-ACDIR
ACNAM:	.ASCII	/ACCLOG.SYS/
ACNAMZ=.-ACNAM
	.EVEN
 
ACFNB:	.BLKB	N.UNIT+2		;FILE NAME BLOCK FOR FID
 
ACRCDZ=40
ACRCD:	.BLKB	ACRCDZ			;ACCOUNT FILE RECORD BUFFER

	.SBTTL	EVENT FLAG AND OFFSET DEFINITIONS
;
; EVENT FLAG DEFINITIONS
;
RDNEF=1					;RUNDOWN REQUEST
RDNEFB=1
TXEF=2					;LOG TASK EXIT REQUEST
TXEFB=2					;EVENT FLAG BIT IN EVENT FLAG WORD
TIMEF=3					;LOG TIME REQUEST
TIMEFB=4
EREF=17					;ERROR MESSAGE QIO EVENT FLAG
;
; ACB TYPE DEFINITIONS
;
TP.AVL=1				;AVAILABLE ACB
TP.ACT=2				;ACTIVE ACB
TP.XIT=4				;EXIT ACB
;
; ACB OFFSET DEFINITIONS
;
AC.LNK=0				;NEXT ACB LINK
AC.TYP=2				;ACB TYPE
AC.TCB=4				;ADDRESS OF TCB CORRESPONDING TO THIS ACB
AC.UIC=6				;UIC
AC.NAM=10				;RADIX 50 TASK NAME
AC.STM=10				;INITIAL TASK SWITCH TIME
AC.CPU=14				;ACCUMULATED CPU TIME
AC.ELP=20				;ELAPSE TIME
AC.QDB=24				;DB QIO COUNT
AC.QLP=26				;LP QIO COUNT
AC.QMT=30				;MT QIO COUNT
AC.QOT=32				;OTHER QIO COUNT
ACBZ=34					;SIZE OF ACB
;
; RECORD TYPE DEFINITION
;
RT.TM=17				;TIMER RECORD
RT.XT=360				;TASK EXIT RECORD
;
; TIMER RECORD OFFSET DEFINITION
;
R.TYP=0					;RECORD TYPE
R.CTM=2					;CURRENT TIME
R.KTM=22				;TIME SPENT IN KERNAL MODE
R.ITM=26				;IDLE TIME
R.LST=32				;LOST REQUEST COUNT

	.SBTTL	ACCOUNT LOG MAINLINE
;
; OPEN ACCOUNTING FILE, SAVE FILE ID AND CLOSE IT
;
ST:	FINIT$
	OPEN$W	#ACFDB,,,,,,ERR1	;OPEN ACCOUNTING FILE BY FILE NAME
	MOV	#ACFDB+F.FNB,R1		;SETUP SOURCE FOR COPYING
	MOV	#ACFNB,R2		;SETUP DESTINATION
10$:	CMP	R1,#ACFDB+F.FNB+N.UNIT	;FINISHED SAVING FID?
	BGT	20$			;IF GT, YES
	MOV	(R1)+,(R2)+		;SAVE A WORD
	BR	10$
20$:	CLOSE$	#ACFDB,ERR2		;CLOSE ACCOUNTING FILE
 
;
; ALLOCATE A BLOCK OF DSR
;
	MOV	#IE.UPN,$DSW		;ASSUME ALLOCATION FAILURE
	MOV	#DSRZ,R1		;GET SIZE OF DSR NEEDED
	CALL	$SWSTK,40$		;SWITCH TO SYSTEM STATE
	CALL	$ALOCB			;;ALLOCATE DSR
	MOV	R0,DSR			;;SAVE DSR STARTING ADDRESS
	BCC	30$			;;IF CC, DSR ALLOCATED
	RETURN				;;
30$:	MOV	#IS.SUC,$DSW		;;INDICATE SUCCESS
	RETURN
 
40$:	CMP	#IS.SUC,$DSW		;DSR SUCCESSFULLY ALLOCATED?
	BEQ	INIDSR			;IF EQ, YES
	CALL	ERR3
;
; INITIALIZE DSR
;
INIDSR:	MOV	DSR,R0			;GET STARTING ADDRESS OF DSR
	MOV	R0,ACBST		;SAVE STARTING ADDRESS OF ACB LIST
	ADD	#ICEND-ICBEG,ACBST
	MOV	@#$TKTCB,ACLTCB		;SAVE TCB ADDRESS OF ACL
 
	.IF EQ	V$$RSN-31
 
	MOV	@#$TKTCB,PST		;SETUP INITIAL PREVIOUS STATE
 
	.ENDC
 
	MOV	#ICBEG,R1		;SETUP TO COPY INTERCEPT CODE
10$:	CMP	R1,#ICEND		;DONE?
	BGE	INIACB			;IF GE, YES
	MOV	(R1)+,(R0)+		;COPY A WORD
	BR	10$
;
; INITIALIZE THE ACB (ACCOUNTING CONTROL BLOCK) LIST
;
INIACB:	MOV	R0,R1			;COPY START OF ACB ADDRESS
	ADD	#ACBMX*ACBZ,R1		;CALCULATE END OF ACB ADDRESS
10$:	CMP	R0,R1			;DONE?
	BGE	20$			;IF GE, YES
	MOV	R0,(R0)			;SETUP FORWARD LINK
	ADD	#ACBZ,(R0)
	MOV	#TP.AVL,AC.TYP(R0)	;MARK ACB AS AVAILABLE
	ADD	#ACBZ,R0		;NEXT ACB
	BR	10$
20$:	CLR	-ACBZ(R0)		;CLEAR FORWARD LINK OF LAST ACB
;
; CREATE ACB FOR CURRENTLY ACTIVE TASKS
;
CRACB:	CALL	$LOCKL			;LOCK SYSTEM LISTS
	MOV	@#$TSKHD,R0		;GET START OF STD
10$:	CMP	R0,#$HEADR		;IS THIS THE NULL TASK
	BEQ	30$			;IF EQ, YES
	TST	T.STAT(R0)		;IF TASK ACTIVE?
	BMI	20$			;IF MI, NO
	CALL	ACTACB			;CREATE ACB FOR IT
20$:	MOV	T.TCBL(R0),R0		;GET NEXT TCB
	BR	10$
30$:	CALL	$UNLKL			;UNLOCK SYSTEM LISTS
;
; CLEAR TIMER, TASK EXIT AND RUNDOWN EVENT FLAGS
;
	CLEF$S	#TIMEF			;CLEAR TIMER EVENT FLAG
	CLEF$S	#TXEF			;CLEAR TASK EXIT EVENT FLAG
	CLEF$S	#RDNEF			;CLEAR ACL RUNDOWN EVENT FLAG
;
; INSERT INTERCEPT CODE INTO THE EXEC
;
INSTIC:	MOV	#ISOTBL,R1		;GET ADDRESS OF INTERCEPT SUBROUTINE OFFSET TABLE
	MOV	#IATBL,R2		;GET ADDRESS OF INTERCEPT ADDRESS TABLE
	CALL	$SWSTK,30$		;SWITCH TO SYSTEM STATE
10$:	MOV	(R2)+,R3		;;GET ADDRESS OF INTERCEPTED INSTRUCTION
	BNE	20$			;;IF NE, YES
	RETURN				;;
20$:	MOV	#4737,(R3)+		;;INSERT 'JSR PC'
	MOV	DSR,(R3)		;;INSERT INTERCEPT CODE ADDRESS
	ADD	(R1)+,(R3)		;;
	BR	10$
;
; INSERT CLOCK INTERCEPT CODE
;
30$:	BIS	#340,@#PS		;RAISE PRIORITY TO 7
	MOV	DSR,@#100		;;;GET DSR STARTING ADDRESS
	ADD	#FRQCLK-ICBEG,@#100	;;;ADD IN INTERCEPT CODE OFFSET
	MOV	#341,@#102		;;;SET CARRY FOR ADC INSTRUCTION
	CLRB	@#PS			;;;LOWER PRIORITY TO 0
;
; SET TIMER AND WAITFOR ACCOUNTING REQUEST
;
	MOV	#RT.TM,R2		;SET RECORD TIMER CODE
	CALL	TIMHDL			;WRITE OUT CURRENT TIME
SRVR:	WTLO$S	0,#RDNEFB!TXEFB!TIMEFB	;WAITFOR ACCOUNTING REQUEST
	RDAF$S	#EFS			;READ ALL EVENT FLAGS
;
; ACCOUNTING REQUESTED
;
	MOV	#DSPTBL-2,R1		;INITIALIZE HANDLER ADDRESS
10$:	TST	EFS			;ANYMORE REQUESTS TO HANDLE?
	BEQ	SRVR			;IF EQ, NO
	ADD	#2,R1			;UPDATE HANDLER ADDRESS
	CLC
	ROR	EFS			;HANDLER REQUESTED?
	BCC	10$			;IF CC, NO
	MOV	#RT.TM,R2		;SET TIMER RECORD CODE
	CALL	@(R1)			;CALL HANDLER
	BCC	10$			;IF CC, CONTINUE
	EXIT$S

	.SBTTL	ACCOUNT LOG RUNDOWN ROUTINE
;
; ACL RUNDOWN ROUTINE
;
RDNHDL:	MOV	#$CKINT,@#100		;;;SINGLE INSTRUCTION SHOULD BE NON-INTERRUPTIBLE
;
; RESTORE INTERCEPTED INSTRUCTIONS
;
	MOV	#IATBL,R1		;GET INTERCEPT ADDRESS TABLE
	MOV	#IITBL,R0		;GET INTERCEPT INSTRUCTION TABLE
	CALL	$SWSTK,30$		;SWITCH TO SYSTEM STATE
10$:	MOV	(R1)+,R2		;;GET INTERCEPTED ADDRESS
	BEQ	20$			;;IF EQ, END OF TABLE
	MOV	(R0)+,(R2)+		;;RESTORE INSTRUCTION
	MOV	(R0)+,(R2)		;;
	BR	10$
20$:	RETURN
30$:	CALL	TXHDL			;LOG ALL EXIT ACB
	MOV	#TP.ACT,R1		;LOG ALL ACTIVE ACB ALSO
	CALL	TXHDL1
	MOV	#RT.TM,R2		;SET RECORD TIMER CODE
	CALL	TIMHDL			;WRITE TIMER RECORD
	CLR	R2			;SET RECORD TYPE TO ZERO,
	CALL 	TIMHDL			;WRITE AN EOF RECORD.
;
; DEALLOCATE DSR
;
	MOV	DSR,R0			;GET DSR STARTING ADDRESS
	MOV	#DSRZ,R1		;GET DSR SIZE
	CALL	$SWSTK,40$		;SWITCH TO SYSTEM STATE
	CALL	$DEACB			;;DEALLOCATE DSR
	RETURN
;
; CLOSE FILE AND DONE
;
40$:	CLOSE$	#ACFDB,ERR2
	SEC				;EXIT REQUESTED
	RETURN

	.SBTTL	TASK EXIT HANDLER
;
; TASK EXIT HANDLER
;	R1	=ACB TYPE
;
TXHDL:	MOV	#TP.XIT,R1		;ENTRY POINT FOR LOG TASK EXIT
TXHDL1:	MOV	R1,-(SP)		;SAVE ACB TYPE
	CLEF$S	#TXEF			;CLEAR EXIT EVENT FLAG
;
; CLEAR RECORD BUFFER JUST IN CASE
;
	MOV	#ACRCD,R2		;GET BUFFER ADDRESS
10$:	CMP	R2,#ACRCD+ACRCDZ	;DONE CLEARING RECORD BUFFER?
	BGT	20$			;IF GT, YES
	CLR	(R2)+			;CLEAR A WORD
	BR	10$
;
; SCAN ACB LIST AND LOG ACTIVE OR EXIT ACB
;
20$:	MOV	ACBST,R2		;GET START OF ACB LIST
30$:	CLR	$DSW			;INDICATE LOG STILL PENDING
	MOV	R2,R0			;GET SAVED ACB ADDRESS
	MOV	(SP),R1			;GET ACB TYPE
	CALL	$SWSTK,80$		;SWITCH TO SYSTEM STATE
	CLR	R5			;MATCH ANY ACB OF THAT TYPE
	CALL	SRACB			;;FIND ACB
	BCS	70$			;;IF CS, NO MORE ACBS LEFT
;
; UPDATE ACB IF IT IS STILL ACTIVE
;
	BIT	#TP.ACT,AC.TYP(R0)	;;ACB STILL ACTIVE?
	BEQ	40$			;;IF EQ, NO
	MOV	AC.TCB(R0),R5		;;GET TCB ADDRESS
	MOV	DSR,R1			;;GET START OF DSR ADDRESS
	CALL	XITACB-ICBEG(R1)	;;UPDATE ELAPSE TIME, UIC & TASKNAME
40$:	MOV	R0,R2			;;SAVE ACB ADDRESS
;
; COPY ACB INTO RECORD BUFFER
;
	MOV	#ACRCD,R1		;;GET RECORD BUFFER ADDRESS
50$:	CMP	R1,#ACRCD+ACBZ		;;DONE COPYING?
	BGE	60$			;;IF GE, YES
	MOV	(R0)+,(R1)+		;;COPY A WORD
	BR	50$			;;
60$:	MOV	R2,R0			;;GET CURRENT ACB ADDRESS
	MOV	#TP.AVL,AC.TYP(R0)	;;MARK ACB AVAILABLE
	RETURN
;
; HAVE SCANNED ENTIRE ACB LIST
;
70$:	INC	$DSW			;;INDICATE NO LOGGING PENDING
	RETURN
;
; WIRTE RECORD TO ACCOUNTING FILE
;
80$:	CMP	#IS.SUC,$DSW		;LOGGING PENDING?
	BEQ	90$			;IF EQ, YES
	MOV	#RT.XT,ACRCD		;MARK RECORD TYPE TO BE TASK EXIT
	CALL	WRTRCD			;WRITE RECORD OUT TO ACCOUNTING FILE
	BR	30$
;
; LOGGED ALL ACB IN LIST
;
90$:	MOV	(SP)+,R1		;CLEAN STACK
	CLC				;DON'T EXIT
	RETURN

	.SBTTL	TIMER HANDLER
;
; TIMER HANDLER
;
TIMHDL:	MRKT$S	#TIMEF,#30.,#3		;CLEAR TIMER AND SCHEDULE NEXT WAKEUP 
	MOV	#ACRCD,R0		;GET BUFFER ADDRESS
10$:	CMP	R0,#ACRCD+ACRCDZ	;DONE CLEARING RECORD BUFFER
	BGT	20$			;IF GT, YES
	CLR	(R0)+			;CLEAR A WORD
	BR	10$
;
; CREATE TIMER RECORD
;
20$:	MOV	#ACRCD,R0		;GET BUFFER ADDRESS
	MOV	R2,R.TYP(R0)		;MARK RECORD TO BE TIMER RECORD
	MOV	R0,R2			;COPY RECORD ADDRESS
	ADD	#R.CTM,R2		;GET ADDRESS OF CURRENT TIME FIELD
	GTIM$S	R2			;GET THE CURRENT TIME
	MOV	DSR,R1			;GET START OF DSR
	BIS	#340,@#PS		;RAISE PRIORITY TO 7
	MOV	KRNL-ICBEG(R1),R.KTM(R0) ;;;COPY TIME SPENT IN KERNAL MODE
	MOV	KRNL-ICBEG+2(R1),R.KTM+2(R0) ;;;
	CLR	KRNL-ICBEG(R1)		;;;RE-INITIALIZE TIME SPENT IN KERNAL
	CLR	KRNL-ICBEG+2(R1)	;;;
	MOV	IDLE-ICBEG(R1),R.ITM(R0) ;;;COPY IDLE TIME
	MOV	IDLE-ICBEG+2(R1),R.ITM+2(R0) ;;;
	CLR	IDLE-ICBEG(R1)		;;;RE-INITIALIZE IDLE TIME
	CLR	IDLE-ICBEG+2(R1)	;;;
	CLRB	@#PS			;;;LOWER PRIORITY TO 0
	MOV	LSTRQ-ICBEG(R1),R.LST(R0);SAVE LOST REQUEST COUNT
	CLR	LSTRQ-ICBEG(R1)		;RE-INITIALIZE LOST REQUEST COUNT
	CALL	WRTRCD			;WRITE OUT TIMER RECORD
	CLC				;INDICATE NO EXIT
	RETURN

	.SBTTL	ACCOUNT FILE WRITE ROUTINE
;
; WRITE RECORD BUFFER OUT TO ACCOUNTING FILE
;
WRTRCD:	MOV	R2,-(SP)		;SAVE REGISTERS
	MOV	R3,-(SP)
	MOV	#ACFNB,R2		;GET SAVED FILENAME BLOCK ADDRESS
	MOV	#ACFDB+F.FNB,R3		;GET ADDRESS OF FNB IN FDB
10$:	CMP	R2,#ACFNB+N.UNIT	;DONE COPYING FNB?
	BGT	20$			;IF GT, YES
	MOV	(R2)+,(R3)+		;COPY A WORD
	BR	10$
20$:	OFID$A	#ACFDB,,,,,,ERR4	;OPEN FILE BY FILE ID
	PUT$	#ACFDB,,,ERR5		;WRITE OUT RECORD
	CLOSE$	#ACFDB,ERR2		;CLOSE FILE
	MOV	(SP)+,R3		;RESTORE REGISTERS
	MOV	(SP)+,R2
	RETURN


	.SBTTL	ERROR HANDLER
ERR1:	CLR	ERROR
	BR	ERHDL
ERR2:	MOV	#2,ERROR
	BR	ERHDL
ERR3:	MOV	#4,ERROR
	BR	ERHDL
ERR4:	MOV	#6,ERROR
	BR	ERHDL
ERR5:	MOV	#10,ERROR
ERHDL:	MOV	R0,-(SP)		;SAVE REGISTER
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	TST	DSR			;DSR ALLOCATED?
	BEQ	30$			;IF EQ, NO
	MOV	#$CKINT,@#100		;;;RESTORE CLOCK INTERRUPT ADDRESS
	MOV	#IATBL,R1		;GET INTERCEPT ADDRESS TABLE
	MOV	#IITBL,R0		;GET INTERCEPT INSTRUCTION TABLE
	CALL	$SWSTK,30$		;SWITCH TO SYSTEM STATE
10$:	MOV	(R1)+,R2		;;GET INTERCEPTED ADDRESS
	BEQ	20$			;;IF EQ, END OF TABLE
	MOV	(R0)+,(R2)+		;;RESTORE INSTRUCTION
	MOV	(R0)+,(R2)		;;
	BR	10$			;;
20$:	MOV	DSR,R0			;;GET DSR STARTING ADDRESS
	MOV	#DSRZ,R1		;;GET DSR SIZE
	CALL	$DEACB			;;DEALLOCATE DSR
	RETURN
30$:	MOV	ERROR,R0
	ADD	#ERTBL,R0		;GET ERROR MESSAGE ADDRESS
	QIOW$S	#IO.WLB,#ERLUN,#EREF,,,,<(R0),#30,#40>
	MOV	(SP)+,R2		;RESTORE REGISTER
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	HALT				;TRAP

	.SBTTL	TABLES
;
; HANDLER DISPATCH TABLE
;
DSPTBL:	.WORD	RDNHDL
	.WORD	TXHDL
	.WORD	TIMHDL
;
; INTERCEPT ADDRESS TABLE
;
IATBL:	.WORD	$TSKRT+TROFF
 
	.IF EQ	V$$RSN-31
 
	.IFF
 
	.WORD	$NONSI+CSOFF
 
	.IFT
 
	.WORD	$NONSI+CSOFF0
	.WORD	$NONSI+CSOFF1
	.WORD	$NONSI+CSOFF2
 
	.ENDC
 
	.WORD	$DREXT
	.WORD	$IOFIN
	.WORD	0
;
; INTERCEPT SUBROUTINE OFFSET TABLE
;
ISOTBL:	.WORD	TSKRQ-ICBEG
 
	.IF EQ	V$$RSN-31
 
 	.IFF
 
	.WORD	CNTSW-ICBEG
 
	.IFT
 
	.WORD	CNTSW0-ICBEG
	.WORD	CNTSW1-ICBEG
	.WORD	CNTSW2-ICBEG
 
	.ENDC
 
	.WORD	TSKXT-ICBEG
	.WORD	QIOCNT-ICBEG
;
; INTERCEPTED INSTRUCTION TABLE
;
IITBL:	BIC	(SP),(R3)+
	CLR	(SP)
 
	.IF EQ	V$$RSN-31
 
	CLRB	@#$CURPR
	CMP	R5,@#$TKTCB
 
	.ENDC
 
	MOV	R5,@#$TKTCB
	CALL	@#$DRCMT
	MOV	I.IOSB+4(R3),R2
;
; EVENT FLAGS
;
EFS:	.WORD	0,0,0,0
;
; ERROR MESSAGE TABLE
;
ERTBL:	.WORD	EROPEN
	.WORD	ERCLOS
	.WORD	ERNDSR
	.WORD	EROFID
	.WORD	ERPUT
;
; ERROR MESSAGE
;
EROPEN:	.ASCII	/ACL - OPEN$ FAILURE     /
ERCLOS:	.ASCII	/ACL - CLOSE$ FAILURE    /
ERNDSR:	.ASCII	/ACL - NO DSR AVAILABLE  /
EROFID:	.ASCII	/ACL - OFID$ FAILURE     /
ERPUT:	.ASCII	/ACL - PUT$ FAILURE      /
;
; MISC. STORAGE
;
DSR:	.WORD	0			;ADDRESS OF DSR BLOCK
ERROR:	.WORD	0			;ERROR MESSAGE TABLE OFFSET

	.SBTTL	TASK REQUEST INTERCEPT CODE
ICBEG:					;REFERENCE LABEL - BEGINNING OF
					;INTERCEPT CODE AREA
;
; TASK REQUEST INTERCEPT CODE
;
TSKRQ:	CALL	ACTACB			;ALLOCATE ACB AND MARK IT ACTIVE
	BIC	2(SP),(R3)+		;* INTERCEPTED INSTRUCTION
	CLR	2(SP)			;* INTERCEPTED INSTRUCTION
	RETURN

	.SBTTL	CONTEXT SWITCH INTERCEPT CODE
;
; ENTERING INTO IDLE LOOP
;	R5	=0
;
 
	.IF EQ	V$$RSN-31
 
CNTSW0:	TST	PST			;PREVIOUSLY IN IDLE LOOP?
	BEQ	20$			;IF EQ, YES
	MOV	R5,PST			;UPDATE NEW PREVIOUS STATE
	MOV	R0,-(SP)		;SAVE REGISTERS
	MOV	R1,-(SP)
	MOV	ACBST,R0		;GET START OF ACB LIST
	MOV	#TP.ACT,R1		;FIND ACTIVE ACB
	MOV	@#$TKTCB,R5		;GET CURRENT TCB ADDRESS
	CALL	SRACB
	BCS	10$			;IF CS, ACB NOT FOUND
	CALL	UPCPU			;UPDATE ELAPSE CPU TIME
10$:	MOV	(SP)+,R1
	MOV	(SP)+,R0
20$:	CLRB	@#$CURPR		;* INTERCEPTED INSTRUCTION
	RETURN
 
	.ENDC
 
;
; SETUP INITIAL SWITCH TIME ON NO CONTEXT SWITCH
;
;	R5	=TCB ADDRESS
;
 
	.IF EQ	V$$RSN-31
 
CNTSW1:	CMP	R5,@#$TKTCB		;* INTERCEPTED INSTRUCTION
	BNE	30$			;IF NE, NEW TASK DIFFERENT FROM CURRENT
	ADD	#2,(SP)			;ADJUST RETURN ADDRESS
	TST	PST			;COMING FROM IDLE LOOP?
	BNE	20$			;IF NE, NO
;
; INITIALIZE SWITCH TIME
;
	MOV	R0,-(SP)		;SAVE REGISTERS
	MOV	R1,-(SP)
	MOV	ACBST,R0		;GET START OF ACB LIST
	MOV	#TP.ACT,R1		;FIND ACTIVE ACB
	CALL	SRACB
	BCS	10$			;IF CS, ACB NOT FOUND
	BIS	#340,@#PS		;RAISE PRIORITY TO 7
	MOV	ACTIM,AC.STM(R0)	;;;UPDATE SWITCH TIME
	MOV	ACTIM+2,AC.STM+2(R0)	;;;
	CLRB	@#PS			;;;LOWER PRIORITY TO 0
10$:	MOV	(SP)+,R1		;RESTORE REGISTERS
	MOV	(SP)+,R0
20$:	MOV	R5,PST			;UPDATE NEW PREVIOUS STATE
30$:	RETURN
 
	.ENDC
 
;
; CONTEXT SWITCH INTERCEPT CODE
;	$TKTCB	=OLD TCB
;	R5	=NEW TCB
;
 
	.IF EQ	V$$RSN-31
 
CNTSW2:
 
	.IFF
 
CNTSW:
 
	.ENDC
 
	MOV	R0,-(SP)		;SAVE REGISTERS
	MOV	R1,-(SP)
	MOV	R5,-(SP)
 
	.IF EQ	V$$RSN-31
 
	TST	PST			;COMING FROM IDLE LOOP?
	BEQ	10$			;IF EQ, YES
 
	.ENDC
 
;
; UPDATE ELAPSE CPU TIME OF OLD TASK
;
	MOV	ACBST,R0		;GET START OF ACB LIST
	MOV	#TP.ACT,R1		;THE ACB IS ACTIVE
	MOV	@#$TKTCB,R5		;MUST MATCH THIS TCB ADDRESS
	CALL	SRACB			;SEARCH ACTIVE ACB
	BCS	10$			;IF CS, NO ACB FOUND
	CALL	UPCPU			;UPDATE ELAPSE CPU TIME
;
; INITIALIZE SWITCH TIME OF NEW TASK
;
10$:	MOV	ACBST,R0		;GET START OF ACB LIST
 
	.IF EQ	V$$RSN-31
 
	MOV	#TP.ACT,R1		;FIND ACTIVE ACB
 
	.ENDC
 
	MOV	(SP)+,R5		;GET TCB OF NEW TASK
 
	.IF EQ	V$$RSN-31
 
	MOV	R5,PST			;UPDATE NEW PREVIOUS STATE
 
	.ENDC
 
	CALL	SRACB			;SEARCH ACTIVE ACB OF NEW TASK
	BCS	20$			;IF CS, NO ACB FOUNE
	BIS	#340,@#PS		;RAISE PRIORITY TO 7
	MOV	ACTIM,AC.STM(R0)	;;;SAVE SWITCH TIME
	MOV	ACTIM+2,AC.STM+2(R0)	;;;
	CLRB	@#PS			;;;LOWER PRIORITY TO 0
20$:	MOV	(SP)+,R1		;RESTORE REGISTERS
	MOV	(SP)+,R0
	MOV	R5,@#$TKTCB		;* INTERCEPTED INSTRUCTION
	RETURN

	.SBTTL	TASK EXIT INTERCEPT CODE
;
; TASK EXIT INTERCEPT CODE
;	R5	=TCB ADDRESS OF EXITING TASK
;
TSKXT:	MOV	R0,-(SP)		;SAVE REGISTERS
	MOV	R1,-(SP)
;
; UPDATE ELASE TIME OF EXITING TASK
;
	MOV	ACBST,R0		;GET START OF ACB LIST
	MOV	#TP.ACT,R1		;ACB IS ACTIVE
	CALL	SRACB			;FIND ACB BELONGING TO EXITING TASK
	BCS	10$			;IF CS, NO ACB FOUND
	CALL	UPCPU			;UPDATE CPU ELAPSE TIME
	CALL	XITACB			;UPDATE ELAPSE TIME, UIC & TASKNAME
	MOV	#TP.XIT,AC.TYP(R0)	;MARK ACB TO BE AN EXIT ACB
	MOV	ACLTCB,R1		;GET TCB ADDRESS OF ACL TASK
	BIS	#TXEFB,T.EFLG(R1)	;SET TASK EXIT EVENT FLAG
10$:	MOV	(SP)+,R1		;RESTORE REGISTERS
	MOV	(SP)+,R0
	CALLR	@#$DRCMT		;* INTERCEPTED INSTRUCTION

	.SBTTL	CLOCK INTERRUPT INTERCEPT CODE
;
; CLOCK INTERRUPT INTERCEPT CODE
;
FRQCLK:	ADC	ACTIM			;;;UPDATE ACCOUNTING TIME
	ADC	ACTIM+2			;;;
 
	.IF EQ	V$$RSN-31
 
	CMP	#$HEADR,@#$RQSCH		;;;IN IDLE LOOP?
	BNE	10$			;;;IF NE, NO
	ADD	#1,IDLE			;;;UPDATE IDLE TIME
	ADC	IDLE+2			;;;
	BR	20$			;;;
10$:	BIT	#PMODE,@#PS		;;;DID WE COME FROM KERNAL MODE?
	BNE	20$			;;;IF NE, NO
	ADD	#1,KRNL			;;;UPDATE TIME SPENT IN KERNAL MODE
	ADC	KRNL+2			;;;
 
	.IFF
 
	BIT	#PMODE,@#PS		;;;DID WE COME FROM KERNAL MODE
	BNE	10$			;;;IF NE, NO
	ADD	#1,KRNL			;;;UPDATE TIME SPENT IN KERNAL MODE
	ADC	KRNL+2			;;;
	BR	20$			;;;
10$:	CMP	@#$TKTCB,#$HEADR	;;;IS NULL TASK THE CURRENT TASK?
	BNE	20$			;;;IF NE, NO
	ADD	#1,IDLE			;;;UPDATE IDLE TIME
	ADC	IDLE+2			;;;
 
	.ENDC
 
20$:	JMP	@#$CKINT		;;;* RESUME NORMAL INTERRUPT CODE

	.SBTTL	QIO DONE INTERCEPT CODE
;
; QIO INTERCEPT CODE
;	R3	=I/O PACKET ADDRESS
;	R5	=UCB ADDRESS
;
QIOCNT:	MOV	R0,-(SP)		;SAVE REGISTERS
	MOV	R1,-(SP)
	MOV	R5,-(SP)
;
; FIND ACB OF TASK DOING I/O
;
	MOV	ACBST,R0		;GET START OF ACB LIST
	MOV	#TP.ACT,R1		;ACB IS ACTIVE
	MOV	I.TCB(R3),R5		;GET TCB ADDRESS
	CALL	SRACB			;FIND ACTIVE ACB BELONGING TO THIS TCB
	BCS	30$			;IF CS, NO ACB FOUND
;
; UPDATE DEVICE QIO COUNT
;
	MOV	I.UCB(R3),R5		;GET UCB ADDRESS
	MOV	U.DCB(R5),R5		;GET DCB ADDRESS
	MOV	PC,R1			;GET LOGGING DEVICE NAME TABLE
	ADD	#DVTBL-.,R1
10$:	TST	(R1)			;END OF TABLE?
	BEQ	20$			;IF EQ, YES
	CMP	(R1),D.NAM(R5)		;DEVICE NAME MATCHES?
	BEQ	20$			;IF EQ, YES
	ADD	#4,R1			;TRY NEXT DEVICE
	BR	10$
20$:	MOV	2(R1),R1		;GET ACB INDEX
	ADD	R0,R1			;ADD ACB BASE ADDRESS
	INC	(R1)			;INCREMENT QIO COUNT
30$:	MOV	(SP)+,R5		;RESTORE REGISTERS
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	MOV	I.IOSB+4(R3),R2		;* INTERCEPTED INSTRUCTION
	RETURN

	.SBTTL	ACTIVATE ACB ROUTINE
;
; ALLOCATES ACB FROM ACB LIST, INITIALIZE THE ACB AND MARK IT ACTIVE
;	R0	=TCB ADDRESS
;
; NOTE:	THIS ROUTINE IS CALL FROM BOTHE THE MAINLINE AND THE INTERCEPT
;	ROUTINE IN DSR.
;
ACTACB:	MOV	R0,-(SP)		;SAVE REGISTERS
	MOV	R1,-(SP)
;
; GET FREE ACB
;
	MOV	ACBST,R0		;GET START OF ACB
	MOV	#TP.AVL,R1		;FIND AVAILABLE ACB
	CLR	R5			;MATCH ANY AVAILABLE ACB
	CALL	SRACB
	BCS	10$			;IF CS, NO ACB AVAILABLE
;
; INITIALIZE CPU, ELAPSE TIME & QIO COUNT
;
	MOV	2(SP),AC.TCB(R0)	;SAVE TCB ADDRESS
	BIS	#340,@#PS		;RAISE PRIORITY TO 7
	MOV	ACTIM,AC.STM(R0)	;;;SAVE INITIAL CPU TIME (LOW)
	MOV	ACTIM+2,AC.STM+2(R0)	;;;(HIGH)
	MOV	ACTIM,AC.ELP(R0)	;;;SAVE INITIAL ELAPSE TIME (LOW)
	MOV	ACTIM+2,AC.ELP+2(R0)	;;;(HIGH)
	CLRB	@#PS			;;;LOWER PRIORITY TO 0
	CLR	AC.CPU(R0)		;INITIALIZE ACCUMULATED CPU TIME
	CLR	AC.CPU+2(R0)
	CLR	AC.QDB(R0)		;INITIALIZE DB QIO COUNT
	CLR	AC.QLP(R0)		;INITIALIZE LP QIO COUNT
	CLR	AC.QMT(R0)		;INITIALIZE MT QIO COUNT
	CLR	AC.QOT(R0)		;INITIALIZE OTHER QIO COUNT
	MOV	#TP.ACT,AC.TYP(R0)	;MARK ACB ACTIVE
	BR	20$
10$:	INC	LSTRQ			;INCREMENT LOST REQUEST (NO ACB AVAILABLE)
20$:	MOV	(SP)+,R1		;RESTORE REGISTERS
	MOV	(SP)+,R0
	RETURN

	.SBTTL	SEARCH ACB LIST ROUTINE
;
; SEARCH ACB LIST FOR ACB WITH MATCHING TYPE AND TCB ADDRESS
;
;	INPUT
;	R0	=STARTING ACB ADDRESS
;	R1	=ACB TYPE (TP.AVL, TP.ACT, TP.XIT)
;	R5	=0 (ANY ACB OF TYPE IN R1)
;		=TCB ADDRESS
;
;	OUTPUT
;	CC	IF ACB FOUND
;		R0	=ACB ADDRESS
;	CS	IF ACB NOT FOUND
;
SRACB:	BIT	R1,AC.TYP(R0)		;MATCHING TYPE?
	BNE	20$			;IF NE, YES
10$:	MOV	(R0),R0			;GET NEXT ACB ADDRESS
	BEQ	40$			;IF EQ, END OF ACB LIST
	BR	SRACB
20$:	TST	R5			;MATCH TCB ADDRESS?
	BEQ	30$			;IF EQ, NO
	CMP	R5,AC.TCB(R0)		;TCB ADDRESS MATCH?
	BNE	10$			;IF NE, NO
30$:	CLC				;FOUND ACB
	RETURN
40$:	SEC				;ACB NOT FOUND
	RETURN

	.SBTTL	UPDATE CPU TIME ROUTINE
;
; UPDATE CPU TIME
;	R0	=ACB ADDRESS
;
UPCPU:	BIS	#340,@#PS		;RAISE PRIORITY TO 7
	MOV	ACTIM+2,-(SP)		;;;SAVE CURRENT TIME
	MOV	ACTIM,-(SP)		;;;
	CLRB	@#PS			;;;LOWER PRIORITY TO 0
	SUB	AC.STM(R0),(SP)		;CALCULATE ELAPSE TIME
	SBC	2(SP)
	SUB	AC.STM+2(R0),2(SP)
	ADD	(SP)+,AC.CPU(R0)	;ADD TO TOTAL CPU TIME
	ADC	AC.CPU+2(R0)
	ADD	(SP)+,AC.CPU+2(R0)
	RETURN

	.SBTTL	UPDATE ELAPSE TIME, UIC & TASK NAME ROUTINE
;
; UPDATE ELAPSE TIME, UIC & TASK NAME
;	R0	=ACB ADDRESS
;	R5	=TCB ADDRESS
;
XITACB:	MOV	R1,-(SP)		;SAVE REGISTER
	BIS	#340,@#PS		;RAISE PRIORITY TO 7
	MOV	ACTIM+2,-(SP)		;;;SAVE EXITING TIME
	MOV	ACTIM,-(SP)		;;;
	CLRB	@#PS			;;;
	SUB	AC.ELP(R0),(SP)		;CALCULATE ELAPSE TIME
	SBC	2(SP)
	SUB	AC.ELP+2(R0),2(SP)
	MOV	(SP)+,AC.ELP(R0)	;SAVE ELAPSE TIME
	MOV	(SP)+,AC.ELP+2(R0)	
;
; SAVE EXITING TASK'S UIC AND NAME
;
	MOV	T.UCB(R5),R1		;GET UCB ADDRESS OF 'TI'
 
	.IF DF	M$$MUP
 
	MOV	U.LUIC(R1),AC.UIC(R0)	;SAVE LOGIN UIC
 
	.IFF
 
	MOV	U.UIC(R1),AC.UIC(R0)	;SAVE TERMINAL UIC
 
	.ENDC
 
	MOV	T.NAM(R5),AC.NAM(R0)	;COPY TASK NAME INTO ACB
	MOV	T.NAM+2(R5),AC.NAM+2(R0)
	MOV	(SP)+,R1		;RESTORE REGISTER
	RETURN

	.SBTTL	LOCAL STORAGE IN DSR
;
; LOCAL STORAGE IN DSR
;
 
	.IF EQ	V$$RSN-31
 
PST:	.WORD	0			;PREVIOUS STATE WORD
 
	.ENDC
 
ACLTCB:	.WORD	0			;ACCOUNT LOG TASK TCB ADDRESS
LSTRQ:	.WORD	0			;LOST TASK REQUEST COUNT
ACBST:	.WORD	0			;START OF ACB LIST
ACTIM:	.WORD	0,0			;ACCOUNTING TIME
KRNL:	.WORD	0,0			;TIME SPENT IN KERNAL
IDLE:	.WORD	0,0			;IDLE TIME
DVTBL:	.ASCII	/DB/			;DEVICE TABLE OF ACCOUNTABLE DEVICES
	.WORD	AC.QDB
	.ASCII	/LP/
	.WORD	AC.QLP
	.ASCII	/MT/
	.WORD	AC.QMT
	.WORD	0,AC.QOT		;END OF TABLE
ICEND:					;REFERENCE LABEL - END OF INTERCEPT CODE
					;AREA
	.END	ST