Transactor/Transactor_14_1986_Transactor_Publishing.d64/trace.pal

Commodore BASIC | 2023-02-26 | 9KB | 518 lines

1000 open 1,8,1,"0:trace.com"
1010 sys700
1020 .opt o1
1030 ;
1040 ;program name-trace/nmi
1050 ;
1060 ;purpose     -to trace and record
1070 ;the data from the <pc> in order
1080 ;to analyze the performance of
1090 ;a program
1100 ;
1110 ;last update -12/26/85
1120 ;
1130 ;author      -r.w.stringer
1140 ;            7805 villa cliff #111
1150 ;            dallas texas 75228
1160 ;            (214)-327-3039
1170 ;
1180 ;special note-i/o cannot operate
1190 ;with nmi interrupts functioning
1200 ;the unset routine (kill jmp
1210 ;vector ) should be called before
1220 ;any input/output
1230 ;            -buffer size in the
1240 ;present configuration is limited
1250 ;to 3 kbytes.this is room for a
1260 ;trace of 24kbytes of address
1270 ;space.to trace more space the
1280 ;program will need to move the
1290 ;buffer or remove basic from the
1300 ;current address space.no basic
1310 ;routines are used
1320 ;
1330 ;
1340 ;     system equates
1350 zpg =$fb
1360 temp =53
1370 skey =653    ;shft/ctrl/cmdre flag
1380 cbegin =$a0  ;trace start address
1390 cfinsh =$ff  ;trace end address
1400 ;above set range for trace
1410 ccycle =100  ;cycle count timer a
1420 milli =828   ;timer b count
1430 vector =792  ;nmi vector
1440 irqoff =%01111111 ;interrupt mask
1450 bmask =%00000010  ;timer b mask
1460 talo =$dd04  ;timer a latch low
1470 tahi =$dd05  ;              hi
1480 tactrl =$dd0e ;timer a control reg
1490 tblo =$dd06  ;timer b latch low
1500 tbhi =$dd07  ;              hi
1510 tbctrl =$dd0f ;timer b control reg
1520 irc =$dd0d  ;interrupt control reg
1530 ;    kernal equates
1540 setlfs =$ffba
1550 setnam =$ffbd
1560 open =$ffc0
1570 chrout =$ffd2
1580 close =$ffc3
1590 clrchn =$ffcc
1600 chkout =$ffc9
1610 ;
1620 ;the difference between cbegin
1630 ;and cfinsh can be no larger than
1640 ;$5f.the buffer at the present
1650 ;location is only 3k long
1660 ;in order to trace the complete
1670 ;64k address space you will need
1680 ;to allocate an 8k buffer.the
1690 ;chart will be 256 lines long.the
1700 ;buffer space formula is
1710 ;buffer =(#kbytes to trace)/8
1720 ;
1730 *=$8000       ;program orgin
1740 ;
1750 ;       jump vectors
1760 trace      jmp setirq  ;start
1770 kill       jmp unset   ;stop
1780 chart      jmp pntcht  ;printout
1790 reset      jmp settwo  ;restart
1800 ;
1810 ;set up vectors zero variables
1820 ;set up and start timers
1830 ;timer b counts underflows
1840 ;from timer a and counts down
1850 ;the number of underflows in
1860 ;milli.on timer b underflow a
1870 ;nmi is generated.vector points
1880 ;to tstprg
1890 ;
1900 setirq     jsr zbuff
1910 lda #0
1920 sta freq
1930 sta freq+1
1940 sta freq+2
1950 sta vflag
1960 settwo     lda vector
1970 sta oldvec
1980 lda #<tstprg
1990 sta vector
2000 lda vector+1
2010 sta oldvec+1
2020 lda #>tstprg
2030 sta vector+1
2040 settmr     lda milli
2050 bne sttimb
2060 lda #1
2070 sta milli
2080 sttimb     sta tblo
2090 lda #0
2100 sta tbhi
2110 lda #>ccycle
2120 sta tahi
2130 lda #<ccycle
2140 sta talo
2150 sei
2160 lda #%01000001
2170 sta tbctrl
2180 lda #%00000001
2190 sta tactrl
2200 lda #%10000010
2210 sta irc
2220 cli
2230 rts
2240 ;
2250 ;reset vectors to normal and
2260 ;turn interrupts off.needed for
2270 ;i/o operations
2280 ;
2290 unset      lda #irqoff
2300 sta irc
2310 lda #0
2320 sta tbctrl
2330 sta tactrl
2340 lda oldvec
2350 sta vector
2360 lda oldvec+1
2370 sta vector+1
2380 rts
2390 ;
2400 ;stop interrupts.pull address
2410 ;of next program step from stack
2420 ;check if in range.subtract offset
2430 ;from hibyte and store.store
2440 ;lobyte and jsr to array routine
2450 ;on return turn interrupts on
2460 ;reset timers and exit.
2470 ;
2480 tstprg     pha
2490 txa
2500 pha
2510 tya
2520 pha
2530 lda #bmask
2540 bit irc
2550 beq outjmp
2560 jmp swich
2570 outjmp     jsr unset
2580 lda #irqoff
2590 sta irc
2600 jmp $fe4c
2610 swich      lda #irqoff
2620 sta irc
2630 lda #0
2640 sta tactrl
2650 sta tbctrl
2660 tsx
2670 lda $0105,x
2680 sta lobyte
2690 lda $0106,x
2700 cmp #cbegin
2710 beq tryhi
2720 bcc bu(NULL)ut
2730 tryhi      cmp #cfinsh
2740 beq issame
2750 bcs bu(NULL)ut
2760 issame     sec
2770 sbc #cbegin
2780 sta hibyte
2790 ;
2800 ;we need to allow system irq
2810 ;requests here because we are
2820 ;stealing so much cpu time
2830 ;
2840 cli
2850 jsr mainpg ;index array
2860 bu(NULL)ut     jsr settmr
2870 jmp $ea81
2880 ;
2890 ;calculate array index and
2900 ;increment the proper array var
2910 ;array is-  array[0...xx,0...15]
2920 ;of double integer [0...65535]
2930 ;array index is calculated as
2940 ;  (hibyte-#cbegin)*32  +
2950 ;  (lobyte/16)*2        +
2960 ;  buffer start address
2970 ;overflow is checked for and
2980 ;sample count incremented.sample
2990 ;count is maintained as a 24 bit
3000 ;integer (2^24)-1.trace is
3010 ;terminated on sample overflow
3020 ;a flag is set on var overflow
3030 ;var's are kept in lo/high format
3040 ;
3050 mainpg     jsr setbuf
3060 lda #0
3070 sta hibyte+1
3080 lda lobyte
3090 and #$f0
3100 lsr a
3110 lsr a
3120 lsr a
3130 sta lobyte
3140 lda hibyte
3150 ldx #4
3160 mul32      asl a
3170 rol hibyte+1
3180 dex
3190 bpl mul32
3200 adc zpg
3210 sta zpg
3220 lda zpg+1
3230 adc hibyte+1
3240 sta zpg+1
3250 ldy lobyte
3260 lda (zpg),y
3270 clc
3280 adc #1
3290 sta (zpg),y ;indexed
3300 iny         ;element
3310 lda (zpg),y
3320 adc #0
3330 sta (zpg),y
3340 bcc test1
3350 lda #0
3360 adc vflag
3370 sta vflag
3380 lda #$ff
3390 sta (zpg),y
3400 dey
3410 sta (zpg),y
3420 test1      inc freq
3430 bne test2
3440 inc freq+1
3450 bne test2
3460 inc freq+2
3470 bne test2
3480 jsr unset
3490 test2      rts
3500 ;
3510 ;print results in chart form
3520 ;with proper formating.leading
3530 ;zeros are suppressed on two
3540 ;byte hexadecimal numbers
3550 ;
3560 ;
3570 pntcht      lda #cbegin
3580 sta fre2
3590 jsr p2scr
3600 ldx #4
3610 jsr chkout
3620 jsr phead
3630 jsr setbuf
3640 pnch1       lda #13
3650 jsr chrout
3660 lda fre2
3670 beq pfini
3680 cmp #cfinsh
3690 beq chks
3700 bcs pfini
3710 chks        jsr pnthex
3720 lda #":"
3730 jsr chrout
3740 lda #32
3750 jsr chrout
3760 ldy #255
3770 pnloop      iny
3780 cpy #32
3790 beq pnch2
3800 lda skey
3810 cmp #3
3820 bne pnch
3830 lda #13
3840 jsr chrout
3850 bcc pfini
3860 pnch        lda (zpg),y
3870 sta lcnt
3880 bne bumpy
3890 iny
3900 lda (zpg),y
3910 bne pntit
3920 jsr pnt3sp
3930 jmp pnloop
3940 pnch2       inc fre2
3950 clc
3960 lda zpg
3970 adc #32
3980 sta zpg
3990 lda zpg+1
4000 adc #0
4010 sta zpg+1
4020 jmp pnch1
4030 pfini       jsr phead
4040 jsr pntsta
4050 lda #4
4060 jsr close
4070 jsr clrchn
4080 rts
4090 bumpy       iny
4100 lda (zpg),y
4110 pntit       sty ysave
4120 ldy lcnt
4130 jsr hex16
4140 lda #32
4150 jsr chrout
4160 ldy ysave
4170 bne pnloop
4180 ;
4190 ;output hexnumber <two bytes>
4200 ;
4210 hex16      sty 829
4220 jsr pnthex
4230 lda 829
4240 jsr hexout
4250 jmp nozera
4260 ;
4270 ;output hex number <one byte>
4280 ;
4290 pnthex     jsr hexout
4300 cmp #"0"
4310 bne nozera
4320 cpy #"0"
4330 bne nozery
4340 ldy #32
4350 bne nozery
4360 nozera     jsr chrout
4370 nozery     tya
4380 jsr chrout
4390 rts
4400 hexout     tax
4410 and #$f0
4420 lsr a
4430 lsr a
4440 lsr a
4450 lsr a
4460 jsr ho2
4470 pha
4480 txa
4490 and #$0f
4500 jsr ho2
4510 tay
4520 pla
4530 rts
4540 ho2        cmp #10
4550 bcc nixadd
4560 clc
4570 adc #7
4580 nixadd     adc #"0"
4590 rts
4600 ;
4610 ;open printer as device #4
4620 ;
4630 p2scr      lda #255
4640 sta pindex+1
4650 lda 53272
4660 and #2
4670 beq ucase
4680 lda #7
4690 sta pindex+1
4700 ucase      lda #4
4710 ldx #4
4720 pindex     ldy #255
4730 jsr setlfs
4740 lda #0
4750 jsr setnam
4760 jsr open
4770 rts
4780 ;
4790 ;reset buffer to start
4800 ;
4810 setbuf    lda #<trbuf
4820 sta zpg
4830 lda #>trbuf
4840 sta zpg+1
4850 rts
4860 ;
4870 ;zero buffer area
4880 ;
4890 zbuff     jsr setbuf
4900 ldx #(cfinsh+1-cbegin)>3
4910 ldy #0
4920 tya
4930 zloop1    sta (zpg),y
4940 iny
4950 bne zloop1
4960 inc zpg+1
4970 dex
4980 bne zloop1
4990 rts
5000 ;
5010 ;print 3 spaces and a colon
5020 ;
5030 pnt3sp     sty ysave
5040 ldy #<space
5050 lda #>space
5060 jsr pstrng
5070 ldy ysave
5080 rts
5090 ;
5100 ;print top of chart
5110 ;
5120 phead      ldy #<messg
5130 lda #>messg
5140 jsr pstrng
5150 rts
5160 ;
5170 ;print string a => y =< address
5180 ;
5190 pstrng      sty temp
5200 sta temp+1
5210 ldy #0
5220 pstrg1      lda (temp),y
5230 beq pstrg2
5240 jsr chrout
5250 iny
5260 bne pstrg1
5270 pstrg2      rts
5280 ;
5290 ;print sample stats
5300 ;
5310 pntsta      ldy #<messg2
5320 lda #>messg2
5330 jsr pstrng
5340 ldy milli
5350 lda #0
5360 jsr hex16
5370 ldy #<messg5
5380 lda #>messg5
5390 jsr pstrng
5400 ldy #<messg3
5410 lda #>messg3
5420 jsr pstrng
5430 ldy #<ccycle
5440 lda #>ccycle
5450 jsr hex16
5460 ldy #<messg5
5470 lda #>messg5
5480 jsr pstrng
5490 ldy #<messg4
5500 lda #>messg4
5510 jsr pstrng
5520 lda freq+2
5530 jsr hexout
5540 jsr nozera
5550 lda freq+1
5560 jsr hexout
5570 jsr nozera
5580 lda freq
5590 jsr hexout
5600 jsr nozera
5610 ldy #<messg5
5620 lda #>messg5
5630 jsr pstrng
5640 ldy #<messg7
5650 lda #>messg7
5660 jsr pstrng
5670 lda vflag
5680 jsr hexout
5690 jsr nozera
5700 ldy #<messg5
5710 lda #>messg5
5720 jsr pstrng
5730 lda #13
5740 jsr chrout
5750 rts
5760 ;
5770 ;program  data and message tables
5780 ;
5790 space  .asc  "   :"
5800 .byte 0
5810 ;
5820 messg3 .byte 13
5830 .asc "clock cycle (a)  ["
5840 .byte 0
5850 ;
5860 messg2 .byte 13,13,13
5870 .asc "cycles      (b)  ["
5880 .byte 0
5890 ;
5900 messg4 .byte 13
5910 .asc "sample count     [ "
5920 .byte 0
5930 ;
5940 messg5 .asc " ]"
5950 .byte 0
5960 ;
5970 messg =*
5980 .asc "     00  10  20"
5990 .asc "  30  40  50  60"
6000 .asc "  70  80  90  a0"
6010 .asc "  b0  c0  d0  e0  f0"
6020 .byte 0
6030 messg7 .byte 13
6040 .asc "overflows        [ "
6050 .byte 0
6060 ;               data
6070 ysave  .byte 0
6080 oldvec .byte 0,0
6090 lcnt   .byte 0
6100 fre2   .byte 0,0
6110 hibyte .byte 0,0
6120 lobyte .byte 0
6130 freq   .byte 0,0,0
6140 vflag  .byte 0
6150 trbuf =*
6160 .end