From 91d5a88929a6fd3be826d51b2e40fd27b7b36a5c Mon Sep 17 00:00:00 2001
From: jimb <jimb>
Date: Tue, 15 Feb 2005 09:01:32 +0000
Subject: [PATCH] Make backtraces work more reliably. * guile.scm: Set up
 debugging parameters, and enable debugging and source positions while
 loading. (cgen-call-with-debugging, cgen-debugging-stack-start): New
 functions. * read.scm: Don't set debugging parameters here.
 (catch-with-backtrace): Function deleted. (-cgen): Simply note the presence
 or absence of the -b option. Pass the flag to cgen-call-with-debugging, so
 debugging is turned off here if the user didn't request it, for faster
 computation. (cgen): Call cgen-debugging-stack-start here, instead of
 catch-with-backtrace.

* Makefile.am (GUILE): Explicitly load guile.scm here, and leave a
trailing -s.
(desc, html, opcodes, sim-arch, sim-cpu, gas-test, sim-test):
Don't write out the trailing -s here.
* Makefile.in: Regenerated.
* cgen-doc.scm, cgen-gas.scm, cgen-stest.scm): Don't load
fixup.scm here; let the caller decide which Scheme's customization
file to preload.
* dev.scm: Load guile.scm, not fixup.scm.
* fixup.scm: Deleted; contents have all moved to guile.scm.
* README: Doc fix.

* guile.scm (debug-write): New function.
---
 cgen/ChangeLog      |  29 +++++++++++++
 cgen/Makefile.am    |  16 +++----
 cgen/Makefile.in    |  30 ++++++-------
 cgen/README         |   4 +-
 cgen/cgen-doc.scm   |   3 --
 cgen/cgen-gas.scm   |   3 --
 cgen/cgen-stest.scm |   3 --
 cgen/dev.scm        |   4 +-
 cgen/fixup.scm      |  60 --------------------------
 cgen/guile.scm      |  85 ++++++++++++++++++++++++++++++++++++
 cgen/read.scm       | 121 ++++++++++++++++++----------------------------------
 11 files changed, 182 insertions(+), 176 deletions(-)
 delete mode 100644 cgen/fixup.scm

diff --git a/cgen/ChangeLog b/cgen/ChangeLog
index b9110aead6..96feca5cd1 100644
--- a/cgen/ChangeLog
+++ b/cgen/ChangeLog
@@ -1,3 +1,32 @@
+2005-02-15  Jim Blandy  <jimb@redhat.com>
+
+	Make backtraces work more reliably.
+	* guile.scm: Set up debugging parameters, and enable debugging and
+	source positions while loading.
+	(cgen-call-with-debugging, cgen-debugging-stack-start): New
+	functions.
+	* read.scm: Don't set debugging parameters here.
+	(catch-with-backtrace): Function deleted.
+	(-cgen): Simply note the presence or absence of the -b option.
+	Pass the flag to cgen-call-with-debugging, so debugging is turned
+	off here if the user didn't request it, for faster computation.
+	(cgen): Call cgen-debugging-stack-start here, instead of
+	catch-with-backtrace.
+
+	* Makefile.am (GUILE): Explicitly load guile.scm here, and leave a
+	trailing -s.
+	(desc, html, opcodes, sim-arch, sim-cpu, gas-test, sim-test):
+	Don't write out the trailing -s here.
+	* Makefile.in: Regenerated.
+	* cgen-doc.scm, cgen-gas.scm, cgen-stest.scm): Don't load
+	fixup.scm here; let the caller decide which Scheme's customization
+	file to preload.
+	* dev.scm: Load guile.scm, not fixup.scm.
+	* fixup.scm: Deleted; contents have all moved to guile.scm.
+	* README: Doc fix.
+
+	* guile.scm (debug-write): New function.
+
 2005-02-14  Jim Blandy  <jimb@redhat.com>
 
 	* pmacros.scm (pmacros-init!): For .eval macros, use eval1 as the
diff --git a/cgen/Makefile.am b/cgen/Makefile.am
index 065e114475..0532ed7ad8 100644
--- a/cgen/Makefile.am
+++ b/cgen/Makefile.am
@@ -4,7 +4,7 @@ AUTOMAKE_OPTIONS = cygnus
 
 SUBDIRS = doc
 
