;+
; PERFRM 
;
; AUTHOR: S. M. LAZARUS
;	  FORD AEROSPACE AND COMMUNICATIONS CORPORATION
;	  MAIL STOP X-90
;	  3939 FABIAN WAY
;	  PALO ALTO, CALIFORNIA  94303
;
;	  THIS IS A MODIFICATION OF "TIMER.MAC" FROM THE CHICAGO (SPRING 1979)
;	  DECUS TAPE  WRITTEN BY DAVE ARGUE OF A.E.C.L.  MUCH THANKS TO DAVE
;	  FOR A GREAT UTILITY THAT I WAS ABLE TO BUILD UPON.
;
;	  THIS FILE BUILDS THE ROUTINE TIMER IF "MEAS" IS UNDEFINED AND
;	  MEASUR IF "MEAS" IS DEFINED.  TIMER IS IDENTICAL TO THAT OF
;	  ARGUE'S EXCEPT THAT FLOATING POINT INSTRUCTIONS HAVE BEEN ELIMINATED.
;	  THE TABLE VARIABLES THAT WERE PREVIOUSLY FLOATING POINT ARE NOW
;	  DOUBLE INTEGER.
;
;	  THE MEASUR ROUTINE ALLOWS THE RECORDING OF THE NUMBER OF TIMES
;	  EACH ROUTINE IS CALLED.  A PATCH TO THE DEC F4P NAM$ OTS ROUTINE
;	  PASSES CONTROL TO $COUNT WITHIN THIS ROUTINE WHENEVER A NEW
;	  NAME IS ADDED TO THE TRACEBACK STACK.  SINCE A CALL IS MADE
;	  FROM THE MAIN PROGRAM AS SOON AS IT COMES UP, IT IS NECESSARY
;	  TO BE ABLE TO IGNORE CALLS UNTIL INITIALIZATION IS PERFORMED.
;	  THIS IS CONTROLLED BY THE VARIABLE SFLAG.  WHEN MEASUR IS
;	  EXPLICITLY CALLED SFLAG IS SET TO 1 AND WE'RE ON OUR WAY.
;
;	  A SPECIAL PROBLEM ARISES WHEN DOING BOTH TIMING AND COUNTING
;	  CALLS.  A TIMING INTERRUPT MAY OCCUR WHILE WE ARE IN THIS
;	  ROUTINE TO RECORD A CALL.  VARIABLES CNTFLG AND TIMFLG ACT
;	  AS CONTROL VARIABLE FOR COUNTING AND TIMING RESPECTIVELY.
;	  WE ADD TO THE TIME TABLE IF TIMFLG IS SET AND TO THE COUNT
;	  TABLE IF CNTFLG IS SET.  IF AN AST ENTRY OCCURS TO TIME:
;	  AT A CLOCK INTERRUPT AND CNTFLG IS SET, WE ARE IN THIS ROUTINE.
;	  IN THIS CASE, TIMFLG IS SET AND AN EXIT PERFORMED.
;
;	  CODE IS LARGELY SHARED BETWEEN THE ENTRIES AT TIME AND COUNT.
;	  THE OTHER ENTRY IS SKIPPED OVER AND THE TWO FLAGS USED TO 
;	  CONTROL WHICH TABLE IS UPDATED.
;-
	.PAGE
;
	.NLIST	CND
; RATFOR LIBRARY TIMING ROUTINES MEASUR AND TIMER
	.IF DF MEAS
	.TITLE MEASUR
	.IFF
	.TITLE	TIMER
	.ENDC
	.IDENT	"V2"
;
; TIME FORTRAN PROGRAMS BY AST'ING EVERY TIC AND CHECKING TRACEBACK
; CHAIN TO SEE WHAT FORTRAN ROUTINE IS EXECUTING.  SUBROUTINE TIMERX
; OR MESURX IS CALLED BY SYSTEM AT END OF FORTRAN PROGRAM TO PRINT STATISTICS.
;
	.MACRO	PUSH,LIST
	.IRP	X,<LIST>
	MOV	X,-(SP)
	.ENDR
	.ENDM
	.MACRO	POP,LIST
	.IRP	X,<LIST>
	MOV	(SP)+,X
	.ENDR
	.ENDM
	.MACRO	FCALL,NAME,LIST		;FORTRAN SUBROUTINE CALL
	MOV	#LIST,R5
	JSR	PC,NAME
	.ENDM
	.MCALL	MRKT$S,ASTX$S
