.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 #,-(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 #,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,# ;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 ; .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