cgit.sxemacs.org Git - sxemacs/blob - src/mem/free-hook.c

   1 /*
   2 This file is part of SXEmacs
   3
   4 SXEmacs is free software: you can redistribute it and/or modify
   5 it under the terms of the GNU General Public License as published by
   6 the Free Software Foundation, either version 3 of the License, or
   7 (at your option) any later version.
   8
   9 SXEmacs is distributed in the hope that it will be useful,
  10 but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 GNU General Public License for more details.
  13
  14 You should have received a copy of the GNU General Public License
  15 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  16
  17
  18 /* Synched up with: Not in FSF. */
  19
  20
  21 #include <config.h>
  22 #include "lisp.h"
  23
  24 /* This file used to include debugging hooks for malloc(), back when we
  25    shipped our own copy of gmalloc.c. Now we just use the system malloc, and
  26    this file has code to debug GCPROs. */
  27
  28 #if defined(DEBUG_INPUT_BLOCKING) || defined (DEBUG_GCPRO)
  29
  30 /* Note: There is no more input blocking in XEmacs */
  31 typedef enum {
  32         block_type, unblock_type, totally_type,
  33         gcpro1_type, gcpro2_type, gcpro3_type, gcpro4_type, gcpro5_type,
  34         ungcpro_type
  35 } blocktype;
  36
  37 struct block_input_history_struct {
  38         char *file;
  39         int line;
  40         blocktype type;
  41         int value;
  42 };
  43
  44 typedef struct block_input_history_struct block_input_history;
  45
  46 #endif                          /* DEBUG_INPUT_BLOCKING || DEBUG_GCPRO */
  47
  48 #ifdef DEBUG_INPUT_BLOCKING
  49
  50 int blhistptr;
  51
  52 #define BLHISTLIMIT 1000
  53
  54 block_input_history blhist[BLHISTLIMIT];
  55
  56 note_block_input(char *file, int line)
  57 {
  58         note_block(file, line, block_type);
  59         if (interrupt_input_blocked > 2)
  60                 abort();
  61 }
  62
  63 note_unblock_input(char *file, int line)
  64 {
  65         note_block(file, line, unblock_type);
  66 }
  67
  68 note_totally_unblocked(char *file, int line)
  69 {
  70         note_block(file, line, totally_type);
  71 }
  72
  73 note_block(char *file, int line, blocktype type)
  74 {
  75         blhist[blhistptr].file = file;
  76         blhist[blhistptr].line = line;
  77         blhist[blhistptr].type = type;
  78         blhist[blhistptr].value = interrupt_input_blocked;
  79
  80         blhistptr++;
  81         if (blhistptr >= BLHISTLIMIT)
  82                 blhistptr = 0;
  83 }
  84
  85 #endif                          /* DEBUG_INPUT_BLOCKING */
  86 \f
  87 #ifdef DEBUG_GCPRO
  88
  89 int gcprohistptr;
  90 #define GCPROHISTLIMIT 1000
  91 block_input_history gcprohist[GCPROHISTLIMIT];
  92
  93 static void log_gcpro(char *file, int line, struct gcpro *value, blocktype type)
  94 {
  95         if (type == ungcpro_type) {
  96                 if (value == gcprolist)
  97                         goto OK;
  98                 if (!gcprolist)
  99                         abort();
 100                 if (value == gcprolist->next)
 101                         goto OK;
 102                 if (!gcprolist->next)
 103                         abort();
 104                 if (value == gcprolist->next->next)
 105                         goto OK;
 106                 if (!gcprolist->next->next)
 107                         abort();
 108                 if (value == gcprolist->next->next->next)
 109                         goto OK;
 110                 if (!gcprolist->next->next->next)
 111                         abort();
 112                 if (value == gcprolist->next->next->next->next)
 113                         goto OK;
 114                 abort();
 115               OK:;
 116         }
 117         gcprohist[gcprohistptr].file = file;
 118         gcprohist[gcprohistptr].line = line;
 119         gcprohist[gcprohistptr].type = type;
 120         gcprohist[gcprohistptr].value = (int)value;
 121         gcprohistptr++;
 122         if (gcprohistptr >= GCPROHISTLIMIT)
 123                 gcprohistptr = 0;
 124 }
 125
 126 void debug_gcpro1(char *file, int line, struct gcpro *gcpro1, Lisp_Object * var)
 127 {
 128         gcpro1->next = gcprolist;
 129         gcpro1->var = var;
 130         gcpro1->nvars = 1;
 131         gcprolist = gcpro1;
 132         log_gcpro(file, line, gcpro1, gcpro1_type);
 133 }
 134
 135 void
 136 debug_gcpro2(char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2,
 137              Lisp_Object * var1, Lisp_Object * var2)
 138 {
 139         gcpro1->next = gcprolist;
 140         gcpro1->var = var1;
 141         gcpro1->nvars = 1;
 142         gcpro2->next = gcpro1;
 143         gcpro2->var = var2;
 144         gcpro2->nvars = 1;
 145         gcprolist = gcpro2;
 146         log_gcpro(file, line, gcpro2, gcpro2_type);
 147 }
 148
 149 void
 150 debug_gcpro3(char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2,
 151              struct gcpro *gcpro3, Lisp_Object * var1, Lisp_Object * var2,
 152              Lisp_Object * var3)
 153 {
 154         gcpro1->next = gcprolist;
 155         gcpro1->var = var1;
 156         gcpro1->nvars = 1;
 157         gcpro2->next = gcpro1;
 158         gcpro2->var = var2;
 159         gcpro2->nvars = 1;
 160         gcpro3->next = gcpro2;
 161         gcpro3->var = var3;
 162         gcpro3->nvars = 1;
 163         gcprolist = gcpro3;
 164         log_gcpro(file, line, gcpro3, gcpro3_type);
 165 }
 166
 167 void
 168 debug_gcpro4(char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2,
 169              struct gcpro *gcpro3, struct gcpro *gcpro4, Lisp_Object * var1,
 170              Lisp_Object * var2, Lisp_Object * var3, Lisp_Object * var4)
 171 {
 172         log_gcpro(file, line, gcpro4, gcpro4_type);
 173         gcpro1->next = gcprolist;
 174         gcpro1->var = var1;
 175         gcpro1->nvars = 1;
 176         gcpro2->next = gcpro1;
 177         gcpro2->var = var2;
 178         gcpro2->nvars = 1;
 179         gcpro3->next = gcpro2;
 180         gcpro3->var = var3;
 181         gcpro3->nvars = 1;
 182         gcpro4->next = gcpro3;
 183         gcpro4->var = var4;
 184         gcpro4->nvars = 1;
 185         gcprolist = gcpro4;
 186 }
 187
 188 void
 189 debug_gcpro5(char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2,
 190              struct gcpro *gcpro3, struct gcpro *gcpro4, struct gcpro *gcpro5,
 191              Lisp_Object * var1, Lisp_Object * var2, Lisp_Object * var3,
 192              Lisp_Object * var4, Lisp_Object * var5)
 193 {
 194         log_gcpro(file, line, gcpro5, gcpro5_type);
 195         gcpro1->next = gcprolist;
 196         gcpro1->var = var1;
 197         gcpro1->nvars = 1;
 198         gcpro2->next = gcpro1;
 199         gcpro2->var = var2;
 200         gcpro2->nvars = 1;
 201         gcpro3->next = gcpro2;
 202         gcpro3->var = var3;
 203         gcpro3->nvars = 1;
 204         gcpro4->next = gcpro3;
 205         gcpro4->var = var4;
 206         gcpro4->nvars = 1;
 207         gcpro5->next = gcpro4;
 208         gcpro5->var = var5;
 209         gcpro5->nvars = 1;
 210         gcprolist = gcpro5;
 211 }
 212
 213 void
 214 debug_gcpro6(char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2,
 215              struct gcpro *gcpro3, struct gcpro *gcpro4, struct gcpro *gcpro5,
 216              struct gcpro *gcpro6,
 217              Lisp_Object * var1, Lisp_Object * var2, Lisp_Object * var3,
 218              Lisp_Object * var4, Lisp_Object * var5, Lisp_Object * var6)
 219 {
 220         log_gcpro(file, line, gcpro5, gcpro5_type);
 221         gcpro1->next = gcprolist;
 222         gcpro1->var = var1;
 223         gcpro1->nvars = 1;
 224         gcpro2->next = gcpro1;
 225         gcpro2->var = var2;
 226         gcpro2->nvars = 1;
 227         gcpro3->next = gcpro2;
 228         gcpro3->var = var3;
 229         gcpro3->nvars = 1;
 230         gcpro4->next = gcpro3;
 231         gcpro4->var = var4;
 232         gcpro4->nvars = 1;
 233         gcpro5->next = gcpro4;
 234         gcpro5->var = var5;
 235         gcpro5->nvars = 1;
 236         gcpro6->next = gcpro5;
 237         gcpro6->var = var5;
 238         gcpro6->nvars = 1;
 239         gcprolist = gcpro6;
 240 }
 241
 242 void
 243 debug_gcpro7(char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2,
 244              struct gcpro *gcpro3, struct gcpro *gcpro4, struct gcpro *gcpro5,
 245              struct gcpro *gcpro6, struct gcpro *gcpro7,
 246              Lisp_Object * var1, Lisp_Object * var2, Lisp_Object * var3,
 247              Lisp_Object * var4, Lisp_Object * var5, Lisp_Object * var6,
 248              Lisp_Object * var7)
 249 {
 250         log_gcpro(file, line, gcpro5, gcpro5_type);
 251         gcpro1->next = gcprolist;
 252         gcpro1->var = var1;
 253         gcpro1->nvars = 1;
 254         gcpro2->next = gcpro1;
 255         gcpro2->var = var2;
 256         gcpro2->nvars = 1;
 257         gcpro3->next = gcpro2;
 258         gcpro3->var = var3;
 259         gcpro3->nvars = 1;
 260         gcpro4->next = gcpro3;
 261         gcpro4->var = var4;
 262         gcpro4->nvars = 1;
 263         gcpro5->next = gcpro4;
 264         gcpro5->var = var5;
 265         gcpro5->nvars = 1;
 266         gcpro6->next = gcpro5;
 267         gcpro6->var = var5;
 268         gcpro6->nvars = 1;
 269         gcpro7->next = gcpro6;
 270         gcpro7->var = var5;
 271         gcpro7->nvars = 1;
 272         gcprolist = gcpro7;
 273 }
 274
 275 void
 276 debug_gcpro8(char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2,
 277              struct gcpro *gcpro3, struct gcpro *gcpro4, struct gcpro *gcpro5,
 278              struct gcpro *gcpro6, struct gcpro *gcpro7, struct gcpro *gcpro8,
 279              Lisp_Object * var1, Lisp_Object * var2, Lisp_Object * var3,
 280              Lisp_Object * var4, Lisp_Object * var5, Lisp_Object * var6,
 281              Lisp_Object * var7, Lisp_Object * var8)
 282 {
 283         log_gcpro(file, line, gcpro5, gcpro5_type);
 284         gcpro1->next = gcprolist;
 285         gcpro1->var = var1;
 286         gcpro1->nvars = 1;
 287         gcpro2->next = gcpro1;
 288         gcpro2->var = var2;
 289         gcpro2->nvars = 1;
 290         gcpro3->next = gcpro2;
 291         gcpro3->var = var3;
 292         gcpro3->nvars = 1;
 293         gcpro4->next = gcpro3;
 294         gcpro4->var = var4;
 295         gcpro4->nvars = 1;
 296         gcpro5->next = gcpro4;
 297         gcpro5->var = var5;
 298         gcpro5->nvars = 1;
 299         gcpro6->next = gcpro5;
 300         gcpro6->var = var5;
 301         gcpro6->nvars = 1;
 302         gcpro7->next = gcpro6;
 303         gcpro7->var = var5;
 304         gcpro7->nvars = 1;
 305         gcpro8->next = gcpro7;
 306         gcpro8->var = var5;
 307         gcpro8->nvars = 1;
 308         gcprolist = gcpro8;
 309 }
 310
 311 void debug_ungcpro(char *file, int line, struct gcpro *gcpro1)
 312 {
 313         log_gcpro(file, line, gcpro1, ungcpro_type);
 314         gcprolist = gcpro1->next;
 315 }
 316
 317 /* To be called from the debugger */
 318 void show_gcprohist(void);
 319 void show_gcprohist(void)
 320 {
 321         int i, j;
 322         for (i = 0, j = gcprohistptr; i < GCPROHISTLIMIT; i++, j++) {
 323                 if (j >= GCPROHISTLIMIT)
 324                         j = 0;
 325                 printf("%3d  %s         %d      %s      0x%x\n",
 326                        j, gcprohist[j].file, gcprohist[j].line,
 327                        (gcprohist[j].type ==
 328                         gcpro1_type ? "GCPRO1" : gcprohist[j].
 329                         type ==
 330                         gcpro2_type ? "GCPRO2" : gcprohist[j].
 331                         type ==
 332                         gcpro3_type ? "GCPRO3" : gcprohist[j].
 333                         type ==
 334                         gcpro4_type ? "GCPRO4" : gcprohist[j].
 335                         type ==
 336                         gcpro5_type ? "GCPRO5" : gcprohist[j].
 337                         type ==
 338                         ungcpro_type ? "UNGCPRO" : "???"), gcprohist[j].value);
 339         }
 340         fflush(stdout);
 341 }
 342
 343 #endif                          /* DEBUG_GCPRO */