;
	.IF NDF	MEAS
	.PSECT	TIMERC,GBL,OVR,RW,D
	.IFF
	.PSECT	MESURC,GBL,OVR,RW,D
	.ENDC
	TABSIZ=800.		;800 BYTES (200 DOUBLE INTEGERS ) PER TABLE
TABLE:	.BLKB	TABSIZ		;RAD50 SIX LETTER ROUTINE NAMES
	.BLKB	TABSIZ		;DOUBLE INTEGER COUNT
	.IF DF	MEAS		;DOUBLE INTEGER NUMBER OF CALLS
	.BLKB	TABSIZ		;DOUBLE INTEGER NUMBER OF CALLS
TCALLS:	.WORD	0,0		;TOTAL NUMBER OF SUBROUTINE CALLS
SFLAG:	.WORD	0		;SET TO 0 IF INITIALIZATION IS NOT YET PERFORMED
	.ENDC
TICS:	.WORD	0,0		;TOTAL NUMBER OF PROBES
NUMNAM:	.WORD	0		;NUMBER OF DIFFERENT ROUTINES
ELAPSD:	.FLT2	0.0		;ELAPSED TIME SINCE START OF TIMER
FN:	.BLKB	41.		;FILE NAME FOR TIMING INFO SUMMARY
	.PAGE
	.IF NDF MEAS
	.PSECT	TIMER
ARGL:	.WORD	1,TIMERX	;ARG LIST TO CALL USEREX
	.IFF
	.PSECT	MEASUR
ARGL:	.WORD	1,MESURX	;ARG LIST TO CALL USEREX
CNTFLG:	.WORD	0		;SET TO 1 WHEN RECORDING CALLS
TIMFLG: .WORD	0		;SET TO 1 WHEN RECORDING TICS
	.ENDC
ARGL2:	.WORD	1,ZERO		;ARG LIST TO CALL SECNDS
ZERO:	.WORD	0,0
ROUNAM:	.BLKW	2		;SET ROUNAM NON-ZERO TO BEGIN FORCING ALL
				;TICS TO BE RECORDED UNDER ROUNAM. SEE TIMEIN.
	.IF NDF	MEAS
TIMER::
	.IFF
MEASUR::
	.ENDC
	PUSH	<R0,R1,R5>	;INITIALIZE ENTRYPOINT
	CLR	NUMNAM		;TABLE IS EMPTY
	CLR	ROUNAM		;NORMAL RECORDING OF TICS
	CLR 	ROUNAM+2	;HO-HUM
	CLR	TICS		;NO TICS
	CLR	TICS+2		;MAKE SURE
	.IF DF	MEASUR
	CLR	CNTFLG
	CLR	TIMFLG
	CLR	TCALLS		;NUMBER OF CALLS
	CLR	TCALLS+2
	INC	SFLAG		;INDICATE THAT INITIALIZATION IS DONE
	.ENDC
;
	TST	(R5)+		;ANY ARGS?
	BNE	10$		;YES - GO HANDLE
	MOVB	#'L,FN		;SET FILE NAME TO L ...
	MOVB	#'P,FN+1	; P ...
	MOVB	#':,FN+2	; : ...
	CLRB	FN+3		;PUT IT ALL TOGETHER AND YOU GET LP: !
	BR	20$
;
10$:	MOV	(R5)+,R0	;PUT ADDRESS OF HIS FILE ARG IN R0
	MOV	#FN,R1		;AND MY STORE AREA FOR FILE ARG
	MOV	#40.,R5		;NO MORE THAN 40 CHARS MOVED
