home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / mactosh / code / asm_qplo.sit < prev    next >
Encoding:
Text File  |  1988-05-14  |  17.6 KB  |  611 lines
  1. 11-May-88 21:24:39-MDT,18622;000000000000
  2. Return-Path: <u-lchoqu%sunset@cs.utah.edu>
  3. Received: from cs.utah.edu by SIMTEL20.ARPA with TCP; Wed, 11 May 88 21:24:12 MDT
  4. Received: by cs.utah.edu (5.54/utah-2.0-cs)
  5.     id AA03586; Wed, 11 May 88 21:24:43 MDT
  6. Received: by sunset.utah.edu (5.54/utah-2.0-leaf)
  7.     id AA29270; Wed, 11 May 88 21:24:40 MDT
  8. Date: Wed, 11 May 88 21:24:40 MDT
  9. From: u-lchoqu%sunset@cs.utah.edu (Lee Choquette)
  10. Message-Id: <8805120324.AA29270@sunset.utah.edu>
  11. To: rthum@simtel20.arpa
  12. Subject: Profile.asm
  13.  
  14. The following program installs a trace routine and instruction frequency
  15. table.  It can write the table out in a compressed format on the disk for
  16. later evaluation (see comments indicating compressed format.)
  17.  
  18.   -- Dave Trissel  Motorola Semiconductor Inc., Austin, Texas
  19.               Delphi: M68000
  20.             Usenet: {ihnp4,seismo}!ut-sally!oakhill!davet
  21.  
  22. ;               ***************** PROFILE **********************
  23. ;    Program to collect 68k instruction counts by dynamic frequency
  24. ;   D3-D6/A2-A6 safe (A5 reserved)
  25.  
  26.     include QuickEquX.D
  27.     include    SysEquX.D
  28.     include ToolEquX.D
  29.     include MacTraps.D
  30.     
  31. ; following SFPutFile macro system copied from PackMacs.txt
  32.     .MACRO _SFPutFile
  33.     _PackCall #SFPutFile,_Pack3
  34.     .ENDM
  35.  
  36.     .MACRO    _PackCall
  37.     MOVE.W      %1,-(SP)
  38.     %2
  39.     .ENDM
  40.     
  41. sfPutFile    EQU    1
  42.  
  43. ;Equates
  44. dupFNErr equ    -48    ;(From SysErr.Txt) File already exists
  45. Aline    equ    40    ;68k a-line vector
  46. Trace    equ    36    ;68k trace vector
  47. inKey    equ    $13243546 ;key indicating table installed
  48.  
  49. ;   QDstore := NewPtr (Size):Ptr Get nonreloc memory for Quickdraw area
  50. Start    MOVE.L    #grafSize,D0    ;size
  51.     _NewPtr
  52.     LEA    QDstore,A1    ;where to store
  53.     MOVE.L    A0,(A1)        ; remember it
  54.     PEA    grafSize-4(A0)    ;Point to it
  55.  
  56.     ;PROCEDURE    InitGraf (globalPtr: QDPtr);
  57.     _InitGraf        ;Init Quickdraw
  58.     _InitFonts        ;Init Font Manager    
  59.     _InitWindows        ;Init Window Manager
  60.     _InitMenus        ;Init Menu Manager    
  61. ;    InitDialogs (restartProc: ProcPtr);
  62.     pea    Start        ;Restart if Store Table into File error
  63.     _InitDialogs        ;Init Dialog Manager    
  64.     _TEInit            ;Init Text Edit
  65.     _InitCursor        ;init cursor
  66. ;    FlushEvents(everyEvent,0)
  67.     move.l    #$0000FFFF,D0    ;clear all events
  68.     _FlushEvents
  69.         
  70. ; Setup Apple Menu
  71. ;    NewMenu(1,'Apple'): Handle
  72.     SUB    #4,SP        ;return parm
  73.     MOVE    #1,-(SP)    ;column
  74.     PEA    MenT1        ;Apple symbol title
  75.     _NewMenu        ;_NewMenu
  76.     LEA    Men1Hndl,A2    ;store handle
  77.     MOVE.L    (SP)+,(A2)    ;  here
  78.  
  79. ;    AppendMenu(Menuhndl,'About...;(-;Desk Accs')
  80.     MOVE.L    (A2),-(SP)    ;pass handle
  81.     PEA    'Profile - by Trissel;(-;Do not run with;Macsbug or Switcher;(-' ;about and null line
  82.     _AppendMenu        ;_AppendMenu
  83.     
  84. ;    AddResMenu(MenuHndl,Type);  {add desktop stuff}
  85.     MOVE.L    (A2),-(SP)    ;pass handle
  86.     MOVE.L    #'DRVR',-(SP)    ;type name
  87.     _AddResMenu        ;_AddResMenu
  88.     
  89. ;    InsertMenu(MenuHndl,beforeID);
  90.     MOVE.L    (A2),-(SP)    ;menu handle
  91.     CLR    -(SP)        ;at front
  92.     _InsertMenu        ;_InsertMenu
  93.  
  94. ;setup File menu    
  95. ;    NewMenu(2,'File'):MenHndl;
  96.     SUB    #4,SP        ;parm return area
  97.     MOVE    #2,-(SP)    ;menu id
  98.     PEA    'File'        ;title
  99.     _NewMenu        ;_NewMenu
  100.     LEA    Men2Hndl,A2    ;handle area
  101.     MOVE.L    (SP)+,(A2)    ; stored here
  102.  
  103.     move.l    BufPtr,A0    ;? is table already installed
  104.     cmp.l    #inkey,(A0)
  105.     beq.s    enough        ;br if so, no need to check
  106.  
  107. ;If not enough memory or running switcher only allow a quit
  108. ;    MaxMem(VAR grow:Size):Size;  {return zone free space and max growth}
  109.     _MaxMem
  110.     cmp.l    #$40000,A0    ;? at least 256k available for growth
  111.     bhi.s    enough        ;yes
  112. ;    AppendMenu(MenuHndl,'Items...');
  113.     MOVE.L    (A2),-(SP)    ;menu handle
  114.     PEA    '(Store Table...;Quit - Not Enough Memory or Switcher Running'
  115.     _AppendMenu        ;_AppendMenu
  116. ;    InsertMenu(MenuHndl,Pos);
  117.     MOVE.L    (A2),-(SP)    ;menu handle
  118.     CLR    -(SP)        ;append
  119.     _InsertMenu
  120. ;     DisableItem(MenuHandle;item);  { disable entire Apple menu }
  121.     move.l    men1hndl,-(SP)    ;menu handle
  122.     clr.w    -(SP)        ;all items
  123.     _DisableItem
  124. ;    DrawMenuBar;
  125.     _DrawMenuBar    
  126.     bra    Event        ;only allow a quit
  127.     
  128. ;    AppendMenu(MenuHndl,'Items...');
  129. enough    MOVE.L    (A2),-(SP)    ;menu handle
  130.     PEA    'Store Table ...;Quit' ;list
  131.     _AppendMenu        ;_AppendMenu
  132.     
  133. ;    InsertMenu(MenuHndl,Pos);
  134.     MOVE.L    (A2),-(SP)    ;menu handle
  135.     CLR    -(SP)        ;append
  136.     _InsertMenu
  137.     
  138. ;install Control menu
  139. ;    NewMenu(3,'Control'):MenHndl;
  140.     SUB    #4,SP        ;parm return area
  141.     MOVE    #3,-(SP)    ;menu id
  142.     PEA    'Control'        ;title
  143.     _NewMenu        ;_NewMenu
  144.     LEA    Men3Hndl,A2    ;handle area
  145.     MOVE.L    (SP)+,(A2)    ; stored here
  146.  
  147. ;    AppendMenu(MenuHndl,'Items...');
  148.     MOVE.L    (A2),-(SP)    ;menu handle
  149.     PEA    'Install Table;Reset Table' ;list
  150.     _AppendMenu        ;_AppendMenu
  151.     
  152. ;    InsertMenu(MenuHndl,Pos);
  153.     MOVE.L    (A2),-(SP)    ;menu handle
  154.     CLR    -(SP)        ;append
  155.     _InsertMenu
  156.         
  157. ;    DrawMenuBar;
  158.     _DrawMenuBar
  159.     
  160. ; Activate and Deactive Menues according to table status.
  161. setmenu
  162. ;    SetItem (MenuHandle;item;string);  {Set to "Quit"}
  163.     move.l    men2hndl,-(SP)    ;menu handle
  164.     move.w    #2,-(SP)    ;second item
  165.     pea    'Quit'        ;title
  166.     _SetItem
  167.     move.l    BufPtr,A0    ;find top of memory
  168.     cmp.l    #inKey,(A0)    ;? table been installed
  169.     beq.s    Tablein        ;yes, continue
  170.     
  171. ; table not installed
  172. ;    SetItem (MenuHandle;item;string);  {Set to "Install Table"}
  173.     move.l    men3hndl,-(SP)    ;menu handle
  174.     move.w    #1,-(SP)    ;first item
  175.     pea    'Install Table'    ;title
  176.     _SetItem
  177. notready
  178. ;     DisableItem(MenuHandle;item);  { disable Store Table... }
  179.     move.l    men2hndl,-(SP)    ;menu handle
  180.     move.w    #1,-(SP)    ;first item [Store Table...]
  181.     _DisableItem
  182. ;    DisableItem(MenuHandle;item); {Disable Reset menu}
  183.     move.l    men3hndl,-(SP)    ;menu handle
  184.     move.w    #2,-(SP)    ;second item (Reset Table)
  185.     _DisableItem
  186.     bra.s    Event
  187.  
  188. ;Table is in so set "Remove Table" and highlight Save and Reset
  189. Tablein
  190. ;    SetItem (MenuHandle;item;string);  {Set to "Remove Table"}
  191.     move.l    men3hndl,-(SP)    ;menu handle
  192.     move.w    #1,-(SP)    ;first item
  193.     pea    'Remove Table'    ;title
  194.     _SetItem
  195. ;    EnableItem(MenuHandle;item); {Enable Reset menu}
  196.     move.l    men3hndl,-(SP)    ;menu handle
  197.     move.w    #2,-(SP)    ;second item (Reset Table)
  198.     _EnableItem
  199. ;    EnableItem(MenuHandle;item); {Enable Store Table...}
  200.     move.l    men2hndl,-(SP)    ;menu handle
  201.     move.w    #1,-(SP)    ;second item (Reset Table)
  202.     _EnableItem    
  203.     
  204.     move.l    BufPtr,A0    ;reload stub base
  205.     tst.b    flag-stub(A0)    ;? Table have data
  206.     bpl.s    Event        ;yes, all set
  207. ;    SetItem (MenuHandle;item;string);  {Set to "Quit - Will Profile"}
  208.     move.l    men2hndl,-(SP)    ;menu handle
  209.     move.w    #2,-(SP)    ;second item
  210.     pea    'Quit and Profile Next Application'    ;title
  211.     _SetItem
  212.     bra    notready    ;and reset reset and store
  213.     
  214. ;---MAIN EVENT LOOP---
  215. Event    _SystemTask        ;allow timed events
  216. ;    _GetNextEvent(Mask,Var Eventrec):ours:boolean
  217.     SUB    #2,SP        ;boolean return
  218.     MOVE    #$FFFF,-(SP)    ;all events
  219.     PEA    EvRecord    ;event record
  220.     _GetNextEvent
  221.     TST.B    (SP)+        ;? for us
  222.     BEQ    Event        ;loop if not
  223.     MOVE    Evntype,D0    ;get type
  224.     BEQ    Event        ;ignore if null
  225.     CMP    #mButDwnEvt,D0    ;? mousedown 1
  226.     BEQ    MouseDwn    ;br if so
  227.     BRA    Event        ;ignore all else
  228.     
  229. ;Mouse is down
  230. ;    _FindWindow(Mousepos:point,VAR Window):where:int
  231. MouseDwn SUB    #2,SP        ;int return
  232.     MOVE.L    EvMpos,-(SP)    ;Mouse Position
  233.     PEA    Windparm    ;Window returned
  234.     _FindWindow
  235.     MOVE    (SP)+,D0    ;get where
  236.     CMP    #inMenuBar,D0    ;? Menu Bar 1
  237.     BEQ    inMenu        ;br if so
  238.     CMP    #inSysWindow,D0    ;? System Window 2
  239.     BEQ    inSystem    ;br if so
  240.     BRA    Event        ;ignore all others
  241.     
  242. ;in a system window
  243. ;    _SystemClick(Event,Window);
  244. inSystem PEA    EvRecord    ;pass event record
  245.     MOVE.L    Windparm,-(SP)    ;pass window involved
  246.     _SystemClick
  247.     BRA    Event        ;and continue
  248.     
  249. ;Click in a Menu
  250. ;    _MenuSelect(Mousepos):Biresult
  251. inMenu    SUB    #4,SP        ;Lint return
  252.     MOVE.L    EvMpos,-(SP)    ;Mouse position
  253.     _MenuSelect
  254.     MOVE    (SP)+,D3    ;Menu number
  255.     MOVE    (SP)+,D4    ;Menu item
  256.     CMP    #1,D3        ;? Apple Menu
  257.     BEQ.s    Applemenu    ;br if so
  258.     CMP    #2,D3        ;? File Menu
  259.     BEQ.s    Filemenu    ;br if so
  260.     cmp    #3,D3        ;? Control Menu
  261.     beq    Contmenu    ;br if so
  262.     BRA    Event        ;MENU=ID=0 no menu picked
  263.  
  264. Applemenu CMP    #1,D4        ;? About...
  265.     BEQ    hilite        ;br if so
  266.  
  267. ;Must be Desk Accessary
  268. ;    _GetItem(Menuhndl,item,VAR chars);
  269. isDA
  270.     MOVE.L    Men1Hndl,-(SP)    ;Apple Menu handle
  271.     MOVE    D4,-(SP)    ;Menu item
  272.     PEA    Deskname    ;return area
  273.     _GetItem
  274. ;    _OpenDeskAcc(Name:str255):resultint;
  275.     SUB    #2,SP        ;result
  276.     PEA    Deskname    ;and name
  277.     _OpenDeskAcc
  278.     ADD    #2,SP        ;throw away result
  279.     bra    hilite        ;unhilite menues
  280.     
  281. ;File menu hit
  282. Filemenu 
  283.     cmp.w    #1,D4        ;Store Table
  284.     beq.s    store        ;yes
  285.     cmp.w    #2,D4        ;Quit
  286.     beq.s    quit        ;must be quit
  287.     bra    hilite        ;cannot not happen
  288.     
  289. ;Store Table...
  290. store
  291. ;    SFPutFile(where;prompt;origName;dlgHook;VAR reply);
  292.     move.w    #80,-(SP)
  293.     move.w    #100,-(SP)    ;point
  294.     pea    'Save table as:' ;prompt
  295.     pea    ''        ;no original name
  296.     pea    0        ;use standard dialog box
  297.     pea    SFReply        ;reply record
  298.     _SFPutFile
  299. ;check if cancel given
  300.     move.b    good,D0        ;? OK
  301.     beq.s    hilite        ;ignore output if CANCEL
  302.     bsr    createfile    ;call create subroutine
  303.     bra.s    hilite        ;now continue
  304.  
  305. ;Continue menu    
  306. Contmenu
  307.     cmp    #1,D4        ;Install or Remove table
  308.     beq.s    change        ;yes
  309.     cmp    #2,D4        ;reset ?
  310.     beq.s    doreset        ;br if so
  311.     bra.s    hilite        ;can't happen
  312.     
  313. ;Install or remove
  314. change    move.l    BufPtr,A0    ;install or remove
  315.     cmp.l    #inKey,(A0)    ;? is this our table
  316.     beq.s    remove        ;yes, remove it
  317.     bsr.s    install        ;install table
  318.     bra.s    hilite        ;clear up menu
  319.     
  320. ;remove the table
  321. remove    move.l    StoBufPtr-stub(A0),BufPtr ; replace old top of memory
  322. ;restore current values of A-LINE and TRACE exceptions
  323.     move.l    StoAline-stub(A0),Aline
  324.     move.l    StoTrace-stub(A0),Trace
  325.     bra.s    hilite        ;hilite menu back    
  326.  
  327. ;Reset menu
  328. doreset    move.l    BufPtr,A0    ;prepare table to be reused
  329.     st.b    flag-stub(A0)    ;set to -1
  330.     
  331. hilite    
  332. ;    _HiLiteMenu(0)
  333.     CLR    -(SP)        ;clear any hilighted menu
  334.     _HiLiteMenu
  335.     bra    setmenu        ;go reset-up menues
  336.  
  337. ;   TERMINATE
  338. Quit
  339. ;    DisposMenu(Menuhndl);
  340.     MOVE.L    Men1Hndl,-(SP)    ;Apple menu
  341.     _DisposMenu
  342.     MOVE.L    Men2Hndl,-(SP)    ;File menu
  343.     _DisposMenu
  344.     MOVE.L    Men3Hndl,-(SP)    ;Control menu
  345.     _DisposMenu
  346.     
  347. ;    DisposPtr (QDstore);    {Free QD area}
  348.     MOVE.L    QDstore,A0    ;load Ptr
  349.     _DisposPtr
  350.     
  351. ; Exit to shell
  352.     _exitToShell
  353.     
  354. ;    **** Install The Table Subroutine ****        
  355. ; allocate a 64K 24-bit entry table (3 X 64k = 192K)
  356. Install
  357.     move.l    A0,D0        ;get current top of memory
  358.     sub.l    #$30100,D0    ;room for 64k entries and 256 byte stub
  359.     and.w    #$F000,D0    ;insure 2k boundary
  360.     move.l    D0,A1        ;base it
  361.     lea    StoBufPtr,A2    ;store position
  362.     move.l    A0,0(A2)    ;remember old value
  363.     move.l    A1,BufPtr    ;change Macintosh top memory limit
  364. ;copy over current values of A-LINE and TRACE exceptions
  365.     lea    StoAline,A6
  366.     move.l    Aline,(A6)
  367.     lea    StoTrace,A6
  368.     move.l    Trace,(A6)
  369. ; move in code and header
  370.     move.w    #$256-1,D0    ;len-1
  371.     move.l    A1,A3        ;copy source
  372.     lea    stub,A2        ;start area
  373. mvloop    move.b    (A2)+,(A3)+    ;next byte
  374.     dbra    D0,mvloop    ;loop till done
  375. ;install our own A-line and trace
  376.     lea    StAline-Stub(A1),A2 ; Aline entry point
  377.     move.l    A2,Aline    ;replace A-LINE
  378.     lea    StTrace-Stub(A1),A2 ; Trace entry point
  379.     move.l    A2,Trace    ;replace trace
  380.     rts            ;return to caller    
  381. ;     ****** STUB *********
  382. ;
  383. ; all code must be relocatable.
  384. stub    
  385.     dc.l    inkey        ;keyword to indicate installation done
  386. flag    dc.b    $FF        ;-1 for initial flag
  387.     dc.b    0,0,0        ;spare
  388. StoAline dc.l    0        ;old Aline vector
  389. StoTrace dc.l    0        ;old Trace vector
  390. StoBufPtr dc.l    0        ;old Top of Memory
  391. StTcount dc.l    0        ;Total instructions traced count
  392.     
  393. ;TRACE entry point - 68k trace entry point
  394. StTrace
  395.     move.b    flag,-1(SP)    ;? tracing on
  396.     bne.s    traceoff    ;br if not
  397.     movem.l    D0/A0,-(SP)    ;work registers
  398.     lea    StTcount,A0
  399.     addq.l    #1,(A0)        ;up total trace count
  400.     move.l    4+4+2(SP),A0    ;caller's PC
  401.     move.w    (A0),D0        ;load opcode
  402.     mulu.w    #3,D0        ;find table offset
  403.     lea    stub+256+2,A0    ;table base + low byte entry offset
  404.     addq.b    #1,(A0,D0.L)    ;increment low byte by one
  405.     bcc.s    noofl        ;branch no overflow
  406.     addq.b    #1,-1(A0,D0.L)    ;increment next byte
  407.     bcc.s    noofl        ;branch no overflow
  408.     addq.b    #1,-2(A0,D0.L)    ;increment next byte
  409.     bcc.s    noofl        ;branch no overflow
  410.     st.b    (A0,D0.L)    ;back up to maximum
  411.     st.b    -1(A0,D0.L)    ;back up to maximum
  412.     st.b    -2(A0,D0.L)    ;back up to maximum
  413. noofl
  414.     movem.l    (SP)+,D0/A0    ;restore registers
  415. traceoff
  416.     rte            ;continue user
  417.     
  418. ;A-LINE entry point - interception to detect Launches and I/O calls
  419. ; 
  420. ; For Launch increment the flag and if zero (1st call) clear count table.
  421. ;    Happens when Finder launches next application after table installed.
  422. ; For A-LINE inhibit tracing for I/O and Enqueue calls.  Otherwise if profiling then
  423. ;          set caller's trace bit on and ours as well before continueing.
  424. StAline
  425.     move.l    StoAline,-(SP)    ;setup to pass to Mac A-line
  426.     movem.l    D0/A0,-(SP)    ;save work regs
  427.     move.l    4+4+4+2(SP),A0    ;caller's PC
  428.     move.b    1(A0),D0    ;second byte of a-line
  429.     cmp.b    #$6F,D0        ;? Enqueue call
  430.     beq.s    passthru    ; yes let right on through
  431.     cmp.b    #$F2,D0        ;? launch
  432.     bne.s    notlaunch    ;br if not
  433.     lea    flag,A0
  434.     add.b    #1,(A0)        ;increment flag
  435.     bne.s    notlaunch
  436. ; zero out table as we are starting to trace
  437.     move.b    D0,-(SP)    ;save a-line index
  438.     move.l    #$30000,D0    ;bytes to clear (64k*3)
  439.     lsr.l    #2,D0        ;Div by 4
  440.     lea    stub+256,A0    ;start of table
  441. clrloop    clr.l    (A0)+        ;next entry
  442.     subq.l    #1,D0        ;count down
  443.     bne    clrloop        ;br till done
  444.     move.b    (SP)+,D0    ;restore a-line index
  445. notlaunch
  446.     cmp.b    #$F4,D0        ;exit to shell
  447.     bne.s    notexit        ;br not
  448. ; if we have just been tracing then increment the flag
  449.     lea    flag,A0        ;base ourselves
  450.     tst.b    (A0)        ;? tracing
  451.     bne.s    noincr        ;br if not
  452.     add.b    #1,(A0)        ;increment flag to stop tracing
  453. noincr    bclr.b    #7,12(SP)    ;stop tracing from caller
  454. notexit
  455.     move.b    flag,-1(SP)    ;? we tracing
  456.     bne.s    passthru    ;no - pass through
  457.     cmp.b    #5,D0        ;? not I/O
  458.     bhi.s    dotrace        ;yes, allow trace
  459.     cmp.b    #2,D0        ;open or close
  460.     blo.s    dotrace        ;yes, trace them
  461. passthru
  462.     movem.l (SP)+,D0/A0    ;restore work
  463.     rts            ;to Mac A-line
  464.     
  465. dotrace
  466.     movem.l    (SP)+,D0/A0    ;restore work regs
  467.     bset.b    #7,4(SP)    ;force caller to trace
  468.     move.w    SR,-(SP)    ;store status register
  469.     bset.b    #7,(SP)        ;force this routine to trace
  470.     rte            ;to normal A-line
  471.     
  472. ;   *******end of Stub*******
  473.  
  474. ;         *** Output Table Subroutine ***
  475. ;
  476. ;The table consists of a longword header which is a count of the total
  477. ;instructions traced for this profile.  Following the header is 
  478. ;the table proper with 64k entries each 3 bytes in length.  Entry one is 
  479. ;for instruction opcode $0000, entry two for $0001 etc.  If an entry count
  480. ;went over the 24 bits it is kept at $FFFFFF.  The amount of overflows
  481. ;can be computed by adding up all the table entries and comparing to the
  482. ;header count which is exact.
  483. ;
  484. ;The format of the block of memory representing the header and table 
  485. ;on the disk is a series of compressed records with the format:
  486. ;
  487. ;    BYTE 1 = number of zero bytes (0 to $FE, FF = EOF)
  488. ;    BYTE 2 = 1st of 2 literal byte values
  489. ;    BYTE 3 = 2nd of 2 literal byte values
  490. ;
  491. ;Recreating the table is as simple as reading each record, adding the number
  492. ;of zero bytes specified (from zero to $FE) then adding the 2 specific bytes,
  493. ;and stopping when the next zero byte count reaches $FF.  Note: the 
  494. ;rebuilding may overflow the table by a few bytes so leave an extra 
  495. ;longword at the end.
  496.  
  497. createfile
  498.     lea    Param,A0    ;I/O param block
  499.     clr.l    ioCompletion(A0) ; no asynch I/O
  500.     lea    fName,A1    ;file name from SFGetFile
  501.     move.l    A1,ioFileName(A0) ; store ptr in
  502.     move.w    vRefNum,ioVRefNum(A0) ; volume no. from SFGetFile
  503.     clr.b    ioFileType(A0)    ;no version no.
  504.     _Create
  505.     cmp.w    #dupFNErr,D0    ;? File already created
  506.     beq.s    ignoredup    ;yes, just overwrite it
  507.     tst.w    D0        ;? error
  508.     bne    doError        ;br yes
  509. ;Get File info to update Finder stuff
  510. ignoredup 
  511.     clr.w    ioFDirIndex(A0)    ;indicate to use File name
  512.     _GetFileInfo
  513.     bne    doError        ;br yes
  514. ;Set Type='PROF', creator='????', and in disk window
  515.     move.l    #'PROF',ioFlUsrWds+fdType(A0)
  516.     move.l    #'????',ioFlUsrWds+fdCreator(A0)
  517.     clr.w    ioFlUsrWds+fdFlags(A0) ; leave visible and unprotected
  518.     clr.l    ioFlUsrWds+fdLocation(A0) ; corner of disk window
  519.     clr.w    ioFlUsrWds+fdFldr(A0) ; in the disk window
  520.     _SetFileInfo
  521.     bne    doError        ;br yes
  522. ;open the file
  523.     move.b    #fsWrPerm,ioPermssn(A0) ; write permission
  524.     clr.l    ioOwnBuf(A0)    ;no special buffer
  525.     _Open
  526.     bne    doError        ;br yes
  527. ; *** write table out ***
  528. ; D0 = zero byte count
  529. ; A0-> Paramblock
  530. ; A2-> current byte position in table
  531. ; A3-> last byte past end of table
  532.     move.l    BufPtr,A3    ;stub address
  533.     lea    256-4(A3),A2    ;A2->header in front of table (table-4)
  534.     move.l    StTcount-stub(A3),(A2) ; move total count at table front
  535.     add.l    #$30100,A3    ;A3->byte past end of table
  536. ;zero byte count processing
  537. zerocnt    clr.b    D0        ;start counting zero value bytes
  538. zerotst    cmp.l    A2,A3        ;? to out of table addr
  539.     bls.s    endbuf        ;yes - send end of file mark
  540.     cmp.b    #$FE,D0        ;? top limit of zero byte count
  541.     beq.s    notzero        ;yes - treat as non-zero byte hit
  542.     tst.b    (A2)        ;? non-zero byte hit
  543.     bne.s    notzero        ;br if so
  544.     add.b    #1,D0        ;count this zero byte
  545.     add.l    #1,A2        ;to next entry in table
  546.     bra    zerotst        ;and continue
  547. ;process zero count and 2 literal bytes
  548. notzero    bsr.s    wrtrec        ;write the record out
  549.     bra    zerocnt        ;start on the next zero count
  550. ;end of buffer reached
  551. endbuf    tst.b    D0        ;any zero bytes?
  552.     beq.s    doeof        ;no - no need for final record
  553.     bsr.s    wrtrec        ;write record with count and 2 garbage bytes
  554. doeof    move.b    #$FF,D0        ;setup end of table mark
  555.     bsr.s    wrtrec        ;write end of table and 2 garbage bytes
  556. ;close file
  557.     _Close
  558.     bne.s    doError        ;br yes
  559.     rts            ;return done to caller
  560.     
  561. ;set in zero and next two literals then write record out
  562. wrtrec    lea    outrec,A1    ;point to record
  563.     move.b    D0,(A1)        ;zero count
  564.     move.b    (A2)+,1(A1)    ;1st literal
  565.     move.b    (A2)+,2(A1)    ;2nd literal
  566.     move.l    A1,ioBuffer(A0) ;start at front of record
  567.     move.l    #3,ioByteCount(A0) ;record length
  568.     move.w    #fsAtMark,ioPosMode(A0) ;no seek
  569.     clr.l    ioPosOffset(A0)    ;no offset from mark
  570.     _Write
  571.     bne.s    doError        ;br yes
  572.     rts            ;return to caller
  573.  
  574. ;Error occured.  Bomb system for now with error code
  575. doError    neg.w    D0        ;turn to positive number for msg display
  576.     _SysError        ;Code will show in error window
  577.  
  578. ;---- DATA ----
  579. EvRecord
  580. Evntype    DC    0        ;type of event
  581. Evmsg    DC.L    0        ;message
  582. Evtstamp DC.L    0        ;time stamp
  583. EvMpos    DC.L    0        ;mouse position
  584. Evmod    DC    0        ;modifier bits
  585.     
  586. Windparm DC.L    0        ;Window mouse in parm
  587. Deskname DCB    16,0        ;desk menu item text (no spec chars)
  588. MenT1    DC.B    1,20        ;Apple symbol
  589. Men1Hndl DC.L    0        ;Menu1 handle
  590. Men2Hndl DC.L    0        ;Menu2 handle
  591. Men3Hndl DC.L    0        ;Menu2 handle
  592.  
  593. QDstore    DC.L    0        ;Ptr to QD storage
  594.     
  595. SFReply    
  596. good    dc.b    0        ;good reply
  597.     dc.b    0        ;unused
  598. fType    dc.l    0        ;file type
  599. vRefNum    dc.w    0        ;volume reference
  600. version    dc.w    0        ;version
  601. fName    dcb.b    64,0        ;file name
  602.  
  603. Param    dcb.b    ioFQElSize,0    ;largest I/O block is GetFileInfo
  604.  
  605. outrec    dc.l    0        ;3 byte output record
  606.  
  607.     END
  608.  
  609.  
  610.  
  611.