[RFC 12/14] Nuke cgen-call-with-debugging and cgen-debugging-stack-start

[Tom Tromey <tom@tromey.com>]

cgen-call-with-debugging and cgen-debugging-stack-start are ostensibly
just for Guile, but I don't think they provide much value with more
recent versions of Guile.  This patch removes them.
---
 guile.scm | 63 -----------------------------------------
 read.scm  | 85 ++++++++++++++++++++++++-------------------------------
 2 files changed, 37 insertions(+), 111 deletions(-)

diff --git a/guile.scm b/guile.scm
index 9d7c64c..5899f15 100644
--- a/guile.scm
+++ b/guile.scm
@@ -24,66 +24,3 @@
 ;;; Enabling and disabling debugging features of the host Scheme.
 
 (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, make that debugging / no-debugging setting actually take
-  ;; effect.
-  ;;
-  ;; 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/read.scm b/read.scm
index ee3f488..8856da0 100644
--- a/read.scm
+++ b/read.scm
@@ -1252,7 +1252,7 @@ Define a preprocessor-style macro.
 ;; OPTION-HANDLER is either (lambda () ...) or (lambda (arg) ...) and
 ;; processes the option.
 
-(define /cgen
+(define cgen
   (lambda args
     (let ((app-name "unknown")
 	  (opt-spec nil)
@@ -1380,54 +1380,43 @@ Define a preprocessor-style macro.
 
 	;; All arguments have been parsed.
 
-	(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
-		     trace-options diagnostic-options
-		     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))))
+	(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
+		  trace-options diagnostic-options
+		  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.
-
-(define cgen
-  (lambda args
-    (cgen-debugging-stack-start /cgen args))
-)
-- 
2.41.0