← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/c/profile.d

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2006-05-17 02:46:26 UTC
  • Revision ID: james.westby@ubuntu.com-20060517024626-lljr08ftv9g9vefl
Tags: upstream-0.9h-20060510
Import upstream version 0.9h-20060510

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/c/profile.d
 
1
/*  profile.c -- profiling tool                                         */
 
2
/*
 
3
    Copyright (c) 1996, Giuseppe Attardi.
 
4
 
 
5
    This program is free software; you can redistribute it and/or
 
6
    modify it under the terms of the GNU Library General Public
 
7
    License as published by the Free Software Foundation; either
 
8
    version 2 of the License, or (at your option) any later version.
 
9
 
 
10
    See file '../Copyright' for full details.
 
11
*/
 
12
 
 
13
#include <ecl/ecl.h>
 
14
 
 
15
/*
 
16
 *----------------------------------------------------------------------
 
17
 * Profiling tool
 
18
 * ----------------------------------------------------------------------
 
19
 */
 
20
 
 
21
extern caddr_t  *function_entry_table;
 
22
extern int      function_entries;
 
23
 
 
24
static object sSAprofile_arrayA;
 
25
static caddr_t profile_start;
 
26
static unsigned int profile_scale;
 
27
 
 
28
/*
 
29
 *----------------------------------------------------------------------
 
30
 * profile resolution start-address
 
31
 *   scale is a value between 0 and 16384:
 
32
 *      0 means stop profiling, other values represent the size of
 
33
 *      consecutive groups of instructions to which each tick is attributed
 
34
 *   Only (length *profile-array*) / (2 * scale) intructions from
 
35
 *   start-address are profiled.
 
36
 *----------------------------------------------------------------------
 
37
 */
 
38
 
 
39
extern int siLmake_vector (cl_narg narg, object etype, object dim, object adj, object fillp, object displ, object disploff, object staticp);
 
40
extern void profil (short unsigned int *, size_t, int, unsigned int);
 
41
 
 
42
siLprofile(cl_narg narg, object scale, object start_address)
 
43
{
 
44
  int size;
 
45
  object ar = sSAprofile_arrayA->symbol.dbind;
 
46
  if ((narg > 2) || (narg == 0))
 
47
    FEwrong_num_arguments(@'si::profile');
 
48
  if (narg == 1)
 
49
    profile_start = (caddr_t)function_entry_table[0];
 
50
  else
 
51
    profile_start = (caddr_t)fixnnint(start_address);
 
52
  profile_scale = fixnnint(scale);
 
53
  if (type_of(ar) != t_vector) {
 
54
    size = (int)function_entry_table[(function_entries-1)*2]
 
55
      - (int)profile_start;
 
56
    size = size / (sizeof(int) * 2 * profile_scale);
 
57
    ar = siLmake_vector(7, Sfixnum, MAKE_FIXNUM(size),
 
58
                   Cnil, Cnil, Cnil, Cnil,
 
59
                   Ct);         /* static: must not be moved by GC */
 
60
    sSAprofile_arrayA->symbol.dbind = ar;
 
61
  }
 
62
  else
 
63
#   define      inheap(pp)      ((unsigned long)(pp) < (unsigned long)heap_end)
 
64
    if (!inheap(ar->array.self.fix))
 
65
      FEerror("SI:*PROFILE-ARRAY* must be a static array", 0);
 
66
  if (profile_scale > 0)
 
67
    profile_scale = 65536 / ( 2 * profile_scale);
 
68
  profil((unsigned short *)ar->array.self.fix, ar->array.dim * sizeof(int),
 
69
         profile_start, profile_scale);
 
70
#error "Not fixed"
 
71
  VALUES(0) = MAKE_FIXNUM(profile_start);
 
72
  RETURN(1);
 
73
}
 
74
 
 
75
siLclear_profile(cl_narg narg)
 
76
{
 
77
  int i;
 
78
  object ar = sSAprofile_arrayA->symbol.dbind;
 
79
  check_arg(0);
 
80
  if (type_of(ar) != t_vector)
 
81
    FEerror("SI:*PROFILE-ARRAY* must be an array of FIXNUM", 0);
 
82
  for (i = 0;  i < ar->array.dim;  i++)
 
83
      ar->array.self.fix[i] = 0;
 
84
}
 
85
 
 
86
total_ticks(unsigned short *aar, unsigned int dim)
 
87
{
 
88
  register unsigned short *endar = aar+dim;
 
89
  register int count = 0;
 
90
  for ( ; aar < endar; aar++)
 
91
    count += *aar;
 
92
  return count;
 
93
}
 
94
 
 
95
siLdisplay_profile(cl_narg narg)
 
96
{
 
97
  caddr_t prev, next;
 
98
  unsigned upto, dim;
 
99
  int i, j, scale, count, total;
 
100
  unsigned short *ar;
 
101
  object obj_ar = sSAprofile_arrayA->symbol.dbind;
 
102
  int groupSize = 0x20000 / profile_scale;
 
103
 
 
104
  check_arg(0);
 
105
  if (type_of(obj_ar) != t_vector)
 
106
    FEerror("si:*profile-array* not a vector", 0);
 
107
  ar = (unsigned short *)obj_ar->array.self.fix;
 
108
  dim = obj_ar->array.dim * (sizeof(int) / sizeof(short));
 
109
 
 
110
  total = total_ticks(ar, dim);
 
111
 
 
112
  for (i = 0; i < 2*function_entries; i += 2, prev = next) {
 
113
    prev = function_entry_table[i];
 
114
    if (prev < profile_start) continue;
 
115
 
 
116
    if (i+2 == 2*function_entries)
 
117
      upto = dim;
 
118
    else {
 
119
    next = function_entry_table[i+2];
 
120
      upto = (next > profile_start)
 
121
        ? (next - profile_start) / groupSize : 0;
 
122
      if (upto >= dim) upto = dim;
 
123
    }
 
124
    count = 0;
 
125
    for (j = (prev - profile_start) / groupSize; j < upto; j++)
 
126
      count += ar[j];
 
127
    if (count > 0) {
 
128
      object name = (object)function_entry_table[i+1];
 
129
      printf("\n%6.2f%% (%5d): ", 100.0 * count/total, count);
 
130
      prin1(name, Cnil);
 
131
      fflush(stdout);
 
132
    }
 
133
    if (upto == dim) break;
 
134
  }
 
135
  printf("\nTotal ticks: %d\n", total); fflush(stdout);
 
136
  RETURN(0);
 
137
}