-GUILE = `if test -f ../guile/libguile/guile ; then echo ../guile/libguile/guile; else echo guile ; fi`
+GUILE = "`if test -f ../guile/libguile/guile ; then echo ../guile/libguile/guile; else echo guile ; fi` -l guile -s"
 CGENFLAGS = -v
 ARCH = @arch@
 ARCHFILE = $(srcroot)/../cpu/$(ARCH).cpu
@@ -46,7 +46,7 @@ stamp-cgen: $(CGENFILES)
 # FIXME: needs more dependencies
 desc: desc.scm
 	rm -f tmp-desc.h tmp-desc.c tmp-opinst.c
-	$(GUILE) -s $(srcdir)/cgen-opc.scm \
+	$(GUILE) $(srcdir)/cgen-opc.scm \
 		-s $(srcdir) \
 		$(CGENFLAGS) \
 		-f "$(OPTIONS)" \
@@ -60,7 +60,7 @@ desc: desc.scm
 .PHONY: html
 html: desc.scm html.scm cgen-doc.scm
 	rm -f tmp-doc.html
-	$(GUILE) -s $(srcdir)/cgen-doc.scm \
+	$(GUILE) $(srcdir)/cgen-doc.scm \
 		-s $(srcdir) \
 		$(CGENFLAGS) \
 		-f "$(OPTIONS)" \
@@ -82,7 +82,7 @@ html: desc.scm html.scm cgen-doc.scm
 opcodes: opcodes.scm
 	rm -f tmp-opc.h tmp-itab.c
 	rm -f tmp-asm.in tmp-dis.in tmp-ibld.h tmp-ibld.in
-	$(GUILE) -s $(srcdir)/cgen-opc.scm \
+	$(GUILE) $(srcdir)/cgen-opc.scm \
 		-s $(srcdir) \
 		$(CGENFLAGS) \
 		-f "$(OPTIONS) opinst" \
@@ -103,7 +103,7 @@ opcodes: opcodes.scm
 # FIXME: needs more dependencies
 sim-arch: sim.scm
 	rm -f tmp-arch.h tmp-arch.c tmp-cpuall.h
-	$(GUILE) -s $(srcdir)/cgen-sim.scm \
+	$(GUILE) $(srcdir)/cgen-sim.scm \
 		-s $(srcdir) \
 		$(CGENFLAGS) \
 		-f "$(OPTIONS)" \
@@ -114,7 +114,7 @@ sim-arch: sim.scm
 sim-cpu: sim.scm
 	rm -f tmp-cpu.h tmp-cpu.c tmp-decode.h tmp-decode.c
 	rm -f tmp-model.c tmp-sem.c tmp-sem-switch.c
-	$(GUILE) -s $(srcdir)/cgen-sim.scm \
+	$(GUILE) $(srcdir)/cgen-sim.scm \
 		-s $(srcdir) \
 		$(CGENFLAGS) \
 		-f "$(OPTIONS)" \
@@ -135,7 +135,7 @@ gas-test: gas-test.scm cgen-gas.scm
 	  echo "ISAS not specified!" ;\
 	  exit 1 ;\
 	fi
-	$(GUILE) -s $(srcdir)/cgen-gas.scm \
+	$(GUILE) $(srcdir)/cgen-gas.scm \
 		-s $(srcdir) \
 		$(CGENFLAGS) \
 		-a $(ARCHFILE) \
@@ -153,7 +153,7 @@ sim-test: sim-test.scm cgen-stest.scm
 	  echo "ISAS not specified!" ;\
 	  exit 1 ;\
 	fi
-	$(GUILE) -s $(srcdir)/cgen-stest.scm \
+	$(GUILE) $(srcdir)/cgen-stest.scm \
 		-s $(srcdir) \
 		$(CGENFLAGS) \
 		-a $(ARCHFILE) \
diff --git a/cgen/Makefile.in b/cgen/Makefile.in
index 524b19a134..ed3fa50c2a 100644
--- a/cgen/Makefile.in
+++ b/cgen/Makefile.in
@@ -1,6 +1,6 @@
-# Makefile.in generated automatically by automake 1.4 from Makefile.am
+# Makefile.in generated automatically by automake 1.4-p6 from Makefile.am
 
-# Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc.
+# Copyright (C) 1994, 1995-8, 1999, 2001 Free Software Foundation, Inc.
 # This Makefile.in is free software; the Free Software Foundation
 # gives unlimited permission to copy and/or distribute it,
 # with or without modifications, as long as this notice is preserved.
