Commit abb1cafc authored by Per Cederqvist's avatar Per Cederqvist
Browse files

Initial revision

parent 24282fa5
;;;; $Id: handle-malloc-dump.el,v 1.1 1991/09/21 12:09:35 ceder Exp $
;;;; Copyright (C) 1991 Lysator Academic Computer Association.
;;;; This file is part of the LysKOM server.
;;;; LysKOM is free software; you can redistribute it and/or modify it
;;;; under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 1, or (at your option)
;;;; any later version.
;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT
;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
;;;; for more details.
;;;; You should have received a copy of the GNU General Public License
;;;; along with LysKOM; see the file COPYING. If not, write to
;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN,
;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
;;;; MA 02139, USA.
;;;; Please mail bug reports to
;;; block - each block that is active is stored on a dll. The dll
;;; contains blocks. Each block consists of 'addr' - the base addr of
;;; the block - and 'marker' - a marker that points to the backtrace.
;;; Constructor:
(defun create-block (addr
"Create a block from ADDR and MARKER."
(vector addr marker )))
;;; Selectors:
(defun block->addr (block)
"Get addr from BLOCK."
(elt (cdr block) 0))
(defun block->marker (block)
"Get marker from BLOCK."
(elt (cdr block) 1))
;;; Modifiers:
(defun set-block->addr (block newval)
"Set addr in BLOCK to NEWVAL."
(aset (cdr block) 0 newval))
(defun set-block->marker (block newval)
"Set marker in BLOCK to NEWVAL."
(aset (cdr block) 1 newval))
;;; Predicate:
(defun block-p (object)
"Return t if OBJECT is a block."
(eq (car-safe object) 'BLOCK))
(defvar mstack nil
"A dll that holds all currently active memory blocks.")
(defvar illegal-free nil
"A dll that holds all illegal free attempts.")
(defun resolve-trace ()
"Search the current buffer, and output any erroneous
mallocs/reallocs/frees to *Result*."
(setq mstack (dll-create))
(setq illegal-free (dll-create))
(goto-char (point-min))
(while (re-search-forward "^--- \\(.*\\) ---$" nil 'foo)
(let* ((fn (buffer-substring (match-beginning 1) (match-end 1)))
(btstart (match-end 0))
(btend (progn (re-search-forward "^==== end ====")
(match-beginning 0))))
(message fn)
((string= fn "malloc")
(beginning-of-line 0)
((string= fn "free")
(beginning-of-line 0)
((string= fn "realloc")
(beginning-of-line -1)
(beginning-of-line 2)
(defun get-number ()
"Get the last hex-string on this line, as a string."
(re-search-forward "0x[0-9a-f]*$")
(buffer-substring (match-beginning 0) (match-end 0)))
(defun allocate ()
"Add an unresolved allocation to mstack."
(dll-enter-first mstack
(create-block (get-number)
(defun free ()
"Resolve an allocation from mstack."
(let ((addr (get-number))
(node (dll-nth mstack 0)))
(while (and node
(not (string= addr
(block->addr (dll-element mstack node)))))
(setq node (dll-next mstack node)))
(if node
(dll-delete mstack node)
(dll-enter-first illegal-free (create-block addr (point))))))
(defun report-stacks ()
(pop-to-buffer "*Result*" t)
(insert "Forgotten mallocs:\n\n"))
(report-stack mstack)
(pop-to-buffer "*Result*" t)
(insert "\n\nIllegal frees:\n\n"))
(report-stack illegal-free))
(defun report-stack (stack)
(let ((gdb-buf (current-buffer))
(node (dll-nth stack 0)))
(while node
(goto-char (block->marker (dll-element stack node)))
(re-search-backward "^---")
(let* ((b (point))
(e (progn
(re-search-forward "====$")
(set-buffer "*Result*")
(insert (format "From char %d:\n" b))
(insert-buffer-substring gdb-buf (1- b) (1+ e))))
(setq node (dll-next stack node)))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment