davet@oakhill.UUCP (Dave Trissel) (11/20/85)
The following program installs a trace routine and instruction frequency
table. It can write the table out in a compressed format on the disk for
later evaluation (see comments indicating compressed format.)
-- Dave Trissel Motorola Semiconductor Inc., Austin, Texas
{ihnp4,seismo}!ut-sally!oakhill!davet
; ***************** PROFILE **********************
; Program to collect 68k instruction counts by dynamic frequency
; D3-D6/A2-A6 safe (A5 reserved)
include QuickEquX.D
include SysEquX.D
include ToolEquX.D
include MacTraps.D
; following SFPutFile macro system copied from PackMacs.txt
.MACRO _SFPutFile
_PackCall #SFPutFile,_Pack3
.ENDM
.MACRO _PackCall
MOVE.W %1,-(SP)
%2
.ENDM
sfPutFile EQU 1
;Equates
dupFNErr equ -48 ;(From SysErr.Txt) File already exists
Aline equ 40 ;68k a-line vector
Trace equ 36 ;68k trace vector
inKey equ $13243546 ;key indicating table installed
; QDstore := NewPtr (Size):Ptr Get nonreloc memory for Quickdraw area
Start MOVE.L #grafSize,D0 ;size
_NewPtr
LEA QDstore,A1 ;where to store
MOVE.L A0,(A1) ; remember it
PEA grafSize-4(A0) ;Point to it
;PROCEDURE InitGraf (globalPtr: QDPtr);
_InitGraf ;Init Quickdraw
_InitFonts ;Init Font Manager
_InitWindows ;Init Window Manager
_InitMenus ;Init Menu Manager
; InitDialogs (restartProc: ProcPtr);
pea Start ;Restart if Store Table into File error
_InitDialogs ;Init Dialog Manager
_TEInit ;Init Text Edit
_InitCursor ;init cursor
; FlushEvents(everyEvent,0)
move.l #$0000FFFF,D0 ;clear all events
_FlushEvents
; Setup Apple Menu
; NewMenu(1,'Apple'): Handle
SUB #4,SP ;return parm
MOVE #1,-(SP) ;column
PEA MenT1 ;Apple symbol title
_NewMenu ;_NewMenu
LEA Men1Hndl,A2 ;store handle
MOVE.L (SP)+,(A2) ; here
; AppendMenu(Menuhndl,'About...;(-;Desk Accs')
MOVE.L (A2),-(SP) ;pass handle
PEA 'Profile - by Trissel;(-;Do not run with;Macsbug or Switcher;(-' ;about and null line
_AppendMenu ;_AppendMenu
; AddResMenu(MenuHndl,Type); {add desktop stuff}
MOVE.L (A2),-(SP) ;pass handle
MOVE.L #'DRVR',-(SP) ;type name
_AddResMenu ;_AddResMenu
; InsertMenu(MenuHndl,beforeID);
MOVE.L (A2),-(SP) ;menu handle
CLR -(SP) ;at front
_InsertMenu ;_InsertMenu
;setup File menu
; NewMenu(2,'File'):MenHndl;
SUB #4,SP ;parm return area
MOVE #2,-(SP) ;menu id
PEA 'File' ;title
_NewMenu ;_NewMenu
LEA Men2Hndl,A2 ;handle area
MOVE.L (SP)+,(A2) ; stored here
move.l BufPtr,A0 ;? is table already installed
cmp.l #inkey,(A0)
beq.s enough ;br if so, no need to check
;If not enough memory or running switcher only allow a quit
; MaxMem(VAR grow:Size):Size; {return zone free space and max growth}
_MaxMem
cmp.l #$40000,A0 ;? at least 256k available for growth
bhi.s enough ;yes
; AppendMenu(MenuHndl,'Items...');
MOVE.L (A2),-(SP) ;menu handle
PEA '(Store Table...;Quit - Not Enough Memory or Switcher Running'
_AppendMenu ;_AppendMenu
; InsertMenu(MenuHndl,Pos);
MOVE.L (A2),-(SP) ;menu handle
CLR -(SP) ;append
_InsertMenu
; DisableItem(MenuHandle;item); { disable entire Apple menu }
move.l men1hndl,-(SP) ;menu handle
clr.w -(SP) ;all items
_DisableItem
; DrawMenuBar;
_DrawMenuBar
bra Event ;only allow a quit
; AppendMenu(MenuHndl,'Items...');
enough MOVE.L (A2),-(SP) ;menu handle
PEA 'Store Table ...;Quit' ;list
_AppendMenu ;_AppendMenu
; InsertMenu(MenuHndl,Pos);
MOVE.L (A2),-(SP) ;menu handle
CLR -(SP) ;append
_InsertMenu
;install Control menu
; NewMenu(3,'Control'):MenHndl;
SUB #4,SP ;parm return area
MOVE #3,-(SP) ;menu id
PEA 'Control' ;title
_NewMenu ;_NewMenu
LEA Men3Hndl,A2 ;handle area
MOVE.L (SP)+,(A2) ; stored here
; AppendMenu(MenuHndl,'Items...');
MOVE.L (A2),-(SP) ;menu handle
PEA 'Install Table;Reset Table' ;list
_AppendMenu ;_AppendMenu
; InsertMenu(MenuHndl,Pos);
MOVE.L (A2),-(SP) ;menu handle
CLR -(SP) ;append
_InsertMenu
; DrawMenuBar;
_DrawMenuBar
; Activate and Deactive Menues according to table status.
setmenu
; SetItem (MenuHandle;item;string); {Set to "Quit"}
move.l men2hndl,-(SP) ;menu handle
move.w #2,-(SP) ;second item
pea 'Quit' ;title
_SetItem
move.l BufPtr,A0 ;find top of memory
cmp.l #inKey,(A0) ;? table been installed
beq.s Tablein ;yes, continue
; table not installed
; SetItem (MenuHandle;item;string); {Set to "Install Table"}
move.l men3hndl,-(SP) ;menu handle
move.w #1,-(SP) ;first item
pea 'Install Table' ;title
_SetItem
notready
; DisableItem(MenuHandle;item); { disable Store Table... }
move.l men2hndl,-(SP) ;menu handle
move.w #1,-(SP) ;first item [Store Table...]
_DisableItem
; DisableItem(MenuHandle;item); {Disable Reset menu}
move.l men3hndl,-(SP) ;menu handle
move.w #2,-(SP) ;second item (Reset Table)
_DisableItem
bra.s Event
;Table is in so set "Remove Table" and highlight Save and Reset
Tablein
; SetItem (MenuHandle;item;string); {Set to "Remove Table"}
move.l men3hndl,-(SP) ;menu handle
move.w #1,-(SP) ;first item
pea 'Remove Table' ;title
_SetItem
; EnableItem(MenuHandle;item); {Enable Reset menu}
move.l men3hndl,-(SP) ;menu handle
move.w #2,-(SP) ;second item (Reset Table)
_EnableItem
; EnableItem(MenuHandle;item); {Enable Store Table...}
move.l men2hndl,-(SP) ;menu handle
move.w #1,-(SP) ;second item (Reset Table)
_EnableItem
move.l BufPtr,A0 ;reload stub base
tst.b flag-stub(A0) ;? Table have data
bpl.s Event ;yes, all set
; SetItem (MenuHandle;item;string); {Set to "Quit - Will Profile"}
move.l men2hndl,-(SP) ;menu handle
move.w #2,-(SP) ;second item
pea 'Quit and Profile Next Application' ;title
_SetItem
bra notready ;and reset reset and store
;---MAIN EVENT LOOP---
Event _SystemTask ;allow timed events
; _GetNextEvent(Mask,Var Eventrec):ours:boolean
SUB #2,SP ;boolean return
MOVE #$FFFF,-(SP) ;all events
PEA EvRecord ;event record
_GetNextEvent
TST.B (SP)+ ;? for us
BEQ Event ;loop if not
MOVE Evntype,D0 ;get type
BEQ Event ;ignore if null
CMP #mButDwnEvt,D0 ;? mousedown 1
BEQ MouseDwn ;br if so
BRA Event ;ignore all else
;Mouse is down
; _FindWindow(Mousepos:point,VAR Window):where:int
MouseDwn SUB #2,SP ;int return
MOVE.L EvMpos,-(SP) ;Mouse Position
PEA Windparm ;Window returned
_FindWindow
MOVE (SP)+,D0 ;get where
CMP #inMenuBar,D0 ;? Menu Bar 1
BEQ inMenu ;br if so
CMP #inSysWindow,D0 ;? System Window 2
BEQ inSystem ;br if so
BRA Event ;ignore all others
;in a system window
; _SystemClick(Event,Window);
inSystem PEA EvRecord ;pass event record
MOVE.L Windparm,-(SP) ;pass window involved
_SystemClick
BRA Event ;and continue
;Click in a Menu
; _MenuSelect(Mousepos):Biresult
inMenu SUB #4,SP ;Lint return
MOVE.L EvMpos,-(SP) ;Mouse position
_MenuSelect
MOVE (SP)+,D3 ;Menu number
MOVE (SP)+,D4 ;Menu item
CMP #1,D3 ;? Apple Menu
BEQ.s Applemenu ;br if so
CMP #2,D3 ;? File Menu
BEQ.s Filemenu ;br if so
cmp #3,D3 ;? Control Menu
beq Contmenu ;br if so
BRA Event ;MENU=ID=0 no menu picked
Applemenu CMP #1,D4 ;? About...
BEQ hilite ;br if so
;Must be Desk Accessary
; _GetItem(Menuhndl,item,VAR chars);
isDA
MOVE.L Men1Hndl,-(SP) ;Apple Menu handle
MOVE D4,-(SP) ;Menu item
PEA Deskname ;return area
_GetItem
; _OpenDeskAcc(Name:str255):resultint;
SUB #2,SP ;result
PEA Deskname ;and name
_OpenDeskAcc
ADD #2,SP ;throw away result
bra hilite ;unhilite menues
;File menu hit
Filemenu
cmp.w #1,D4 ;Store Table
beq.s store ;yes
cmp.w #2,D4 ;Quit
beq.s quit ;must be quit
bra hilite ;cannot not happen
;Store Table...
store
; SFPutFile(where;prompt;origName;dlgHook;VAR reply);
move.w #80,-(SP)
move.w #100,-(SP) ;point
pea 'Save table as:' ;prompt
pea '' ;no original name
pea 0 ;use standard dialog box
pea SFReply ;reply record
_SFPutFile
;check if cancel given
move.b good,D0 ;? OK
beq.s hilite ;ignore output if CANCEL
bsr createfile ;call create subroutine
bra.s hilite ;now continue
;Continue menu
Contmenu
cmp #1,D4 ;Install or Remove table
beq.s change ;yes
cmp #2,D4 ;reset ?
beq.s doreset ;br if so
bra.s hilite ;can't happen
;Install or remove
change move.l BufPtr,A0 ;install or remove
cmp.l #inKey,(A0) ;? is this our table
beq.s remove ;yes, remove it
bsr.s install ;install table
bra.s hilite ;clear up menu
;remove the table
remove move.l StoBufPtr-stub(A0),BufPtr ; replace old top of memory
;restore current values of A-LINE and TRACE exceptions
move.l StoAline-stub(A0),Aline
move.l StoTrace-stub(A0),Trace
bra.s hilite ;hilite menu back
;Reset menu
doreset move.l BufPtr,A0 ;prepare table to be reused
st.b flag-stub(A0) ;set to -1
hilite
; _HiLiteMenu(0)
CLR -(SP) ;clear any hilighted menu
_HiLiteMenu
bra setmenu ;go reset-up menues
; TERMINATE
Quit
; DisposMenu(Menuhndl);
MOVE.L Men1Hndl,-(SP) ;Apple menu
_DisposMenu
MOVE.L Men2Hndl,-(SP) ;File menu
_DisposMenu
MOVE.L Men3Hndl,-(SP) ;Control menu
_DisposMenu
; DisposPtr (QDstore); {Free QD area}
MOVE.L QDstore,A0 ;load Ptr
_DisposPtr
; Exit to shell
_exitToShell
; **** Install The Table Subroutine ****
; allocate a 64K 24-bit entry table (3 X 64k = 192K)
Install
move.l A0,D0 ;get current top of memory
sub.l #$30100,D0 ;room for 64k entries and 256 byte stub
and.w #$F000,D0 ;insure 2k boundary
move.l D0,A1 ;base it
lea StoBufPtr,A2 ;store position
move.l A0,0(A2) ;remember old value
move.l A1,BufPtr ;change Macintosh top memory limit
;copy over current values of A-LINE and TRACE exceptions
lea StoAline,A6
move.l Aline,(A6)
lea StoTrace,A6
move.l Trace,(A6)
; move in code and header
move.w #$256-1,D0 ;len-1
move.l A1,A3 ;copy source
lea stub,A2 ;start area
mvloop move.b (A2)+,(A3)+ ;next byte
dbra D0,mvloop ;loop till done
;install our own A-line and trace
lea StAline-Stub(A1),A2 ; Aline entry point
move.l A2,Aline ;replace A-LINE
lea StTrace-Stub(A1),A2 ; Trace entry point
move.l A2,Trace ;replace trace
rts ;return to caller
; ****** STUB *********
;
; all code must be relocatable.
stub
dc.l inkey ;keyword to indicate installation done
flag dc.b $FF ;-1 for initial flag
dc.b 0,0,0 ;spare
StoAline dc.l 0 ;old Aline vector
StoTrace dc.l 0 ;old Trace vector
StoBufPtr dc.l 0 ;old Top of Memory
StTcount dc.l 0 ;Total instructions traced count
;TRACE entry point - 68k trace entry point
StTrace
move.b flag,-1(SP) ;? tracing on
bne.s traceoff ;br if not
movem.l D0/A0,-(SP) ;work registers
lea StTcount,A0
addq.l #1,(A0) ;up total trace count
move.l 4+4+2(SP),A0 ;caller's PC
move.w (A0),D0 ;load opcode
mulu.w #3,D0 ;find table offset
lea stub+256+2,A0 ;table base + low byte entry offset
addq.b #1,(A0,D0.L) ;increment low byte by one
bcc.s noofl ;branch no overflow
addq.b #1,-1(A0,D0.L) ;increment next byte
bcc.s noofl ;branch no overflow
addq.b #1,-2(A0,D0.L) ;increment next byte
bcc.s noofl ;branch no overflow
st.b (A0,D0.L) ;back up to maximum
st.b -1(A0,D0.L) ;back up to maximum
st.b -2(A0,D0.L) ;back up to maximum
noofl
movem.l (SP)+,D0/A0 ;restore registers
traceoff
rte ;continue user
;A-LINE entry point - interception to detect Launches and I/O calls
;
; For Launch increment the flag and if zero (1st call) clear count table.
; Happens when Finder launches next application after table installed.
; For A-LINE inhibit tracing for I/O and Enqueue calls. Otherwise if profiling then
; set caller's trace bit on and ours as well before continueing.
StAline
move.l StoAline,-(SP) ;setup to pass to Mac A-line
movem.l D0/A0,-(SP) ;save work regs
move.l 4+4+4+2(SP),A0 ;caller's PC
move.b 1(A0),D0 ;second byte of a-line
cmp.b #$6F,D0 ;? Enqueue call
beq.s passthru ; yes let right on through
cmp.b #$F2,D0 ;? launch
bne.s notlaunch ;br if not
lea flag,A0
add.b #1,(A0) ;increment flag
bne.s notlaunch
; zero out table as we are starting to trace
move.b D0,-(SP) ;save a-line index
move.l #$30000,D0 ;bytes to clear (64k*3)
lsr.l #2,D0 ;Div by 4
lea stub+256,A0 ;start of table
clrloop clr.l (A0)+ ;next entry
subq.l #1,D0 ;count down
bne clrloop ;br till done
move.b (SP)+,D0 ;restore a-line index
notlaunch
cmp.b #$F4,D0 ;exit to shell
bne.s notexit ;br not
; if we have just been tracing then increment the flag
lea flag,A0 ;base ourselves
tst.b (A0) ;? tracing
bne.s noincr ;br if not
add.b #1,(A0) ;increment flag to stop tracing
noincr bclr.b #7,12(SP) ;stop tracing from caller
notexit
move.b flag,-1(SP) ;? we tracing
bne.s passthru ;no - pass through
cmp.b #5,D0 ;? not I/O
bhi.s dotrace ;yes, allow trace
cmp.b #2,D0 ;open or close
blo.s dotrace ;yes, trace them
passthru
movem.l (SP)+,D0/A0 ;restore work
rts ;to Mac A-line
dotrace
movem.l (SP)+,D0/A0 ;restore work regs
bset.b #7,4(SP) ;force caller to trace
move.w SR,-(SP) ;store status register
bset.b #7,(SP) ;force this routine to trace
rte ;to normal A-line
; *******end of Stub*******
; *** Output Table Subroutine ***
;
;The table consists of a longword header which is a count of the total
;instructions traced for this profile. Following the header is
;the table proper with 64k entries each 3 bytes in length. Entry one is
;for instruction opcode $0000, entry two for $0001 etc. If an entry count
;went over the 24 bits it is kept at $FFFFFF. The amount of overflows
;can be computed by adding up all the table entries and comparing to the
;header count which is exact.
;
;The format of the block of memory representing the header and table
;on the disk is a series of compressed records with the format:
;
; BYTE 1 = number of zero bytes (0 to $FE, FF = EOF)
; BYTE 2 = 1st of 2 literal byte values
; BYTE 3 = 2nd of 2 literal byte values
;
;Recreating the table is as simple as reading each record, adding the number
;of zero bytes specified (from zero to $FE) then adding the 2 specific bytes,
;and stopping when the next zero byte count reaches $FF. Note: the
;rebuilding may overflow the table by a few bytes so leave an extra
;longword at the end.
createfile
lea Param,A0 ;I/O param block
clr.l ioCompletion(A0) ; no asynch I/O
lea fName,A1 ;file name from SFGetFile
move.l A1,ioFileName(A0) ; store ptr in
move.w vRefNum,ioVRefNum(A0) ; volume no. from SFGetFile
clr.b ioFileType(A0) ;no version no.
_Create
cmp.w #dupFNErr,D0 ;? File already created
beq.s ignoredup ;yes, just overwrite it
tst.w D0 ;? error
bne doError ;br yes
;Get File info to update Finder stuff
ignoredup
clr.w ioFDirIndex(A0) ;indicate to use File name
_GetFileInfo
bne doError ;br yes
;Set Type='PROF', creator='????', and in disk window
move.l #'PROF',ioFlUsrWds+fdType(A0)
move.l #'????',ioFlUsrWds+fdCreator(A0)
clr.w ioFlUsrWds+fdFlags(A0) ; leave visible and unprotected
clr.l ioFlUsrWds+fdLocation(A0) ; corner of disk window
clr.w ioFlUsrWds+fdFldr(A0) ; in the disk window
_SetFileInfo
bne doError ;br yes
;open the file
move.b #fsWrPerm,ioPermssn(A0) ; write permission
clr.l ioOwnBuf(A0) ;no special buffer
_Open
bne doError ;br yes
; *** write table out ***
; D0 = zero byte count
; A0-> Paramblock
; A2-> current byte position in table
; A3-> last byte past end of table
move.l BufPtr,A3 ;stub address
lea 256-4(A3),A2 ;A2->header in front of table (table-4)
move.l StTcount-stub(A3),(A2) ; move total count at table front
add.l #$30100,A3 ;A3->byte past end of table
;zero byte count processing
zerocnt clr.b D0 ;start counting zero value bytes
zerotst cmp.l A2,A3 ;? to out of table addr
bls.s endbuf ;yes - send end of file mark
cmp.b #$FE,D0 ;? top limit of zero byte count
beq.s notzero ;yes - treat as non-zero byte hit
tst.b (A2) ;? non-zero byte hit
bne.s notzero ;br if so
add.b #1,D0 ;count this zero byte
add.l #1,A2 ;to next entry in table
bra zerotst ;and continue
;process zero count and 2 literal bytes
notzero bsr.s wrtrec ;write the record out
bra zerocnt ;start on the next zero count
;end of buffer reached
endbuf tst.b D0 ;any zero bytes?
beq.s doeof ;no - no need for final record
bsr.s wrtrec ;write record with count and 2 garbage bytes
doeof move.b #$FF,D0 ;setup end of table mark
bsr.s wrtrec ;write end of table and 2 garbage bytes
;close file
_Close
bne.s doError ;br yes
rts ;return done to caller
;set in zero and next two literals then write record out
wrtrec lea outrec,A1 ;point to record
move.b D0,(A1) ;zero count
move.b (A2)+,1(A1) ;1st literal
move.b (A2)+,2(A1) ;2nd literal
move.l A1,ioBuffer(A0) ;start at front of record
move.l #3,ioByteCount(A0) ;record length
move.w #fsAtMark,ioPosMode(A0) ;no seek
clr.l ioPosOffset(A0) ;no offset from mark
_Write
bne.s doError ;br yes
rts ;return to caller
;Error occured. Bomb system for now with error code
doError neg.w D0 ;turn to positive number for msg display
_SysError ;Code will show in error window
;---- DATA ----
EvRecord
Evntype DC 0 ;type of event
Evmsg DC.L 0 ;message
Evtstamp DC.L 0 ;time stamp
EvMpos DC.L 0 ;mouse position
Evmod DC 0 ;modifier bits
Windparm DC.L 0 ;Window mouse in parm
Deskname DCB 16,0 ;desk menu item text (no spec chars)
MenT1 DC.B 1,20 ;Apple symbol
Men1Hndl DC.L 0 ;Menu1 handle
Men2Hndl DC.L 0 ;Menu2 handle
Men3Hndl DC.L 0 ;Menu2 handle
QDstore DC.L 0 ;Ptr to QD storage
SFReply
good dc.b 0 ;good reply
dc.b 0 ;unused
fType dc.l 0 ;file type
vRefNum dc.w 0 ;volume reference
version dc.w 0 ;version
fName dcb.b 64,0 ;file name
Param dcb.b ioFQElSize,0 ;largest I/O block is GetFileInfo
outrec dc.l 0 ;3 byte output record
END