@@ -76,7 +76,7 @@ AUTOMAKE_OPTIONS = cygnus
 
 SUBDIRS = doc
 
-GUILE = `if test -f ../guile/libguile/guile ; then echo ../guile/libguile/guile; else echo guile ; fi`
+GUILE = "`if test -f ../guile/libguile/guile ; then echo ../guile/libguile/guile; else echo guile ; fi` -l guile -s"
 CGENFLAGS = -v
 ARCH = @arch@
 ARCHFILE = $(srcroot)/../cpu/$(ARCH).cpu
@@ -100,7 +100,7 @@ NEWS aclocal.m4 configure configure.in
 
 DISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) $(TEXINFOS) $(EXTRA_DIST)
 
-TAR = tar
+TAR = gtar
 GZIP_ENV = --best
 all: all-redirect
 .SUFFIXES:
@@ -131,7 +131,7 @@ $(srcdir)/configure: @MAINTAINER_MODE_TRUE@$(srcdir)/configure.in $(ACLOCAL_M4)
 all-recursive install-data-recursive install-exec-recursive \
 installdirs-recursive install-recursive uninstall-recursive install-info-recursive \
 check-recursive installcheck-recursive info-recursive dvi-recursive:
-	@set fnord $(MAKEFLAGS); amf=$$2; \
+	@set fnord $$MAKEFLAGS; amf=$$2; \
 	dot_seen=no; \
 	target=`echo $@ | sed s/-recursive//`; \
 	list='$(SUBDIRS)'; for subdir in $$list; do \
@@ -151,11 +151,11 @@ check-recursive installcheck-recursive info-recursive dvi-recursive:
 
 mostlyclean-recursive clean-recursive distclean-recursive \
 maintainer-clean-recursive:
-	@set fnord $(MAKEFLAGS); amf=$$2; \
+	@set fnord $$MAKEFLAGS; amf=$$2; \
 	dot_seen=no; \
 	rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \
 	  rev="$$subdir $$rev"; \
-	  test "$$subdir" = "." && dot_seen=yes; \
+	  test "$$subdir" != "." || dot_seen=yes; \
 	done; \
 	test "$$dot_seen" = "no" && rev=". $$rev"; \
 	target=`echo $@ | sed s/-recursive//`; \
@@ -249,7 +249,7 @@ distdir: $(DISTFILES)
 	@for file in $(DISTFILES); do \
 	  if test -f $$file; then d=.; else d=$(srcdir); fi; \
 	  if test -d $$d/$$file; then \
-	    cp -pr $$/$$file $(distdir)/$$file; \
+	    cp -pr $$d/$$file $(distdir)/$$file; \
 	  else \
 	    test -f $(distdir)/$$file \
 	    || ln $$d/$$file $(distdir)/$$file 2> /dev/null \
@@ -369,7 +369,7 @@ stamp-cgen: $(CGENFILES)
 # FIXME: needs more dependencies
 desc: desc.scm
 	rm -f tmp-desc.h tmp-desc.c tmp-opinst.c
-	$(GUILE) -s $(srcdir)/cgen-opc.scm \
+	$(GUILE) $(srcdir)/cgen-opc.scm \
 		-s $(srcdir) \
 		$(CGENFLAGS) \
 		-f "$(OPTIONS)" \
@@ -383,7 +383,7 @@ desc: desc.scm
 .PHONY: html
 html: desc.scm html.scm cgen-doc.scm
 	rm -f tmp-doc.html
-	$(GUILE) -s $(srcdir)/cgen-doc.scm \
+	$(GUILE) $(srcdir)/cgen-doc.scm \
 		-s $(srcdir) \
 		$(CGENFLAGS) \
 		-f "$(OPTIONS)" \
@@ -405,7 +405,7 @@ html: desc.scm html.scm cgen-doc.scm
 opcodes: opcodes.scm
 	rm -f tmp-opc.h tmp-itab.c
 	rm -f tmp-asm.in tmp-dis.in tmp-ibld.h tmp-ibld.in
-	$(GUILE) -s $(srcdir)/cgen-opc.scm \
+	$(GUILE) $(srcdir)/cgen-opc.scm \
 		-s $(srcdir) \
 		$(CGENFLAGS) \
 		-f "$(OPTIONS) opinst" \
