.TITLE	TSTROT - Test Directive Rates
	.IDENT	/V01.00/
	.ENABL	LC
;
; Macro Library Calls:
;
	.MCALL	FSRSZ$,GCML$,GCMLB$	;Get command line
	.MCALL	TRAN$,STATE$,ISTAT$	;Finite state parse
	.MCALL	QIOW$S,GTIM$S,EXIT$S	;Exit task
	.MCALL	PRGWRN,DIRWRN		;Handle errors
;
; Read-Only Definitions.
;
	.PSECT	ROT$RO,RO,D,LCL,REL,CON

CM.LUN	== 1				;Command input lun
TI.LUN	== 2				;Terminal output lun
XX.LUN	== 3				;Directive test lun

EF.LCL	== 1.				;Local  event flag
EF.GBL	== 33.				;Global event flag
EF.TSK	== 34.				;Global event flag (task sync)
EF.GRP	== 65.				;Group  event flag

T.NAME	= 0				;Test name
T.INIT	= 2				;Test initiator
T.CODE	= 4				;Test routine
T.DONE	= 6				;Test completion
T.LGTH	= 10				;Test table length

	.NLIST	BEX
ER.CMD:	.ASCIZ	#Invalid command line, use "name\iterations"#
ER.NAM:	.ASCIZ	#Unknown directive test name#
ER.TST:	.ASCIZ	#Directive cannot be tested#
ER.INI:	.ASCIZ	#Test initiation failed#
ER.COD:	.ASCIZ	#Test iteration  failed#
ER.DON:	.ASCIZ	#Test completion failed#

ARGFMT:	.ASCII	#%N%I#
	.ASCIZ	#%N  Results: %T loops in %5Z for %T.%2A test/sec (0.%5A/sec)%N#
ERRFMT:	.ASCIZ	#%2NTest error - %I%N#

	.EVEN
	.LIST	BEX
;
; Read-Write Definitions.
;
	.PSECT	ROT$RW,RW,D,LCL,REL,CON

ARGBLK:	.WORD	0			;Pointer to test name
	.WORD	LOOPS			;Pointer to loop count
	.BLKW	5			;Elapse wall-clock test time
	.WORD	FREQI			;Pointer to test/sec integer
	.WORD	FREQF			;Pointer to test/sec fraction
	.WORD	RATEF			;Pointer to sec/test fraction

BEGTIM:	.BLKW	8.			;Starting time
ENDTIM:	.BLKW	8.			;Ending time

NAME:	.WORD	0,0			;Test name length, address
COUNT:	.WORD	0,0			;Iteration count (hi,low)
LOOPS:	.WORD	0,0			;Iteration count (hi,low)

FREQI:	.BLKW	2			;Double-precesion integer
FREQF:	.BLKB	2			;2-digit fraction
RATEF:	.BLKB	6			;6-digit fraction
TSTSTR:	.BLKB	132.			;Test string

GCLBLK:	GCMLB$	2,TST,,CM.LUN,,		;Declare command line buffer
	FSRSZ$	1			;Declare FCS area
;
; Define parsing tables for command.
;
	ISTAT$	TSTTRN,TSTKEY

	STATE$	TSTBEG			;Parse the command name
	TRAN$	!CMDS,,PRSNAM

	STATE$				;Parse the number of loops
	TRAN$	$DNUMB,,PRSCNT

	STATE$				;All done with parse
	TRAN$	$EOS,$EXIT
;
; Parse command name.
;
	STATE$	CMDS			;Parse command string
	TRAN$	<'\>,$EXIT
	TRAN$	$ANY,CMDS

	STATE$
;
; Define parsing action routines.
;
	.PSECT	ROT$CD,RO,I,LCL,REL,CON

PRSNAM:	MOV	.PSTPT,NAME+2		;Store address of name
	MOV	.PSTCN,NAME+0		;Store length  of name
	DEC	NAME+0			;Account for slash
	RETURN				;Return to caller

PRSCNT:	MOV	.PNUMH,LOOPS+0		;Store high count
	MOV	.PNUMB,LOOPS+2		;Store low  count
	MOV	.PNUMH,COUNT+0		;Store high count
	MOV	.PNUMB,COUNT+2		;Store low  count
	RETURN				;Return to caller

;+
; The TST program measures the exection time for a variety of RSX system
; directives and features. The mainline code inputs a test name and loop
; count from the user and sets up to execute the test.
;-

TST::					;Ref. label
;
; Get next command line from user or command file. Exit if any error.
;
1000$:	MOV	#GCLBLK,R0		;Get command line buffer
	GCML$	R0			;Input command line
	BCC	1100$			; If CC - command input
	EXIT$S				;Exit program
;
; Parse out the test name and loop count. Both must always be present.
;
1100$:	TST	G.CMLD+0(R0)		;Is this null input
	BEQ	1000$			; If EQ - yes, loop

	CLR	R1			;No special flags
	MOV	#TSTKEY,R2		;Get keyword table
	MOV	G.CMLD+0(R0),R3		;Get length  of command
	MOV	G.CMLD+2(R0),R4		;Get address of command
	MOV	#TSTBEG,R5		;Get starting state
	CALL	.TPARS			;Parse the command
	BCC	2000$			; If CC - valid command
	PRGWRN	#ER.CMD,1000$		;Output error message and loop
;
; Scan the test table for a match on the name.
;
2000$:	MOV	#TSTTBL,R0		;Get start of table
2100$:	ADD	#T.LGTH,R0		;Advance to next entry
	MOV	T.NAME(R0),R1		;Is this end of table
	BNE	2200$			; If NE - no, continue
	PRGWRN	#ER.NAM,1000$		;Output error message and loop

2200$:	MOV	NAME+2,R2		;Get address of name
	MOV	NAME+0,R3		;Get length  of name
2300$:	MOVB	(R1)+,-(SP)		;Get character
	CMPB	#'A,(SP)		;Is this upper case?
	BHI	2301$			; If HI - no, skip
	CMPB	#'Z,(SP)		;Is this upper case?
	BLO	2301$			; If LO - no, skip
	ADD	#40,(SP)		;Convert to lower case
2301$:	MOVB	(R2)+,-(SP)		;Get character
	CMPB	#'A,(SP)		;Is this upper case?
	BHI	2302$			; If HI - no, skip
	CMPB	#'Z,(SP)		;Is this upper case?
	BLO	2302$			; If LO - no, skip
	ADD	#40,(SP)		;Convert to lower case
2302$:	CMPB	(SP)+,(SP)+		;Are characters equal?
	BNE	2100$			; If EQ - no, loop
	DEC	R3			;Have we check entire name
	BNE	2300$			; If NE - check all characters	
;
; Check for no test or reference to another test. If reference, set
; correct name and restart scan.
;
	TST	T.CODE(R0)		;Is there a test
	BNE	3000$			; If NE - yes, continue
	PRGWRN	#ER.TST,1000$		;Output error message and loop
;
; Test the chosen directive.
;
3000$:	MOV	T.INIT(R0),R1		;Get the initial code
	BEQ	3100$			; If EQ - no inital code
	CALL	(R1)			;Execute initial code
	BCC	3100$			; If CC - test setup
	DIRWRN				;Output directive error
	PRGWRN	#ER.INI,1000$		;Output error message and loop

3100$:	GTIM$S	#BEGTIM			;Get starting time
	MOV	T.CODE(R0),R1		;Get the test code
3110$:	DEC	COUNT+2			;Count a loop
	BNE	3120$			; If NE - execute test
	DEC	COUNT+0			;Count a loop
	BMI	3200$			; If MI - all done
3120$:	CALL	(R1)			;Execute test code
	BCC	3110$			; If CC - loop again
	DIRWRN				;Output directive error
	PRGWRN	#ER.COD,1000$		;Output error message and loop

3200$:	GTIM$S	#ENDTIM			;Get final time
	MOV	T.DONE(R0),R1		;Get the done code
	BEQ	4000$			; If EQ - no done code
	CALL	(R1)			;Execute done code
	BCC	4000$			; If CC - done complete
	DIRWRN				;Output directive error
	PRGWRN	#ER.DON			;Output error message and continue
;
; Compute and output the test results.
;
4000$:	MOV	(R0),ARGBLK+0		;Save test name address
	MOV	#ENDTIM,R5		;Get the end time
	MOV	#BEGTIM,R4		;Get the start time
;
; Get the elapse time (assume time does not exceed 24 hours).
;
	SUB	G.TICT(R4),G.TICT(R5)	;Get number of tics
	BGE	4101$			; If GE - no carry
	ADD	G.TICP(R5),G.TICT(R5)	;Adjust for tic carry
	DEC	G.TISC(R5)		; ...

4101$:	SUB	G.TISC(R4),G.TISC(R5)	;Get number of seconds
	BGE	4102$			; If GE - no carry
	ADD	#60.,G.TISC(R5)		;Adjust for carry
	DEC	G.TIMI(R5)		; ...

4102$:	SUB	G.TIMI(R4),G.TIMI(R5)	;Get number of minutes
	BGE	4103$			; If GE - no carry
	ADD	#60.,G.TIMI(R5)		;Adjust for carry
	DEC	G.TIHR(R5)		; ...

4103$:	SUB	G.TIHR(R4),G.TIHR(R5)	;Get number of hours
	BGE	4104$			; If GE - no carry
	ADD	#24.,G.TIHR(R5)		;Adjust for carry

4104$:	MOV	G.TIHR(R5),ARGBLK+4	;Store elapse time
	MOV	G.TIMI(R5),ARGBLK+6	; ...
	MOV	G.TISC(R5),ARGBLK+10	; ...
	MOV	G.TICT(R5),ARGBLK+12	; ...
	MOV	G.TICP(R5),ARGBLK+14	; ...
;
; Get elapse time in number of tics.
;
	MOV	#60.,R0			;Get minutes/hour
	MOV	G.TIHR(R5),R1		;Get number of hours
	CALL	$MUL			;Get number of minutes
	ADD	G.TIMI(R5),R1		; ...
	ADC	R0			; ...

	MOV	R0,R2			;Copy number of minutes
	MOV	R1,R3			; ...
	MOV	#60.,R0			;Get seconds/minute
	CALL	$DMUL			;Get number of seconds
	ADD	G.TISC(R5),R1		; ...
	ADC	R0			; ...

	MOV	R0,R2			;Copy number of seconds
	MOV	R1,R3			; ...
	MOV	G.TICP(R5),R0		;Get tics/second
	CALL	$DMUL			;Get number of tics
	ADD	G.TICT(R5),R1		; ...
	ADC	R0			; ...
;
; The rest of this algorithm requires the tic count to less than 32767.
; Scale the tics and loop count down as needed.
;
	MOV	LOOPS+0,R2		;Get loop count
	MOV	LOOPS+2,R3		; ...
4200$:	TST	R0			;Is elapse time too large
	BNE	4210$			; If NE - yes, scale down
	TST	R1			;Is elapse time too large
	BPL	4300$			; If PL - no, continue

4210$:	ASR	R0			;Divide tics  by 2
	ROR	R1			; ...
	ASR	R2			;Divide loops by 2
	ROR	R3			; ...
	BR	4200$			;Recheck tic value
;
; Make sure we have at least one tic gone elapse and compute loops/second.
;
4300$:	MOV	R1,R0			;Did any time elapse
	BNE	4310$			; If NE - yes, skip
	INC	R0			;Set at least one tic

4310$:	MOV	R0,-(SP)		;Save the time (tics)
	MOV	R2,R1			;Get loop count
	MOV	R3,R2			; ...
	CALL	$DDIV			;Get loops/tic
	MOV	R0,-(SP)		;Save the remainder
	MOV	R2,R3			;Copy the result
	MOV	R1,R2			; ...
	MOV	G.TICP(R5),R0		;Get the tics/second
	CALL	$DMUL			;Get loops/sec
	MOV	R0,FREQI+0		;Store results
	MOV	R1,FREQI+2		; ...

	MOV	G.TICP(R5),R0		;Get the tics/second
	MOV	(SP)+,R1	 	;Get previous remainder
	CALL	$MUL			;Get the loops/tics/second
	MOV	R1,R2			;Copy the results
	MOV	R0,R1			; ...
	MOV	(SP),R0			;Get the tics
	CALL	$DDIV			;Get the loops/second
	ADD	R2,FREQI+2		;Add to previous results
	ADC	FREQI+0			; ...
	ADD	R1,FREQI+0		; ...

	MOV	#100.,R1		;Get 2-digit fractional part
	CALL	$MUL			; ...
	MOV	R1,R2			;Copy the results
	MOV	R0,R1			; ...
	MOV	(SP)+,R0		;Get the tics
	CALL	$DDIV			;Get the fractional loops/second
	MOV	#FREQF,R0		;Get output address
	MOV	R2,R1			;Get fractional part
	MOV	#<<2*4000>!1000!10.>,R2	;Set conversion (2 places, zero-fill)
	CALL	$CBTA			;Convert fractional part
;
; Compute seconds/loop to 5 places.
;
	MOV	#1000.,R0		;Compute 100,000
	MOV	#100.,R1		; ...
	CALL	$MUL			; ...

	MOV	FREQI+0,R2		;Get test/second
	MOV	FREQI+2,R3		; ...
4400$:	TST	R2			;Is elapse time too large
	BNE	4410$			; If NE - yes, scale down
	TST	R3			;Is elapse time too large
	BPL	4500$			; If PL - no, continue

4410$:	ASR	R0			;Divide 100,000 by 2
	ROR	R1			; ...
	ASR	R2			;Divide test/second by 2
	ROR	R3			; ...
	BR	4400$			;Recheck tic value

4500$:	MOV	R1,R2			;Copy 100,000
	MOV	R0,R1			; ...
	MOV	R3,R0			;Copy test/sec
	CALL	$DDIV			;Get sec/test
	MOV	#RATEF,R0		;Get output address
	MOV	R2,R1			;Get fractional part
	MOV	#<<5*4000>!1000!10.>,R2	;Set conversion (5 places, zero-fill)
	CALL	$CBTA			;Convert fractional part
;
; Format and output the test results.
;
	MOV	#TSTSTR,R0		;Get output string
	MOV	#ARGFMT,R1		;Get format string
	MOV	#ARGBLK,R2		;Get argument block
	CALL	$EDMSG			;Format string
	QIOW$S	#IO.WVB,#TI.LUN,#EF.LCL,,,,<#TSTSTR,R1,#0>
	JMP	1000$			;Loop for next command.

	.END	TST