.TITLE TMR - TIME TASKS .IDENT -010000- .ENABL LC ;+ ; Abstract: TMR ; ; This task can time tasks which were not built with any ; timer facilities. It maps into the task's header and ; notes the PC every few ticks. ; ; Operating procedures: ; ; This task must be run as an MCR function task. The ; command line is of the form: ; ; MCR>TMR ; ; PDS> TMR ; ; where is the command line needed ; to run the task ordinarily. I. E., ; ; MCR>TMR PIP /FR ; ; will time the PIP /FR function. The results are printed ; on CL0:. Note that the "RUN" command is currently not ; supported, so that this module will time "RUN" rather ; than the user task. The program does support both ; the ... and the $$$ forms of system tasks. ; ; ; ; Written: 08-Feb-80, -1.0.0-, Bruce C. Wright ; Modified: ; Verified: ;- .MCALL GMCR$,DIR$,QIOW$,MRKT$,SPWN$ .MCALL EXST$S,WTSE$S,ASTX$S,SETF$S .MCALL OPEN$W,PUT$,CLOSE$ .MCALL FSRSZ$,FDBDF$ .MCALL FDAT$A,FDRC$A,FDOP$A,FDBF$A .MACRO ERROR ARG JSR R0,$ERROR .ASCIZ "ARG" .EVEN .ENDM .MACRO JCS ARG BCC .+6 JMP ARG .ENDM ; TMR:: DIR$ #GMCR ; Get the MCR command line. BCC 10$ ; OK? ERROR 10$: MOV #GMCR+G.MCRB,R4 ; Point to the command line. MOV @#$DSW,R1 ; Get length of line. BEQ 17$ ; No length in line? 15$: CMPB #' ,(R4)+ ; Scan for the first blank. BEQ 20$ ; Got it. SOB R1,15$ ; And count over command. 17$: ERROR 20$: DEC R4 ; Point back at the blank. 22$: CMPB #' ,(R4)+ ; Look for the first non-blank. BNE 24$ ; Got it SOB R1,22$ ; And loop over command. BR 17$ ; Error? 24$: DEC R4 ; Backup to the first non-blank. MOV R4,R2 ; Addr into R2 MOV #CMDLIN,R0 ; Point to the command line. MOV R1,SPWN+S.PWCL ; Put length into SPWN$ macro call 30$: CMPB (R2),#'A+40 ; Is it above lower case A? BLO 31$ ; no CMPB (R2),#'Z+40 ; Is it lower case? BHI 31$ ; No BICB #40,(R2) ; Make it upper case for $CAT5 31$: MOVB (R2)+,(R0)+ ; Output the character to the SPWN line. SOB R1,30$ ; And loop. MOV R4,R0 ; Point to the start of the string. MOV #^RAT.,R1 ; Assume that this is ...AT. CMPB (R0),#'@ ; Is the first character an @? BEQ 32$ ; Yes -- no RAD50. CALL $CAT5 ; Convert first chars to Radix-50 32$: MOV #MFTFNS,R2 ; Get the MFT functions. MOV #MFTNUM,R0 ; And their number. 33$: CMP R1,(R2)+ ; Is this one of them? BEQ 34$ ; Yes -- fix it. SOB R0,33$ ; Loop over MFT functions. BR 35$ ; Skip MFT move. 34$: MOV #^RMFT,R1 ; Get ...MFT request. 35$: MOV R1,SPWN+S.PWTN+2 ; Save task in SPWN DPB. MOV #^R...,SPWN+S.PWTN ; Save first part of task name. MOV #SPWN,-(SP) ; DPB to stack CALL .DIRDL ; Do the directive. BCS 60$ ; Error? JMP MAINLN ; No, just continue normally. 60$: CMP @#$DSW,#IE.INS ; Is it task not installed? BNE 100$ ; No -- decode the error. MOV #^R$$$,SPWN+S.PWTN ; Set the task name. MOV #SPWN,-(SP) ; DPB to stack again. CALL .DIRDL ; Do the directive. BCS 100$ ; Analyse error if any. JMP MAINLN ; And go to main line code. 100$: CMP #IE.UPN,@#$DSW ; Insufficient pool? BNE 102$ ; No ERROR 102$: CMP #IE.INS,@#$DSW ; Task not installed? BNE 103$ ; No ERROR 103$: CMP #IE.PTS,@#$DSW ; Partition too small? BNE 106$ ; No ERROR 106$: CMP #IE.HWR,@#$DSW ; Handler not resident? BNE 107$ ; No ERROR 107$: CMP #IE.ACT,@#$DSW ; Task already active? BNE 108$ ; No ERROR 108$: CMP #IE.ITS,@#$DSW ; Task disabled? BNE 180$ ; No ERROR 180$: CMP #IE.AST,@#$DSW ; Issued by background task? BNE 191$ ; No ERROR 191$: CMP #IE.IUI,@#$DSW ; Invalid UIC? BNE 194$ ; No ERROR 194$: CMP #IE.PNS,@#$DSW ; Partition not in system? BNE 195$ ; No ERROR 195$: CMP #IE.IPR,@#$DSW ; Invalid priority? BNE 198$ ; No ERROR 198$: ERROR ; ; main line code ; MAINLN: MOV #MRKT,-(SP) ; Mark time block to stack. CALL .DIRDL ; Do the request. WTSE$S #1 ; Wait for the task to complete. OPEN$W #OUTFDB ; Open the FDB JCS FILERR ; Error? PUT$ R0,#HDRMSG,#HDRLEN ; Output the header message JCS FILERR ; Error? PUT$ R0,#CMDLIN,SPWN+S.PWCL ; Output the command line. JCS FILERR ; Error? PUT$ R0,#HDRMSG,#0 ; Output a blank line. JCS FILERR ; Error? MOV #BUFFER,R2 ; Point to the output buffer. MOV #FINMSG,R1 ; Get termination message. 1$: MOVB (R1)+,(R2)+ ; Output the termination message. BNE 1$ ; ... DEC R2 ; Backup over the 0 MOV ESB,R1 ; Get termination code ASL R1 ; Convert to a word offset. MOV FINERR(R1),R1 ; Get the buffer describing it 2$: MOVB (R1)+,(R2)+ ; Output it. BNE 2$ ; ... DEC R2 ; Back up over 0 SUB #BUFFER,R2 ; Compute length of buffer. PUT$ R0,#BUFFER,R2 ; Output the termination code. JCS FILERR ; Error? PUT$ R0,#HDRMSG,#0 ; Output a blank line. JCS FILERR ; Error? PUT$ R0,#COLMSG,#COLLEN ; Output the columns message JCS FILERR ; Error? MOV #TMRBUF,R4 ; Point to timer buffer. MOV #TMRLEN,R5 ; Get length of timer buffer. MOV #BUFFER,R0 ; Point to the output buffer. MOV #3,R3 ; Put counter of elements per line. CLR SUM ; Clear high order sum CLR SUM+2 ; And low order. 10$: TST (R4)+ ; Anything in this buffer? BEQ 60$ ; No, just get next element. MOV R4,R1 ; Get offset into R1 SUB #TMRBUF+2,R1 ; Compute actual offset in task. ASH #5.,R1 ; Shift appropriately. MOV #1,R2 ; Show no zero suppression MOV R1,-(SP) ; Save for a bit. CALL $CBOMG ; Convert task address. MOVB #'-,(R0)+ ; Output a - MOV (SP)+,R1 ; Recover task address ADD #77,R1 ; Show top task address MOV #1,R2 ; Show no zero suppression. CALL $CBOMG ; Convert task address MOV -2(R4),R1 ; Get the number of interrupts here ADD R1,SUM+2 ; Add into the sum ADC SUM ; And high order. MOVB #'=,(R0)+ ; Output an = MOVB #' ,(R0)+ ; Output a < > CLR R2 ; Show zero suppression CALL $CBDMG ; Output the number of interrupts MOVB #'.,(R0)+ ; Output a . MOVB #' ,(R0)+ ; And a DEC R3 ; Decrement count of elements per line BGT 60$ ; Skip if still more. SUB #BUFFER,R0 ; compute length of buffer. MOV R0,R1 ; Length into R1 PUT$ #OUTFDB,#BUFFER,R1 ; Print the line. BCS FILERR ; Error? MOV #BUFFER,R0 ; Set up the line again. MOV #3,R3 ; ... 60$: SOB R5,10$ ; And loop over the timer buffer. CMP R3,#3 ; Is anything left in buffer? BEQ 70$ ; No - skip MOV R0,R1 ; Get buffer pointer. SUB #BUFFER,R1 ; Compute length. PUT$ #OUTFDB,#BUFFER,R1 ; Print the buffer. BCS FILERR ; Error? 70$: PUT$ #OUTFDB,#BUFFER,#0 ; Output a blank line. BCS FILERR ; Error? MOV #TOTBUF,R0 ; Get address of total interrupts msg MOV #SUM,R1 ; Get sum address CLR R2 ; Suppress leading 0's CALL $CDDMG ; Convert to double precision. SUB #TOTMSG,R0 ; Compute length of message MOV R0,R1 ; Into R1 PUT$ #OUTFDB,#TOTMSG,R1 ; Print the buffer. BCS FILERR ; Error? CLOSE$ #OUTFDB ; Close the FDB EXST$S #EX$SUC ; And exit. FILERR: CALL .PRFCS ; Print the FCS error code. CLOSE$ #OUTFDB ; Close the FDB EXST$S #EX$ERR ; And exit. ; ; Mark time is done. Get the status of the task if any. ; MKTAST: MOV R5,-(SP) ; Save registers MOV R4,-(SP) ; MOV R3,-(SP) ; MOV @#PS.EXP,-(SP) ; Save PS BIS #140,@#PS.EXP ;;; Set so no task switch. MOV .CRTSK,R5 ;;; Get our ATL node. CLR R4 ;;; Assume no Mark Time. BIT #1,A.EF(R5) ;;; Is the spawned task done? BNE 90$ ;;; Yes - just exit. MOV ATLNOD,R4 ;;; Get ATL node of daughtor BNE 50$ ;;; Skip if found. MOV #.ATLLH,R4 ;;; Get the ATL listhead. 10$: MOV (R4),R4 ;;; Get to next item in list. CMP R4,#.ATLLH ;;; To end of list? BEQ 90$ ;;; Yes - not yet on ATL. CMP A.TI(R4),A.TI(R5) ;;; Devices match? BNE 10$ ;;; No - next entry. MOV A.TD(R4),R3 ;;; Get the STD entry. CMP S.TN(R3),SPWN+S.PWTN ;;; Task name match? BNE 10$ ;;; No CMP S.TN+2(R3),SPWN+S.PWTN+2 ;;; Well? BNE 10$ ;;; No MOV R4,ATLNOD ;;; Remember this node for later. 50$: CMPB A.TS(R4),#TS.RUN ;;; Is the task running? BNE 90$ ;;; No - just ignore it. BIT #AF.CP,A.TF(R4) ;;; Is the task checkpointed? BNE 90$ ;;; Yes - just ignore it. BIT #AF.IA,A.TF(R4) ;;; Is it controled by timesharing? BEQ 60$ ;;; No BIT #AT.TR,A.TFW(R4) ;;; Is it resident? BEQ 90$ ;;; No CMPB A.TST(R4),#JS.RUN ;;; Is it selected for exec? BNE 90$ ;;; No, just ignore this time. 60$: MOV #77406,-(SP) ;;; PDR to stack. MOV A.HA(R4),-(SP) ;;; PAR to stack. CALL @#..SPD3 ;;; swap APR3. MOV @#H.TPC+60000,R3 ;;; Get the task program counter. ASH #-5.,R3 ;;; Shift it over appropriately. BIC #174001,R3 ;;; Clean program counter. INC TMRBUF(R3) ;;; Increment appropriate buffer. CALL @#..SPD3 ;;; Recover our old APR3 CMP (SP)+,(SP)+ ;;; discard task's APR3 90$: CALL @#..ENB0 ;;; Re-enable context switching. TST R4 ; Re-instate Mark Time? BEQ 99$ ; No, just exit. MOV #MRKT,-(SP) ; Mark time to stack. CALL .DIRDL ; Do the request. 99$: MOV (SP)+,R3 ; Recover registers MOV (SP)+,R4 ; MOV (SP)+,R5 ; TST (SP)+ ; Discard a word from stack. ASTX$S ; And return to the AST. ; ; subroutines ; $ERROR: MOV R0,QIO+Q.IOPL ; Set QIO buffer address. 10$: TSTB (R0)+ ; Find end of string. BNE 10$ ; loop. SUB QIO+Q.IOPL,R0 ; Compute length of string. MOV R0,QIO+Q.IOPL+2 ; Set length into QIO block. MOV #QIO,-(SP) ; DPB to stack. CALL .DIRDL ; Output the message. EXST$S #EX$ERR ; Exit with error. ; ; DATA AREA ; FSRSZ$ 2 ; Set FSR size GMCR: GMCR$ ; GMCR block SPWN: SPWN$ ...MCR,,100,0,0,1,,ESB,CMDLIN,0 QIO: QIOW$ IO.WVB,5,5,,,,<0,0,40> MRKT: MRKT$ 0,1,1,MKTAST ; Mark time AST MFTFNS: .RAD50 /ABORESALTCANDISENAFIXUNF/ ; MFT functions MFTNUM = <.-MFTFNS>/2 ; Number of MFT functions ATLNOD: .WORD 0 ; Address of daughtor's ATL node. ESB: .BLKW 8. ; Exit status block CMDLIN: .BLKB 80. ; Command line buffer. FINERR: .WORD WARNING ; Warning message .WORD SUCCESS ; Success message .WORD ERROR ; Error message .WORD E3 ; ** undefined ** .WORD SEVERE ; Severe error message .WORD E5 ; ** undefined ** .WORD E6 ; ** undefined ** .WORD E7 ; ** undefined ** TOTMSG: .ASCII "Total number of interrupts: " TOTBUF: BUFFER: .BLKB 80. ; Output buffer. HDRMSG: .ASCII "Timing statistics for the following command line:" HDRLEN = .-HDRMSG ; Length of header message FINMSG: .ASCIZ "Exit status: " WARNING:.ASCIZ "Warning" SUCCESS:.ASCIZ "Success" ERROR: .ASCIZ "Error" E3: .ASCIZ "3" SEVERE: .ASCIZ "Severe error" E5: .ASCIZ "E5" E6: .ASCIZ "E6" E7: .ASCIZ "E7" COLMSG: .ASCII " Addr range Interrupts" .ASCII " Addr range Interrupts" .ASCII " Addr range Interrupts" COLLEN = .-COLMSG .EVEN SUM: .WORD 0,0 ; Sum of interrupts. TMRBUF: .BLKW 2000 ; Timer status buffer TMRLEN = <.-TMRBUF>/2 ; Set timer buffer length OUTFDB: FDBDF$ FDAT$A R.VAR,FD.CR,80. ; Record type, carriage control, length FDRC$A ; Use GET$/PUT$ for file FDOP$A 2,DSPT ; LUN and dataset descriptor FDBF$A 2,,2 ; EFN and multi-buffer count DSPT: .WORD DEVLEN ; Device name length .WORD DEVSTR ; Device name string .WORD DIRLEN ; Directory length .WORD DIRSTR ; Directory string .WORD NAMLEN ; File name length .WORD NAMSTR ; File name string DEVSTR: .ASCII "CL0:" ; Device name DEVLEN = .-DEVSTR ; Device name length DIRSTR: DIRLEN = .-DIRSTR ; Directory name length NAMSTR: NAMLEN = .-NAMSTR ; File name length .EVEN ; Space to an even boundary. .END TMR