.TITLE	TRACKR - F4P INSTRUCTION TRACKER
	.SBTTL	TRACKR - TITLE PAGE
	.IDENT	/V01.00/
;
; THIS MODULE COUNTS EACH INSTRUCTION EXECUTED AND STORES THE RESULTS
; BY THE NAME OF THE CURRENT FORTRAN SUBROUTINE. IT ALSO COUNTS THE NUMBER
; OF TIMES A SUBROUTINE IS CALLED.
;
; VERSION:	V01.00
;
; AUTHOR:	R.W. STAMERJOHN	  MAPC	23-MAR-81
;
; MODIFICATION HISTORY:
;
;	V01.00	RWS	23-MAR-81	INITIAL VERSION

	.SBTTL	TRACKR - DECLARATIONS
	.DSABL	GBL
;
; MACRO LIBRARY CALLS:
;
;	DIRECTIVE MACROS.
;
	.MCALL	SVDB$S
;
; GLOBAL DECLARATIONS:
;
;	MODULE ENTRY POINTS.
;
	.GLOBL	TRKBEG			;START SUBROUTINE TRACKING
	.GLOBL	TRKEND			;END   SUBROUTINE TRACKING
;
; GLOBAL REFERENCES:
;
;	FORTRAN OTS SYMBOLS.
;
	.GLOBL	$OTSV			;FORTRAN WORK AREA POINTER

	.SBTTL	TRACKR - LOCAL DATA
;
; LOCAL SYMBOLS:
;
;	TRACKING FLAG MASKS.
;
TR.BEG	= 1				;START OF SUBROUTINE
TR.END	= 2				;END   OF SUBROUTINE
;
;	EMT MASKS.
;
EM.ENA	= 1				;ENABLE  TRACKING
EM.DIS	= 2				;DISABLE TRACKING
;
;	CELL OFFSETS.
;
C.NAME	= 0				;SUBROUTINE NAME
C.CALL	= 4				;NUMBER TIMES CALLED
C.INSX	= 10				;NUMBER INSTRUCTIONS
C.SIZE	= 14				;SIZE OF CELL
;
; LOCAL DATA:
;
;	DEBUGGING SST VECTOR.
;
TRKSST::				;REF. LABEL
	.WORD	0			;ODD ADDRESS
	.WORD	0			;MEMORY PROTECT
	.WORD	TRKCNT			;T-BIT TRAP
	.WORD	0			;IOT INSTRUCTION
	.WORD	0			;RESERVED INSTRUCTION
	.WORD	TRKCTL			;NON-RSX EMT
TRKSIZ = <.-TRKSST>/2
;
;	TRACKING MASK WORD.
;
FLAG:	.WORD	0			;TRACKING MASK
;
;	CURRENT SUBROUTINE NAME.
;
NAME:	.WORD	0			;CURRENT SUBROUTINE NAME
	.WORD	0			; SECOND PART OF NAME
;
;	INSTRUCTION ACCUMULATORS.
;
COUNT:	.WORD	0			;INSTRUCTION COUNTS
	.WORD	0			; SECOND PART OF COUNTS
;
;	CELL PARAMETERS.
;
CELSIZ:	.WORD	0			;NUMBER OF COUNTER CELLS
CELBUF:	.WORD	0			;ADDRESS OF COUNTER BUFFER
OVRBUF:	.WORD	0			;ADDRESS OF OTHER BUFFER

	.SBTTL	TRKCNT * COUNT INSTRUCTIONS
;
;+
; THIS SUBROUTINE COUNTS AN INSTRUCTION. IT ALSO CHECKS THE MASK
; WORD AND PERFORMS START AND STOP OF SUBROUTINE WORK.
;
; INPUT:
;
;	CALLED BY T-BIT SST. CALLED WITH STACK AS FOLLOWS:
;
;		(SP)+00 = PC OF TRAP
;		(SP)+02 = PS OF TRAP
;
; OUTPUT:
;
;	INSTRUCTION COUNTED AND RTT EXECUTED. IF START OF SUBROUTINE,
;	INITIALIZE COUNTERS AND NAME. IF END OF SUBROUTINE, STORE
;	VALUES AND RESET FOR NEXT ROUTINE.
;
;
; REGISTERS:	USES R0,R1	SAVES R0-R5
;
;-
;
TRKCNT:					;REF. LABEL
	TST	FLAG			;IS A TRACE CONTROL INSTRUCTION?
	BNE	1000$			; IF NE - YES, PROCESS
;
; COUNT INSTRUCTION AND RETURN.
;
	ADD	#1,COUNT+0		;COUNT INSTRUCTION
	ADC	COUNT+2			; COUNT OVERFLOW
	RTT				;RETURN TO CALLER
