diff --git a/code/ntrace.lisp b/code/ntrace.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..a8306ea7d0f1668b73da46c531dad4bb696f88d0
--- /dev/null
+++ b/code/ntrace.lisp
@@ -0,0 +1,255 @@
+;;; -*- Package: debug -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ntrace.lisp,v 1.1 1991/10/13 14:29:30 chiles Exp $")
+;;;
+;;; **********************************************************************
+;;;
+;;; This is a tracing facility.
+;;;
+;;; THIS IS CURRENTLY UNDER DEVELOPMENT AND TESTING.
+;;;
+;;; Written by Bill Chiles.
+;;;
+;;; **********************************************************************
+;;;
+
+(in-package "DEBUG")
+
+;;; BECAUSE SOMEONE SLOPPILY MADE THE "DEBUG" PACKAGE USE "EXT", I HAVE TO BEND
+;;; OVER BACKWARDS NOW TO PREVENT STEPPING ON STUFF EXPORTED BY THE OLD TRACE
+;;; CODE FROM "EXT".  THAT'S WHY THERE ARE ALL THE FUNNY NAMES.  NO, I DON'T
+;;; FEEL LIKE CLEANING UP THE "DEBUG" PACKAGE ONCE AGAIN.
+;;;
+
+(export '(*n-trace-print-level* *n-trace-print-length* *n-traced-function-list*
+	  n-trace n-untrace))
+
+(defvar *n-traced-function-list* ()
+  "A list of function names which are traced.")
+
+(defvar *n-trace-print-length* ()
+  "*Print-length* will be bound to this value when trace is printing.")
+
+(defvar *n-trace-print-level* ()
+  "*Print-level* will be bound to this value when trace is printing.")
+
+
+
+;;;; TRACE.
+
+;;; WITH-KEYWORDS -- Internal.
+;;;
+;;; This takes an options list of the following form:
+;;;    (<option-name> <value> ...)
+;;; It also takes a keyword binding spec of the following form:
+;;;    ((<keyword> <binding-var> <default>)
+;;;     ...)
+;;; This returns a form that binds the variables to any provided value in
+;;; options-list or to the default.
+;;;
+(defmacro with-keywords (option-list key-list &rest body)
+  `(let ,(mapcar #'(lambda (kl)
+		     `(,(cadr kl)		;var
+		       (or (getf ,option-list ,(car kl))
+			   ,(caddr kl))))	;default
+		 key-list)
+     ,@body))
+
+;;; N-TRACE -- Public.
+;;;
+(defmacro n-trace (&rest specs)
+  "Establishes tracing for specified functions and pushes their names on
+   *n-traced-function-list*.  Each specification is either the name of a function
+   or a list of the form:
+      (function-name <trace-option> <value> <trace-option> <value> ...)
+   If you supply no specifications, TRACE returns the list of traced functions.
+   The following options are valid:
+      :condition
+         A form to EVAL to determine whether TRACE should display anything.
+      :break
+         A form to EVAL to determine whether to call BREAK before the call.
+      :break-after
+         Like :break, but takes effect after the call.
+      :break-all
+         Like :break, but takes effect before and after call.
+      :wherein
+         A function name or list of names in which TRACE will display a call.
+      :print
+         A list of forms for EVAL whose results TRACE will display in addition
+         to other information before the call.
+      :print-after
+         Like :print, but takes effect after the call.
+      :print-all
+         Like :print, but takes effect before and after the call."
+  (cond
+   ((not specs) '*n-traced-function-list*)
+   (t
+    (let ((name-list nil)
+	  (trace-1-forms nil))
+      (dolist (spec specs `(progn
+			     ;; Make sure every name has a definition.
+			     ,@(mapcar #'(lambda (x) `#',x) name-list)
+			     ,@trace-1-forms
+			     ',(nreverse name-list)))
+	(multiple-value-bind
+	    (name options)
+	    (typecase spec
+	      (symbol
+	       (values spec nil))
+	      (list
+	       (unless (symbolp (car spec))
+		 (error "Illegal function name:  ~S." (car spec)))
+	       (when (eq (car spec) 'quote)
+		 (error "I bet you don't want to trace QUOTE."))
+	       (values (car spec) (cdr spec)))
+	      (t (error "Illegal trace spec:  ~S." spec)))
+	  (push name name-list)
+	  (with-keywords options
+	    ((:condition condition nil)
+	     (:break break nil)
+	     (:break-after break-after nil)
+	     (:break-all break-all nil)
+	     (:wherein wherein nil)
+	     (:print print nil)
+	     (:print-after print-after nil)
+	     (:print-all print-all nil))
+	    (when break-all
+	      (setf break (setf break-after break-all)))
+	    (when print-all
+	      (setf print (setf print-after print-all)))
+	    ;; Wherein must be a list of symbols or nil.
+	    (setf wherein
+		  (typecase wherein
+		    (null nil)
+		    (symbol (list wherein))
+		    (list (dolist (fun wherein wherein)
+			    (unless (symbolp fun)
+			      (error "Illegal function name, ~S, in :wherein."
+				     fun))))
+		    (t (error "Illegal :wherein option:  ~S." wherein))))
+	    ;; Print and print-after must be lists.
+	    (unless (listp print)
+	      (error "Illegal form list, ~S, for :print." print))
+	    (unless (listp print-after)
+	      (error "Illegal form list, ~S, for :print-after." print-after))
+	    (push `(n-trace-1 ',name ',condition ',break ',break-after
+			    ',wherein ',print ',print-after)
+		  trace-1-forms))))))))
+
+;;; This is a list of function-end-cookies, which we use to note distinct
+;;; dynamic entries into functions.
+;;;
+;;; The length of this list tells us the indentation to use for printing TRACE
+;;; messages.
+;;;
+;;; This list also helps us synchronize the TRACE facility dynamically for
+;;; detecting non-local flow of control that affects TRACE'ing.  Whenever
+;;; execution hits a :function-end breakpoint used for TRACE'ing, we look for
+;;; the function-end-cookie at the top of *traced-entries*.  If it is not
+;;; there, we can adjust our indentation and the contents of the list
+;;; accordingly, printing a warning that some TRACE'd entries have been fouled.
+;;;
+(defvar *traced-entries* nil)
+
+;;; This maps function names to the two breakpoints created in TRACE-1, so we
+;;; can get rid of them in UNTRACE-1.
+;;;
+(defvar *trace-breakpoints* (make-hash-table :test #'eq))
+
+;;; N-TRACE-1 -- Internal.
+;;;
+;;; This establishes :function-start and :function-end breakpoints with
+;;; appropriate hook functions to TRACE function-name as described by the user.
+;;;
+(defun n-trace-1 (function-name condition break break-after wherein print
+		 print-after)
+  (declare (ignore condition break break-after wherein print print-after))
+  (cond
+   ((member function-name *n-traced-function-list*)
+    (warn "Function ~S already TRACE'd, ignoring this request."
+	  function-name))
+   (t
+    (let* ((debug-fun (di:function-debug-function (fdefinition function-name)))
+	   (start (di:make-breakpoint #'print-trace-start
+				      debug-fun
+				      :kind :function-start))
+	   (end (di:make-breakpoint #'print-trace-end
+				    debug-fun
+				    :kind :function-end
+				    :function-end-cookie
+				    #'(lambda (x) (push x *traced-entries*)))))
+      (setf (gethash function-name *trace-breakpoints*) (cons start end))
+      ;; This works TOTALLY SLIMY by the order of the next two calls.
+      (di:activate-breakpoint start)
+      (di:activate-breakpoint end))
+    (push function-name *n-traced-function-list*))))
+
+;;; PRINT-TRACE-START -- Internal.
+;;;
+;;; This prints a representation of the call establishing frame.
+;;;
+(defun print-trace-start (frame bpt)
+  (declare (ignore bpt))
+  (let ((*print-length* (or *n-trace-print-length* *print-length*))
+	(*print-level* (or *n-trace-print-level* *print-level*)))
+    (fresh-line)
+    (print-trace-indentation)
+    (print-frame-call-1 frame nil)
+    (terpri)))
+
+;;; PRINT-TRACE-END -- Internal.
+;;;
+;;; This prints a representation of the return values delivered to frame by the
+;;; function for which bpt is a :function-end breakpoint.  First, this checks
+;;; to see that cookie is at the top of *traced-entries*; if it is not, then we
+;;; need to adjust this list to determine the correct indentation for output.
+;;;
+(defun print-trace-end (frame bpt values cookie)
+  (declare (ignore frame bpt))
+  (unless (eq cookie (car *traced-entries*))
+    (setf *traced-entries* (member cookie *traced-entries*))
+    (fresh-line)
+    (write-line "WARNING: dynamic flow of control occurred while TRACE'ing."))
+  (print-trace-indentation)
+  (pop *traced-entries*)
+  (write-string "returned ")
+  (dolist (v values)
+    (prin1 v)
+    (write-char #\space))
+  (terpri))
+
+(defun print-trace-indentation ()
+  (let ((len (length (the list *traced-entries*))))
+    (dotimes (i len) (write-string "  "))
+    (prin1 len)
+    (write-string ": ")))
+
+
+
+;;;; N-UNTRACE.
+
+(defmacro n-untrace (&rest names)
+  "Removes tracing from the functions named.  With no args, untraces all
+   functions."
+  (let ((names (or names *n-traced-function-list*))
+	(untrace-1-forms nil))
+    (dolist (name names `(progn ,@(nreverse untrace-1-forms) t))
+      (if (symbolp name)
+	  (push `(n-untrace-1 ',name) untrace-1-forms)
+	  (error "Illegal function name -- ~S." name)))))
+
+(defun n-untrace-1 (name)
+  (cond ((member name *n-traced-function-list*)
+	 (let ((breakpoints (gethash name *trace-breakpoints*)))
+	   (di:delete-breakpoint (car breakpoints))
+	   (di:delete-breakpoint (cdr breakpoints))
+	   (setf (gethash name *trace-breakpoints*) nil))
+	 (setf *n-traced-function-list* (delete name *n-traced-function-list*)))
+	(t (warn "Function is not TRACE'd -- ~S." name))))