.TITLE TRACE- TRACES FORTRAN R0UTINES
	.IDENT /01.2/
;
;	THIS ROUTINE INTERACTS WITH THE FORTRAN TRACE PROTOCOL
;	TO PRODUCE A PRINTED TRACE OF THE TASK'S EXECUTION
;	TO EMPLOY THIS MODULE, SIMPLY EXPLICITLY INCLUDE IT IN THE TASK
;	BUILD FOR THE TASK TO BE TRACED.  THE FORTRAN COMPILATION
;	SHOULD HAVE BEEN DONE WITH THE OPTION "TR:BLOCKS" (THE DEFAULT)
;	OR "TR:NAMES" (FOR SLIGHTLY SMALLER OBJECT MODULES)
;	THIS ROUTINE USES LUN 4, WHICH MUST BE RESERVED FOR IT USE,
;	AND NOT OPENED ANYWHERE IN THE FORTRAN
;
;	NO ATTEMPT IS MADE TO PRESERVE THE USUAL
;	TRACEBACK CHAIN.
;
;	J.TRIPLETT  INTERMETRICS, INC.  11/79
;	701 concord avenue, cambridge, mass 02138
;	(617)-661-1840
;
;
	.NLIST BEX
	.MCALL	QIOW$,DIR$,GTIM$
	.PSECT	$PDATA RW,D,LCL,REL,CON
BMES:	.ASCIZ	/.%VSBEGIN %2R/
	.EVEN
EMES:	.ASCIZ	/.%VSEND  %2R %D:%D:%D/
	.EVEN
FORMT:	.BYTE	234,077,001,012		;FORMAT DESCRIPTOR
	.WORD 100			;FORTRAN ARRAY DESCRIPTOR BLOCK FOR I/O
ADB:	.WORD	BUF
	.WORD	BUF-1
	.WORD	4401
	.EVEN
;
	.PSECT	$IDATA RW,D,LCL,REL,CON
ODPB:	QIOW$	IO.WVB,4,1,,TIME,,<BUF,0,40>
TDPB:	GTIM$	BUF
	.EVEN
BUF:	.BLKB 64.			;OUTPUT BUFFER
INDENT:	.WORD	0			;EDMSG ARG BLOCK: #OF SPACES TO INDENT
NAME:	.BLKW 2				;ROUTINE NAME IN RAD50
TIME:	.BLKW 3				;PLACE FOR TIME 
	.BLKW	80.			;STACK ALLOWS NESTING TO 20 DEEP (4 WORDS PER CALL)
NSTK:	.RAD50	/XBOT../
NPTR:	.WORD NSTK
;
	.PAGE
	.PSECT	$CODE1 RW,I,LCL,REL,CON
NAM$::	MOV	(SP)+,NAME		;POP LAST HALF OF NAME
	MOV	(SP)+,NAME+2		;POP FIRST HALF OF NAME
	MOV	R0,-(SP)		;SAVE R0
	MOV	R1,-(SP)		;SAVE R1
	MOV	R2,-(SP)		;SAVE R2
	MOV	NPTR,R0			;PICK UP NAME STACK PTR
	MOV	NAME,-(R0)		;PUSH HALF OF NAME
	MOV	NAME+2,-(R0)		;PUSH OTHER HALF
	DIR$	#TDPB			;CHECK THE SYSTEM TIME
	MOV	BUF+8.,-(R0)		;PUSH CURRENT MINUTES
	MOVB	BUF+10.,-(R0)		;PUSH CURRENT SECONDS
	MOVB	BUF+12.,-(R0)		;PUSH CURRENT TICKS
	MOV	R0,NPTR			;SAVE NEW STACK PTR
	ADD	#2,INDENT		;INDENT 2 SPACES FOR EACH CALL
	MOV	#BMES,R1		;WANT BEGINNING OF MODULE MESSAGE
	CALL	PRINT			;PRINT OUT 
	MOV	(SP)+,R2		;RESTORE R2
	MOV	(SP)+,R1		;RESTORE R1
	MOV	(SP)+,R0		;RESTORE R0
;
	MOV	R4,-(SP)		;PUSH R4 FOR RETURN
	JSR	PC,@(SP)+		;COROUTINE SWAP
;
	.PAGE
;- - - - - - - - - - - - - - - - - - - - - - - - - -
;	RETURN FROM COROUTINE SWAP AT END OF CURRENT MODULE
;
;- - - - - - - - - - - - - - - - - - - - - - - - - -
	MOV	R0,-(SP)		;SAVE R0
	MOV	R1,-(SP)		;SAVE R1
	MOV	R2,-(SP)		;SAVE R2
	MOV	NPTR,R0			;PICK UP NAME STACK PTR
	MOVB	(R0)+,TIME+4		;POP START TICKS
	MOVB	(R0)+,TIME+2		;POP START SECONDS
	MOV	(R0)+,TIME		;POP START MINUTES
	MOV	(R0)+,NAME+2		;POP HALF OF NAME
	MOV	(R0)+,NAME		;POP SECOND HALF
	MOV	R0,NPTR			;STORE NEW NAME STACK PTR
	DIR$	#TDPB			;CHECK THE CLOCK
	SUB	TIME+4.,BUF+12.		;SUBTRACT START TICKS FROM FINISH TICKS
	BGE	10$			;IF .GT. 0, ITS SIMPLE
	ADD	#60.,BUF+12.		;OTHERWISE, ADJUST FOR BACK TO POSITIVE TIME
	SUB	#1,BUF+10.
10$:	SUB	TIME+2,BUF+10.		;SUBTRACT START SECONDS FROM FINISH SECONDS
	BGE	20$			;AGAIN CHECK FOR UNDERFLOW
	ADD	#60.,BUF+10.		;ADJUST BACK TO POSITIVE
	SUB	#1,BUF+8.
20$:	SUB	TIME,BUF+8.		;SUBTRACT START MINS FROM STOP MINS
	MOV	BUF+8.,TIME			;STASH IT FOR PRINTING
	MOV	BUF+10.,TIME+2	
	MOV	BUF+12.,TIME+4
	MOV	#EMES,R1		;PRINT OUT END OF MODULE MESSAGE
	CALL	PRINT			;PRINT MESSAGE 
	MOV	(SP)+,R2		;RESTORE R2
	MOV	(SP)+,R1		;RESTORE R1
	MOV	(SP)+,R0		;RESTORE R0
	SUB	#2,INDENT		;AFTER EXIT, SHIFT INDENT LEFT 2 SPACES

;
	RTS	PC			;RETURN TO PREVIOUS CALLING MODULE
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
;
;	PRINT : SPIT OUT MESSAGE 
;
;	ASSUMES R1 CONTAINS ADD OF EDMSG FOMAT DESCRIPTOR
;
PRINT:	MOV	#BUF,R0			;OUTPUT BUFFER FOR EDMSG
	MOV	#INDENT,R2		;VARIABLES FOR $EDMSG
	CALL	$EDMSG			;FORMAT THE OUTPUT
	MOV	R1,ADB-2		;STORE OUTPUT LENGTH
	MOV	#4,-(SP)		;OUTPUT ON LUN 4
	MOV	#FORMT,-(SP)		;POINTER TO FORMAT DESCRIPTOR
	CALL	OSF$			;UNFORMATTED SEQ OUTPUT
	MOV	#ADB,-(SP)		;ARRAY DESCRIPTOR BLOCK FOR BUF
	CALL	IOAA$			;PUSH IT OUT
	CALL	EOLST$			;I/O TERMINATION
	RETURN
  
	.END