@@ -426,7 +426,7 @@ opcodes: opcodes.scm
 # FIXME: needs more dependencies
 sim-arch: sim.scm
 	rm -f tmp-arch.h tmp-arch.c tmp-cpuall.h
-	$(GUILE) -s $(srcdir)/cgen-sim.scm \
+	$(GUILE) $(srcdir)/cgen-sim.scm \
 		-s $(srcdir) \
 		$(CGENFLAGS) \
 		-f "$(OPTIONS)" \
@@ -437,7 +437,7 @@ sim-arch: sim.scm
 sim-cpu: sim.scm
 	rm -f tmp-cpu.h tmp-cpu.c tmp-decode.h tmp-decode.c
 	rm -f tmp-model.c tmp-sem.c tmp-sem-switch.c
-	$(GUILE) -s $(srcdir)/cgen-sim.scm \
+	$(GUILE) $(srcdir)/cgen-sim.scm \
 		-s $(srcdir) \
 		$(CGENFLAGS) \
 		-f "$(OPTIONS)" \
@@ -458,7 +458,7 @@ gas-test: gas-test.scm cgen-gas.scm
 	  echo "ISAS not specified!" ;\
 	  exit 1 ;\
 	fi
-	$(GUILE) -s $(srcdir)/cgen-gas.scm \
+	$(GUILE) $(srcdir)/cgen-gas.scm \
 		-s $(srcdir) \
 		$(CGENFLAGS) \
 		-a $(ARCHFILE) \
@@ -476,7 +476,7 @@ sim-test: sim-test.scm cgen-stest.scm
 	  echo "ISAS not specified!" ;\
 	  exit 1 ;\
 	fi
-	$(GUILE) -s $(srcdir)/cgen-stest.scm \
+	$(GUILE) $(srcdir)/cgen-stest.scm \
 		-s $(srcdir) \
 		$(CGENFLAGS) \
 		-a $(ARCHFILE) \
diff --git a/cgen/README b/cgen/README
index d370da325b..d4ea1d4f49 100644
--- a/cgen/README
+++ b/cgen/README
@@ -166,8 +166,8 @@ misc. support scripts
 ---------------------
 
 dev.scm - top level script for doing interactive development