;
; PROCESS SUBROUTINE CONTROL. SAVE WORKING REGISTERS.
;
1000$:	MOV	R0,-(SP)		;SAVE R0
	MOV	R1,-(SP)		;SAVE R1
;
; CHECK FOR BEGINNING OF A NEW SUBROUTINE.
;
	CMP	#TR.BEG,FLAG		;IS THIS START OF TRACE?
	BNE	2000$			; IF NE  - NO, SKIP
;
; PROCESS START OF SUBROUTINE. ADD COUNTS TO PREVIOUS SUBROUTINE
; AND COUNT CALL OF NEW SUBROUTINE. AT THIS POINT, STACK IS ASSUMED
; TO HAVE THE FOLLOWING:
;
;	(SP)+00 = SAVED R0
;	(SP)+02 = SAVED R1
;	(SP)+04 = PC OF TRAP
;	(SP)+06 = PS OF TRAP
;	(SP)+10 = FIRST  PART OF ROUTINE NAME (RAD50)
;	(SP)+12 = SECOND PART OF ROUTINE NAME (RAD50)
;
;	NAME IS ASSUMED TO HAVE CALLING SUBROUTINE NAME.
;
	CALL	TRKFND			;FIND CURRENT NAME CELL
	SUB	#3,COUNT+0		;CORRECT COUNT FOR $NAM CALL
	SBC	COUNT+2			; IN DOUBLE PRECESION
	ADD	COUNT+0,(R0)+		;ADD CURRENT INSTRUCTION COUNTS
	ADC	(R0)			; IN DOUBLE PRECESION
	ADD	COUNT+2,(R0)+		; ADD HIGH PART OF COUNTS

	MOV	10(SP),NAME+0		;STORE NEW NAME
	MOV	12(SP),NAME+2		; STORE HIGH PART
	MOV	#3,COUNT+0		;COUNT $NAM CALL
	CLR	COUNT+2			; IN DOUBLE PRECESION

	CALL	TRKFND			;FIND CURRENT NAME CELL
	INC	-4(R0)			;COUNT SUBROUTINE CALL
	ADC	-2(R0)			; IN DOUBLE PRECESION
	BR	3000$			;AND EXIT CONTROL
;
; CHECK FOR END OF A SUBROUTINES.
;
2000$:	CMP	#TR.END,FLAG		;IS THIS END OF TRACE?
	BNE	3000$			; IF NE  - NO, SKIP
;
; PROCESS END OF SUBROUTINE. ADD COUNTS TO CURRENT SUBROUTINE AND
; RESET NAME OF PREVIOUS SUBROUTINE. AT THE POINT, STACH IS ASSUMED
; TO HAVE THE FOLLOWING:
;
;	(SP)+00 = SAVED R0
;	(SP)+02 = SAVED R1
;	(SP)+04 = PC OF TRAP
;	(SP)+06 = PS OF TRAP
;
;	NAME IS ASSUMED TO HAVE CALLING SUBROUTINE NAME.
;
;	R4 = OTS POINTER. SECOND WORD IS ADDRESS OF NEXT TRACEBACK
;	CELL. USE THIS TO RESET NAME.
;
	CALL	TRKFND			;FIND CURRENT NAME CELL
	ADD	#1,COUNT+0		;COUNT RETURN FROM $NAM
	ADC	COUNT+2			; IN DOUBLE PRECISION
	ADD	COUNT+0,(R0)+		;ADD CURRENT INSTRUCTION COUNTS
	ADC	(R0)			; IN DOUBLE PRECESION
	ADD	COUNT+2,(R0)+		; ADD HIGH PART OF COUNTS

	MOV	2(R4),R0		;GET PREVIOUS NAME TRACEBACK
	MOV	4(R0),NAME+0		;STORE PREVIOUS NAME
	MOV	6(R0),NAME+2		; STORE HIGH PART
	MOV	#-1,COUNT+0		;RESET COUNTER (FOR RETURN FROM $NAM)
	MOV	#-1,COUNT+2		; IN DOUBLE PRECISION
;
; EXIT TRACE CONTROL. RESTORE REGISTERS, ZERO FLAG, AND ZERO COUNTER.
;
3000$:	MOV	(SP)+,R0		;RESTORE R0
	MOV	(SP)+,R1		;RESTORE R1
	CLR	FLAG			;CLEAR TRACEBACK FLAG
	RTT				;RETURN TO CALLER

	.SBTTL	TRKFND * FIND TRACKING CELL
