	.title profiler
	.ident	/840105/
;
;This code handles the profiling of an NBS Pascal program. The profiler
;initialisation and termination code should be called immediately after
;startup and immediately before executing the main program. The
;procedure entry and exit code should be called immediately after entry
;to and immediately before exit from the relevant procedure.
;One IO channel is used.
;
	.mcall	.writw,.gtim
	.globl	fb.buf,fb.chn
	.globl	v.area
	.globl	p.gtln
	.globl	pr.ini, pr.trm
	.globl	$$$004,$$$016,$$$017,$$$020
;
; Definitions of the profile record.
;
flgwrd	= 052525			;header flag word
namsiz	= 16.				;maximum size of name section
ftcsiz	= 8.				;size of flag word, time and count part
;
	.psect
;
$$$998::
init:	mov	r2,-(sp)		;allocate space for filename
	sub	#82.,sp
	mov	sp,r2
	mov	#prompt,-(sp)
	mov	r2,-(sp)
	jsr	pc,p.gtln		;get filename
;
	mov	#<fb.buf+2>,-(sp)	;allocate space in heap
	jsr	pc,$$$004
	mov	(sp),filbuf
;
	mov	(sp),-(sp)		;initialise file space
	mov	#18.,-(sp)
	jsr	pc,$$$016
;
	mov	r2,-(sp)		;open file for output
	mov	#defext,-(sp)
	mov	#1,-(sp)
	mov	#2,-(sp)
	jsr	pc,$$$017
;
1$:	add	#82.,sp			;return
	mov	(sp)+,r2
	clr	pr.ini			;once only
	trap	2			;set up count for total time
	.word	protim
	rts	pc
;
entry:	jsr	pc,timset		;set up time
	cmp	(r1),#flgwrd		;ensure call is not recursive
	beq	1$
	add	#5,r1			;increment call count only
	br	2$
1$:	mov	sp,(r1)+		;save for later verification
	mov	r2,-(sp)		;save temporary
	sub	time+2,(r1)+		;do timer calculation
	movb	(r1),r2
	sbc	r2
	sub	time,r2
	movb	r2,(r1)+
	mov	(sp)+,r2
2$:	add	#1,1(r1)		;adjust count
	adcb	(r1)
	bcc	3$
	decb	(r1)+			;overflow
	dec	(r1)
3$:	rts	pc
;
exit:	jsr	pc,timset		;set up time
	cmp	sp,(r1)			;ensure we have the right caller
	bne	1$
	mov	#flgwrd,(r1)+		;reset flag
	mov	r2,-(sp)
	add	time+2,(r1)+		;do timer calculation
	movb	(r1),r2
	adc	r2
	add	time,r2
	movb	r2,(r1)
	mov	(sp)+,r2
1$:	rts	pc
;
timset:	mov	r0,r1			;get current time
	.gtim	#timspc,code=noset
	mov	r1,r0
	mov	(r0)+,r1
	rts	pc
;
term:	trap	3			;complete count for total time
	.word	protim
	mov	#protim,r2		;use this as a starting point
	mov	r2,r4			;yes, prepare for data scan
;
1$:	mov	r2,r5			;scan backwards, remember last valid
	mov	#<namsiz/2>,r0		;maximum length of name in words
2$:	mov	-(r2),r1		;find beginning of name
	cmpb	r1,#namsiz		;name between one and fifteen in length
	blo	3$
	sob	r0,2$
	br	5$
3$:	movb	r1,r1			;only want low byte
	beq	5$			;zero not valid
	asr	r1			;add two, round down to nearest even
	add	r0,r1			;leave as number of words
	cmp	r1,#<namsiz/2>		;see if ok
	bne	5$
4$:	sub	#ftcsiz,r2		;retreat to flag word
	cmp	(r2),#flgwrd		;check flag word
	beq	1$
;
5$:	add	#ftcsiz,r4		;scan forwards, remember first invalid
	movb	(r4),r0			;length of name
	asr	r0			;add one and round up to nearest even
	inc	r0
	asl	r0
	add	r0,r4
	cmp	(r4),#flgwrd		;check flag word
	beq	5$			;ok, try next
;
6$:	mov	filbuf,r3
	sub	r5,r4
	asr	r4
	.writw	#v.area,fb.chn(r3),r5,r4,#0
	bcs	8$
	mov	r3,-(sp)
	jsr	pc,$$$020
7$:	clr	pr.trm			;once only
	rts	pc
;
8$:	fatal	<Profile write error>
;
	.psect	$trap,gbl,ovr
	.blkw	1			;heap utilisation
	.word	init			;profiler initialisation
	.word	term			;profiler termination
	.blkw	1			;procedure entry 
	.blkw	1			;procedure exit
	.word	entry			;profiler procedure entry
	.word	exit			;profiler procedure exit
;
	.psect	$prof,gbl,con
protim:	.word	flgwrd
	.word	0,0,0
	.byte	1,0
;
	.psect	$msg
prompt:	.asciz	/Profile : /
defext:	.asciz	/TIM/
;
	.psect	$varbl
filbuf:	.word	0
time:	.word	0,0
timspc:	.word	<21*400+0>,time
;
	.end