-fixup.scm - munges the Scheme environment to make it suit us
-	[Guile is/was still in flux]
+guile.scm - Guile-specific definitions, and adaptations to specific
+	    versions of Guile
 cos.scm - OOP implementation
 pmacros.scm - preprocessor-style macro package
 profile.scm - Guile profiling tool [eventually wish to move this to
diff --git a/cgen/cgen-doc.scm b/cgen/cgen-doc.scm
index b2c6ae43c3..3f1671200d 100644
--- a/cgen/cgen-doc.scm
+++ b/cgen/cgen-doc.scm
@@ -9,9 +9,6 @@
 ; Load the various support routines.
 
 (define (load-files srcdir)
-  ; Fix up Scheme to be what we use (guile is always in flux).
-  (primitive-load-path (string-append srcdir "/fixup.scm"))
-
   (load (string-append srcdir "/read.scm"))
   (load (string-append srcdir "/desc.scm"))
   (load (string-append srcdir "/desc-cpu.scm"))
diff --git a/cgen/cgen-gas.scm b/cgen/cgen-gas.scm
index 39fe13a3ed..e097b1d42d 100644
--- a/cgen/cgen-gas.scm
+++ b/cgen/cgen-gas.scm
@@ -8,9 +8,6 @@
 ; Load the various support routines.
 
 (define (load-files srcdir)
-  ; Fix up Scheme to be what we use (guile is always in flux).
-  (primitive-load-path (string-append srcdir "/fixup.scm"))
-
   (load (string-append srcdir "/read.scm"))
   (load (string-append srcdir "/desc.scm"))
   (load (string-append srcdir "/desc-cpu.scm"))
diff --git a/cgen/cgen-stest.scm b/cgen/cgen-stest.scm
index 8eafd140a3..1637f22c24 100644
--- a/cgen/cgen-stest.scm
+++ b/cgen/cgen-stest.scm
@@ -8,9 +8,6 @@
 
 ; Load the various support routines
 (define (load-files srcdir)
-  ; Fix up Scheme to be what we use (guile is always in flux).
-  (primitive-load-path (string-append srcdir "/fixup.scm"))
-
   (load (string-append srcdir "/read.scm"))
   (load (string-append srcdir "/desc.scm"))
   (load (string-append srcdir "/desc-cpu.scm"))
diff --git a/cgen/dev.scm b/cgen/dev.scm
index c8e79d075a..8141c374c6 100644
--- a/cgen/dev.scm
+++ b/cgen/dev.scm
@@ -12,9 +12,9 @@
 ; (load-sid)
 ; (cload #:arch arch #:machs "mach-list" #:isas "isa-list" #:options "options")
 
-; First load fixup.scm to coerce guile into something we've been using.
+; First load guile.scm to coerce guile into something we've been using.
 ; Guile is always in flux.
-(load "fixup.scm")
+(load "guile.scm")
 
 (define srcdir ".")
 (set! %load-path (cons srcdir %load-path))
diff --git a/cgen/fixup.scm b/cgen/fixup.scm
deleted file mode 100644
index 46f672dc68..0000000000
--- a/cgen/fixup.scm
+++ /dev/null
@@ -1,60 +0,0 @@
-; Fix up the current interpreter-du-jour to conform to what we've
-; been working with.
-; Copyright (C) 2000 Red Hat, Inc.
-; This file is part of CGEN.
-; See file COPYING.CGEN for details.
-
-(define *guile-major-version* (string->number (major-version)))
-(define *guile-minor-version* (string->number (minor-version)))
-
-; eval takes a module argument in 1.6 and later
-
-(if (or (> *guile-major-version* 1)
-	(>= *guile-minor-version* 6))
-    (define (eval1 expr)
-      (eval expr (current-module)))
-    (define (eval1 expr)
-      (eval expr))
-)
-
-; symbol-bound? is deprecated in 1.6
-
-(if (or (> *guile-major-version* 1)
-	(>= *guile-minor-version* 6))
-    (define (symbol-bound? table s)
-      (if table
-	  (error "must pass #f for symbol-bound? first arg"))
-      ; FIXME: Not sure this is 100% correct.
-      (module-defined? (current-module) s))
-)
-
-(if (symbol-bound? #f 'load-from-path)
-    (begin
-      (define (load file)
-	(begin
-	  ;(load-from-path file)
-	  (primitive-load-path file)
-	  ))
-      )
-)
-
-; FIXME: to be deleted
-(define =? =)
-(define >=? >=)
-
-(if (not (symbol-bound? #f '%stat))
-    (begin
-      (define %stat stat)
-      )
-)
-
-(if (symbol-bound? #f 'debug-enable)
-    (debug-enable 'backtrace)
-)
-
-; Guile 1.3 has reverse!, Guile 1.2 has list-reverse!.
-; CGEN uses reverse!
-(if (and (not (symbol-bound? #f 'reverse!))
-	 (symbol-bound? #f 'list-reverse!))
-    (define reverse! list-reverse!)
-)
diff --git a/cgen/guile.scm b/cgen/guile.scm
index 23d98f725b..95ddfda90f 100644
--- a/cgen/guile.scm
+++ b/cgen/guile.scm
@@ -57,3 +57,88 @@
 	 (symbol-bound? #f 'list-reverse!))
     (define reverse! list-reverse!)
 )
+
+(define (debug-write . objs)
+  (map (lambda (o)
+	 ((if (string? o) display write) o (current-error-port)))
+       objs)
+  (newline (current-error-port)))
+
+
+
+;;; Enabling and disabling debugging features of the host Scheme.
+
+;;; For the initial load proces, turn everything on.  We'll disable it
+;;; before we start doing the heavy computation.
+(if (memq 'debug-extensions *features*)
+    (begin
+      (debug-enable 'backtrace)
+      (debug-enable 'debug)
+      (debug-enable 'backwards)
+      (debug-set! depth 2000)
+      (debug-set! maxdepth 2000)
+      (debug-set! stack 100000)
+      (debug-set! frames 10)))
+(read-enable 'positions)
+
+;;; Call THUNK, with debugging enabled if FLAG is true, or disabled if
+;;; FLAG is false.
+;;;
+;;; (On systems other than Guile, this needn't actually do anything at
+;;; all, beyond calling THUNK, so long as your backtraces are still
+;;; helpful.  In Guile, the debugging evaluator is slower, so we don't
+;;; want to use it unless the user asked for it.)
+(define (cgen-call-with-debugging flag thunk)
+  (if (memq 'debug-extensions *features*)
+      ((if flag debug-enable debug-disable) 'debug))
+  
+  ;; Now, actually start using the debugging evaluator.
+  ;;
+  ;; Guile has two separate evaluators, one that does the extra
+  ;; bookkeeping for backtraces, and one which doesn't, but runs
+  ;; faster.  However, the evaluation process (in either evaluator)
+  ;; ordinarily never consults the variable that says which evaluator
+  ;; to use: whatever evaluator was running just keeps rolling along.
+  ;; There are certain primitives, like some of the eval variants,
+  ;; that do actually check.  start-stack is one such primitive, but
+  ;; we don't want to shadow whatever other stack id is there, so we
+  ;; do all the real work in the ID argument, and do nothing in the
+  ;; EXP argument.  What a kludge.
+  (start-stack (begin (thunk) #t) #f))
+
+
+;;; Apply PROC to ARGS, marking that application as the bottom of the
+;;; stack for error backtraces.
+;;;
+;;; (On systems other than Guile, this doesn't really need to do
+;;; anything other than apply PROC to ARGS, as long as something
+;;; ensures that backtraces will work right.)
+(define (cgen-debugging-stack-start proc args)
+
+  ;; Naming this procedure, rather than using an anonymous lambda,
+  ;; allows us to pass less fragile cut info to save-stack.
+  (define (handler . args)
+		;;(display args (current-error-port))
+		;;(newline (current-error-port))
+		;; display-error takes 6 arguments.
+		;; If `quit' is called from elsewhere, it may not have 6
+		;; arguments.  Not sure how best to handle this.
+		(if (= (length args) 5)
+		    (begin
+		      (apply display-error #f (current-error-port) (cdr args))
+		      ;; Grab a copy of the current stack, 
+		      (save-stack handler 0)
+		      (backtrace)))
+		(quit 1))
+
+  ;; Apply proc to args, and if any uncaught exception is thrown, call
+  ;; handler WITHOUT UNWINDING THE STACK (that's the 'lazy' part).  We
+  ;; need the stack left alone so we can produce a backtrace.
+  (lazy-catch #t
+	      (lambda () 
+		;; I have no idea why the 'load-stack' stack mark is
+		;; not still present on the stack; we're still loading
+		;; cgen-APP.scm, aren't we?  But stack-id returns #f
+		;; in handler if we don't do a start-stack here.
+		(start-stack proc (apply proc args)))
+	      handler))
diff --git a/cgen/read.scm b/cgen/read.scm
index ee07c22932..5eea56d6bb 100644
--- a/cgen/read.scm
+++ b/cgen/read.scm
@@ -87,20 +87,6 @@
 ; If a routine to initialize compiled-in code is defined, run it.
 (if (defined? 'cgen-init-c) (cgen-init-c))
 
-; Don't use the debugging evaluator unless asked for.
-(if (not (defined? 'DEBUG-EVAL))
-    (define DEBUG-EVAL #f))
-
-(if (and (not DEBUG-EVAL)
-	 (memq 'debug-extensions *features*))
-    (begin
-      (debug-disable 'debug)
-      (read-disable 'positions)
-      ))
-
-; Extend the default limits of the interpreter stack
-(debug-set! stack 100000)
-
 ; If this is set to #f, the file is always loaded.
 ; Don't override any current setting, e.g. from dev.scm.
 (if (not (defined? 'CHECK-LOADED?))
@@ -913,24 +899,6 @@ Define a preprocessor-style macro.
 	       (cons (cons opt #f) (cdr argv))))))
 )
 
-; Used to ensure backtraces are printed if an error occurs.
-
-(define (catch-with-backtrace thunk)
-  (lazy-catch #t thunk
-	      (lambda args
-		;(display args (current-error-port))
-		;(newline (current-error-port))
-		; display-error takes 6 arguments.
-		; If `quit' is called from elsewhere, it may not have 6
-		; arguments.  Not sure how best to handle this.
-		(if (= (length args) 5)
-		    (begin
-		      (apply display-error #f (current-error-port) (cdr args))
-		      (save-stack)
-		      (backtrace)))
-		(quit 1)))
-)
-
 ; Return (cadr args) or print a pretty error message if not possible.
 
 (define (option-arg args)
@@ -1088,6 +1056,7 @@ Define a preprocessor-style macro.
 	    (keep-isa "all")  ; default is all isas
 	    (flags "")
 	    (moreopts? #t)
+	    (debugging #f)    ; default is off, for speed
 	    (cep (current-error-port))
 	    (str=? string=?)
 	    )
@@ -1105,15 +1074,7 @@ Define a preprocessor-style macro.
 		      (set! arch-file arg)
 		      )
 		     ((str=? "-b" (car opt))
-		      (if (memq 'debug-extensions *features*)
-			  (begin
-			    (debug-enable 'backtrace)
-			    (debug-enable 'debug)
-			    (debug-enable 'backwards)
-			    (debug-set! depth 2000)
-			    (debug-set! maxdepth 2000)
-			    (debug-set! frames 10)
-			    (read-enable 'positions)))
+		      (set! debugging #t)
 		      )
 		     ((str=? "-d" (car opt))
 		      (let ((prompt (string-append "cgen-" app-name "> ")))
@@ -1167,51 +1128,51 @@ Define a preprocessor-style macro.
 
 	; All arguments have been parsed.
 
-	(if (not arch-file)
-	    (error "-a option missing, no architecture specified"))
-
-	(if repl?
-	    (debug-repl nil))
-	(cpu-load arch-file
-		  keep-mach keep-isa flags
-		  app-init! app-finish! app-analyze!)
-	; Start another repl loop if -d.
-	; Awkward.  Both places are useful, though this is more useful.
-	(if repl?
-	    (debug-repl nil))
-
-	; Done with processing the arguments.
-	; Application arguments are processed in two passes.
-	; This is because the app may have arguments that specify things
-	; that affect file generation (e.g. to specify another input file)
-	; and we don't want to require an ordering of the options.
-
-	(for-each (lambda (opt-arg)
-		    (let ((opt (car opt-arg))
-			  (arg (cdr opt-arg)))
-		      (if (cadr opt)
-			  ((opt-get-first-pass opt) arg)
-			  ((opt-get-first-pass opt)))))
-		  (reverse app-args))
-
-	(for-each (lambda (opt-arg)
-		    (let ((opt (car opt-arg))
-			  (arg (cdr opt-arg)))
-		      (if (cadr opt)
-			  ((opt-get-second-pass opt) arg)
-			  ((opt-get-second-pass opt)))))
-		  (reverse app-args))
+	(cgen-call-with-debugging
+	 debugging
+	 (lambda ()
+
+	   (if (not arch-file)
+	       (error "-a option missing, no architecture specified"))
+
+	   (if repl?
+	       (debug-repl nil))
+	   (cpu-load arch-file
+		     keep-mach keep-isa flags
+		     app-init! app-finish! app-analyze!)
+
+	   ;; Start another repl loop if -d.
+	   ;; Awkward.  Both places are useful, though this is more useful.
+	   (if repl?
+	       (debug-repl nil))
+
+	   ;; Done with processing the arguments.  Application arguments
+	   ;; are processed in two passes.  This is because the app may
+	   ;; have arguments that specify things that affect file
+	   ;; generation (e.g. to specify another input file) and we
+	   ;; don't want to require an ordering of the options.
+	   (for-each (lambda (opt-arg)
+		       (let ((opt (car opt-arg))
+			     (arg (cdr opt-arg)))
+			 (if (cadr opt)
+			     ((opt-get-first-pass opt) arg)
+			     ((opt-get-first-pass opt)))))
+		     (reverse app-args))
+
+	   (for-each (lambda (opt-arg)
+		       (let ((opt (car opt-arg))
+			     (arg (cdr opt-arg)))
+			 (if (cadr opt)
+			     ((opt-get-second-pass opt) arg)
+			     ((opt-get-second-pass opt)))))
+		     (reverse app-args))))
 	)
       )
     #f) ; end of lambda
 )
 
 ; Main entry point called by application file generators.
-; Cover fn to -cgen that uses catch-with-backtrace.
-; ??? (debug-enable 'backtrace) might also work except I seem to remember
-; having problems with it.  They may be fixed now.
-
 (define cgen
   (lambda args
-    (catch-with-backtrace (lambda () (apply -cgen args))))
+    (cgen-debugging-stack-start -cgen args))
 )
-- 
2.11.0