;
;+
; THIS SUBROUTINE FINDS A TRACKING CELL. IT SEARCHES THE CELL
; BUFFER FOR THE CURRENT VALUE STORED IN 'NAME'. IF FOUND, R0
; IS RETURNED AS THE CELL. IF NOT FOUND AND AN EMPTY CELL IS
; AVAILABLE, 'NAME' IS STORED AND THE CELL RETURNED. OTHERWISE,
; A POINTER IS RETURNED TO THE OVERFLOW AREA.
;
; INPUT:
;
;	NAME = RAD50 NAME OF SUBROUTINE TO FIND
;
;	CELSIZ = NUMBER OF CELLS
;	CELBUF = ADDRESS OF CELL BUFFER
;	OVRBUF = ADDRESS OF OVERFLOW BUFFER
;
; OUTPUT:
;
;	R0 = CELL TO USE (INDEXED TO INSTRUCTION COUNTS).
;
;
; REGISTERS:	USES R0,R1	SAVES R2-R5
;
;-
;
TRKFND:					;REF. LABEL
	MOV	CELSIZ,R1		;GET NUMBER OF CELLS
	MOV	CELBUF,R0		;GET ADDRESS OF CELL BUFFER
;
; SEARCH CELL BUFFER FOR ENTRY. ALSO STORE ANY FREE ENTRY FOUND.
;
1000$:	CMP	NAME+0,(R0)		;IS THIS A MATCH
	BNE	2000$			; IF NE - NO
	CMP	NAME+2,2(R0)		;IS THIS A MATCH
	BEQ	3100$			; IF EQ - YES, CONTINUE

2000$:	TST	(R0)			;IS CELL FREE?
	BNE	2100$			; IF NE - NO
	TST	2(R0)			;IS CELL FREE?
	BEQ	3000$			; IF NE - NO

2100$:	ADD	#C.SIZE,R0		;ADVANCE TO NEXT CELL
	SOB	R1,1000$		; AND LOOP TO NEXT
;
; NOT FOUND AND NO FREE CELL, COUNT AS OVERFLOW.
;
	MOV	OVRBUF,R0		;GET ADDRESS OF OVERFLOW
;
; GET FOUND CELL, SET SUBROUTINE NAME AND RETURN.
;
3000$:	MOV	NAME+0,(R0)		;STORE SUBROUTINE NAME
	MOV	NAME+2,2(R0)		; STORE HIGH PART

3100$:	ADD	#10,R0			;SKIP INSTRUCTION COUNTERS
	RETURN				;RETURN TO CALLER

	.SBTTL	TRKBEG * ENABLE TRACKING
;
;+
; THIS SUBROUTINE ENABLES INSTRUCTION TRACKING.
;
; INPUT:
;
;	CALL FROM FORTRAN STATEMENT AS FOLLOWS:
;
;		CALL TRKBEG (A,B,C)
;
;		A = NUMBER  OF CELLS
;		B = ADDRESS OF CELL ARRAY (ONE CELL IS 6 WORDS)
;		C = ADDRESS OF OVERFLOW ARRAY (6 WORDS)
;
; OUTPUT:
;
;	CELL SIZE AND COUNTER ARRAY ADDRESS ARE STORED AND ARRAY'S
;	ARE INITIALIZED. NOTE, IF PREDEFINED SUBROUTINE NAMES ARE
;	WANTED, INITIALIZE THE FIRST TWO WORDS OF EACH CELL TO THE
;	RAD50 SUBROUTINE NAME. OTHERWISE, LEAVE AS ZERO.
;
;
; REGISTERS:	USES R0,R1,R5	SAVES R2-R4
;
;-
;
TRKBEG::				;REF. LABEL
;
; STORE CALLING PARAMETERS.
;
	TST	(R5)+			;SKIP NUMBER OF ARGUMENTS
	MOV	@(R5)+,CELSIZ		;STORE NUMBER OF CELLS
	MOV	(R5)+,CELBUF		;STORE ADDRESS OF CELL ARRAY
	MOV	(R5)+,OVRBUF		;STORE ADDRESS OF OVERFLOW ARRAY
;
; STORE STARTING TRACE-BACK NAME.
;
	MOV	@#$OTSV,R0		;GET OTS POINTER
	MOV	2(R0),R0		;GET NAME BLOCK POINTER
	MOV	4(R0),NAME+0		;STORE PROGRAM NAME
	MOV	6(R0),NAME+2		; STORE SECOND PART
	CLR	FLAG			;CLEAR FLAG
;
; SETUP DEBUG SST.
;
	SVDB$S	#TRKSST,#TRKSIZ