15$:	MOVB	(R0)+,(R1)+	;NEXT CHAR
	BEQ	20$		;DONE IF MOVED END OF STRING INDICATOR
	SOB	R5,15$		;ELSE IF MORE ROOM, GO MOVE MORE
	CLRB	(R1)		;40 CHARS - EOS STRING IN 41ST
;
20$:	FCALL	SECNDS <ARGL2>	;RECORD ELAPSED TIME
	MOV	R0,ELAPSD	;SAVE FIRST HALF OF START TIME
	MOV	R1,ELAPSD+2	;SECOND HALF
	FCALL	USEREX <ARGL>	;CALL TIMERX BEFORE EXITING
	POP	<R5,R1,R0>
	MRKT$S	,#1,#1,#TIME	;WAKE ME UP IN 1 TIC
	RTS	PC		;SO LONG, IT'S BEEN GOOD TO KNOW YOU
	.PAGE
; USE CALL TIMEIN(RAD50('NAME')) TO FORCE ALL FURTHER TICS TO BE RECORDED
; UNDER NAME.  CALL BEFORE DOING I/O.  RETURN TO NORMAL RECORDING WITH
; CALL TIMEIN                     (NO PARAMETERS)
; NOTE:  ----->  ASSUMES ARGUMENT IS ON EVEN BOUNDARY  <------
;
TIMEIN::
	TSTB	(R5)		;ANY PARAMETERS?
	BNE	10$		;YES - GO HANDLE
	CLR	ROUNAM		;GO TO NORMAL RECORDING CASE
				;ONLY ONE INSTRUCTION ON ROUNAM-NO NEED 
				;FOR CRITICAL REGION
	RTS	PC		;DONE
;
10$:	PUSH	R5		;JUST TO BE SAFE
	MOV	2(R5),R5	;GET ACTUAL ARGUEMENT ADDRESS IN R5
	MOV	(R5)+,ROUNAM	;PUT RAD50 ROUTINE NAME IN ROUNAM
	MOV	(R5),ROUNAM+2
	                        ;USING REALS AVOIDS A CRITICAL REGION ON ROUNAM
	POP	R5		;RESTORE
	RTS	PC		;DONE
	.PAGE
	.ENABLE LSB
;
;	ENTRY FROM NAM$ TO COUNT SUBROUTINE CALLS
;
$COUNT::
	.IF DF	MEAS		; DO COUNTING OF MEAS DEFINED
	TST	SFLAG		; EXIT IF NOT YET INITIALIZED
	BNE	2$
	RETURN
2$:	INC	CNTFLG		; SET TO COUNTING MODE
	BR	3$
	.IFF
	RETURN			;SIMPLY RETURN IF TIMING
	.ENDC
;
; ENTRY FOR CLOCK INTERRUPT
TIME:
	.IF DF	MEAS
	INC	TIMFLG		; SET TO TIMING MODE
	TST	CNTFLG		; CHECK IF COUNTING
	BNE 55$			; IF SO, JUST EXIT FROM INTERRUPT
	.ENDC
3$:	TST	NUMNAM
	BMI	60$		;TIMERX SETS NUMNAM=-1 TO STOP ME
	PUSH	<R0,R1,R2,R3>
	MOV	ROUNAM+2,R1
	MOV	ROUNAM,R0	;FIRST PART OF FORCED RECORDING ROUTINE NAME
	BNE	5$		;IF NON-ZERO, WE ARE IN FORCED RECORDING
	MOV	$NAMC,R2	;POINTER TO CURRENT ROUTINE NAME
	MOV	4(R2),R0	;FIRST HALF NAME
	MOV	4+2(R2),R1	;SECOND HALF NAME
5$:	MOV	#TABLE,R3	;ADDRESS OF NAMES TABLE
	MOV	NUMNAM,R2	;NUMBER OF ROUTINE IN TABLE
	BEQ	20$		;NONE THERE - JUMP
;
10$:	CMP	(R3)+,R0	;GOT 1ST HALF OF NAME?
	BNE	15$		;NOPE - LOOP
	CMP	(R3)+,R1	;GOT 2ND HALF OF NAME?
	BEQ	30$		;YES - BREAK
	BR	17$		;SKIP OVER BUMPING OF R3
