From 41ec3f20a8504a6832c422fcdb2df611242a6142 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 3 May 2010 23:07:46 -0400
Subject: [PATCH] tools.deploy.shaker: tweak error reporting slightly
---
basis/tools/deploy/shaker/shaker.factor | 28 +++++++++++++------
.../tools/deploy/shaker/strip-debugger.factor | 10 ++-----
2 files changed, 22 insertions(+), 16 deletions(-)
diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 485f0f5fa7..44291a96cc 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -1,13 +1,15 @@
! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays alien.libraries accessors io.backend io.encodings.utf8 io.files
-io.streams.c init fry namespaces math make assocs kernel parser
-parser.notes lexer strings.parser vocabs sequences sequences.deep
-sequences.private words memory kernel.private continuations io
-vocabs.loader system strings sets vectors quotations byte-arrays
-sorting compiler.units definitions generic generic.standard
-generic.single tools.deploy.config combinators classes vocabs.loader.private
-classes.builtin slots.private grouping command-line io.pathnames ;
+USING: arrays alien.libraries accessors io.backend
+io.encodings.utf8 io.files io.streams.c init fry namespaces math
+make assocs kernel parser parser.notes lexer strings.parser
+vocabs sequences sequences.deep sequences.private words memory
+kernel.private continuations io vocabs.loader system strings
+sets vectors quotations byte-arrays sorting compiler.units
+definitions generic generic.standard generic.single
+tools.deploy.config combinators combinators.private classes
+vocabs.loader.private classes.builtin slots.private grouping
+command-line io.pathnames ;
QUALIFIED: bootstrap.stage2
QUALIFIED: classes.private
QUALIFIED: compiler.crossref
@@ -548,10 +550,18 @@ SYMBOL: deploy-vocab
strip-words
clear-megamorphic-caches ;
+: die-with ( error original-error -- * )
+ #! We don't want DCE to drop the error before the die call!
+ [ die 1 exit ] (( a -- * )) call-effect-unsafe ;
+
+: die-with2 ( error original-error -- * )
+ #! We don't want DCE to drop the error before the die call!
+ [ die 1 exit ] (( a b -- * )) call-effect-unsafe ;
+
: deploy-error-handler ( quot -- )
[
strip-debugger?
- [ error-continuation get call>> callstack>array die 1 exit ]
+ [ original-error get die-with2 ]
! Don't reference these words literally, if we're stripping the
! debugger out we don't want to load the prettyprinter at all
[ [:c] execute( -- ) nl [print-error] execute( error -- ) flush ] if
diff --git a/basis/tools/deploy/shaker/strip-debugger.factor b/basis/tools/deploy/shaker/strip-debugger.factor
index b7565e7d9e..5faeab0e2d 100644
--- a/basis/tools/deploy/shaker/strip-debugger.factor
+++ b/basis/tools/deploy/shaker/strip-debugger.factor
@@ -1,17 +1,13 @@
USING: compiler.units words vocabs kernel threads.private ;
IN: debugger
-: consume ( error -- )
- #! We don't want DCE to drop the error before the die call!
- drop ;
+: error. ( error -- ) original-error get die-with2 ;
-: print-error ( error -- ) die consume ;
-
-: error. ( error -- ) die consume ;
+: print-error ( error -- ) error. ;
"threads" vocab [
[
"error-in-thread" "threads" lookup
- [ [ die 2drop ] define ] [ f "combination" set-word-prop ] bi
+ [ [ drop error. ] define ] [ f "combination" set-word-prop ] bi
] with-compilation-unit
] when