;
; ISSUE EMT 1 TO START TRACING.
;
	EMT	EM.ENA			;ENABLE TRACING
	RETURN				;RETURN TO CALLER

	.SBTTL	TRKEND * DISABLE TRACKING
;
;+
; THIS SUBROUTINE DISABLES INSTRUCTION TRACKING.
;
; INPUT:
;
;	CALL FROM FORTRAN STATEMENT AS FOLLOWS:
;
;		CALL TRKEND
;
; OUTPUT:
;
;	INSTRUCTION TRACING IS DISABLED. CURRENT COUNT ARE UPDATED.
;
;
; REGISTERS:	USES R0,R1,R5	SAVES R2-R4
;
;-
;
TRKEND::				;REF. LABEL
;
; GET CURRENT TOTALS STORED AWAY.
;
	MOV	#TR.END,FLAG		;STORE CURRENT COUNTS
;
; ISSUE EMT 2 TO DISABLE TRACING.
;
	EMT	EM.DIS			;DISABLE TRACING
;
; DISABLE SST'S
;
	SVDB$S	#0,#0			;DISABLE SST'S
	RETURN				;RETURN TO CALLER

	.SBTTL	TRKCTL * CONTROL TRACING
;
;+
; THIS SUBROUTINE ENABLES OR DISABLE TRACING. IT IS CALLED BY AN
; EMT 1 OR 2 AND MANIPULATES THE T-BIT OF THE PSW.
;
; INPUT:
;
;	CALLED BY NON-RSX SST. CALLED WITH STACK AS FOLLOWS:
;
;		(SP)+00 = EMT OP-CODE (TIMES 2)
;		(SP)+02 = PC OF TRAP
;		(SP)+04 = PS OF TRAP
;
; OUTPUT:
;
;	T-BIT IN PSW SET OR CLEARED ACCORDING TO EMT 1 OR 2.
;
;
; REGISTERS:	USES R0		SAVES R1-R5
;
;-
;
TRKCTL:					;REF. LABEL
	MOV	(SP)+,R0		;GET OPERAND CODE
	CMP	#EM.ENA*2,R0		;IS THIS ENABLE TRACING?
	BNE	1000$			; IF NE - NO
	BIS	#020,2(SP)		;SET T-BIT
	RTT				; AND RETURN

1000$:	CMP	#EM.DIS*2,R0		;IS THIS DISABLE TRACING?
	BNE	2000$			; IF NE - NO
	BIC	#020,2(SP)		;CLEAR T-BIT
	RTT				; AND RETURN

2000$:	HALT				;NOT EXPECTED, HALT.

	.SBTTL	$NAM   - TRACEBACK NAME ROUTINE
;+
; THIS ROUTINE IS A VERSION OF DIGITAL'S $NAM ROUTINE. IT PERFORMS
; THE SAME FUNCTION BUT ALSO FLAGS THE START AND END OF ROUTINES.
;
; THE CHAIN IS CREATED ON THE RUN-TIME STACK AND LINKED TO THE PREVIOUS
; NAME. THE ROUTINES DOES A CO-ROUTINE CALL AND ON RETURN, UNLINKS THE
; CHAIN AND RETURNS TO THE CALLER.
;
; INPUT:
;
;		(SP)+00 = FIRST  PART OF NAME (RAD50)
;		(SP)+02 = SECOND PART OF NAME (RAD50)
;
;		R4 = RETURN ADDRESS.
;
; OUTPUT:
;
;		NAME TRACE BLOCK SETUP. ON FINAL RETURN, PREVIOUS
;		CHAIN SETUP.
;-

NAM$::					;REF. LABEL
	MOV	#TR.BEG,FLAG		;FLAG START OF SUBROUTINE
	MOV	@#$OTSV,R3		;GET OTS POINTER
	MOV	(R3)+,-(SP)		;OLD SEQUENCE NUMBER
	MOV	@R3,-(SP)		;OLD NAME POINTER
	MOV	SP,@R3			;NEW NAME POINTER
	CLR	-(R3)			;INIT SEQUENCE NUMBER
	CALL	@R4			;CALL CALLER BACK
;
; R0-R3 ARE UNTOUCHED FOR RETURN SINCE THEY MAY CONTAIN FUNCTION VALUE.
;
	MOV	@#$OTSV,R4		;GET OTS POINTER
	MOV	(SP)+,2(R4)		;W.NAMC
	MOV	(SP)+,@R4		;W.SEQC
	CMP	(SP)+,(SP)+		;CLEAN STACK
	MOV	#TR.END,FLAG		;FLAG END OF SUBROUTINE
	RETURN				;TAKE FINAL RETURN

	.END