15$:	TST	(R3)+		;SKIP OVER SECOND HALF
17$:	SOB	R2,10$		;AND GO CHECK NEXT NAME
;
20$:	CMP	NUMNAM,#TABSIZ/4 ;TOO MANY ROUTINES?
	BGE	50$		;YES - ADD NO MORE
	MOV	R0,(R3)+	;OFF THE END OF THE TABLE
	MOV	R1,(R3)+	;SAVE BOTH PARTS OF NAME AND THEN...
	ADD	#TABSIZ-4.,R3	;TO CORRESPONDING ENTRY IN COUNTS TABLE
	.IF DF	MEAS
	TST	TIMFLG		; TIMING?
	BEQ	21$		; NO, DON'T ADD TO TIME TABLE
	.ENDC
	CLR	(R3)		; ZERO THE COUNT
	CLR	2(R3)
	CALL	BUMP		; AND BUMP IT TO 1
	.IF DF	MEAS
21$:	TST	CNTFLG		; COUNTING CALLS?
	BEQ	22$		; NO, DON'T ADD TO CALLS TABLE
	ADD	#TABSIZ,R3	;TO CORRESPONDING ENTRY IN CALLS TABLE
	CLR	(R3)		; ZERO THE NUMBER OF CALLS
	CLR	2(R3)
	CALL	BUMP		; AND BUMP IT TO 1
	.ENDC
22$:	INC	NUMNAM		;NEW ROUTINE NAME SO BUMP COUNT
	BR	50$
;
; INCREMENT PREVIOUS COUNT IN TABLES
;
30$:	ADD	#TABSIZ-4,R3	;TO CORRESPONDING ENTRY IN COUNTS TABLE
	.IF DF	MEAS
	TST	TIMFLG		; TIMING?
	BEQ	31$		; NO, DON'T RECORD TIME
	.ENDC
	CALL	BUMP		; BUMP THE COUNT
	.IF DF	MEAS
31$:	TST	CNTFLG		; COUNTING?
	BEQ	50$		; NO, DON'T RECORD COUNTS
	ADD	#TABSIZ,R3	; TO CORRESPONDING ENTRY IN CALLS TABLE
	CALL	BUMP		; BUMP THE COUNT
50$:	TST	TIMFLG		; TIMING?
	BEQ	51$		; NO, DON'T BUMP THE TICS
	MOV	#TICS,R3	; TIMING, GET NUMBER OF PROBES COUNT
	CALL	BUMP
51$:	TST	CNTFLG		; COUNTING?
	BEQ	52$		; NO, DON'T BUMP CALLS
	MOV	#TCALLS,R3	; GET THE TOTAL NUMBER OF CALLS
	CALL	BUMP
	.IFF
50$:	MOV	#TICS,R3	; GET NUMBER OF PROBES COUNT
	CALL	BUMP
	.ENDC
52$:	POP	<R3,R2,R1,R0>
	.IF DF	MEAS
	TST	CNTFLG		; TIMING OR COUNTING?
	BEQ	53$		; TIMING
	CLR	CNTFLG
	CLR	TIMFLG
	RETURN			; SUBROUTINE RETURN FOR COUNTING
53$:	CLR	CNTFLG
	CLR	TIMFLG
	.ENDC
55$:	MRKT$S	,#1,#1,#TIME	;SEE YOU AGAIN SOON,
60$:	TST	(SP)+		;POP MRKT$S EVENT FLAG NUMBER
	ASTX$S			;BUT FOR NOW, GOOD BYE, AST RETURN FOR TIMING
;
; BUMP SUBROUTINE
;
;	BUMP THE COUNT IN THE DOUBLE INTEGER WHOSE ADDRESS IS IN R3
;
BUMP:	INC	(R3)		; INCREMENT LOW ORDER PART
	BNE	65$		; OVERFLOW?
	INC	2(R3)		; INCREMENT HIGH ORDER PART
65$:	RETURN
	.END