From 579875821b687e957b015c6ac5d15310fd8991ea Mon Sep 17 00:00:00 2001 From: =?utf8?q?Bj=C3=B6rn=20Lindqvist?= Date: Tue, 22 Mar 2016 15:56:41 +0100 Subject: [PATCH] VM: removes the OBJ-ERROR special object in favor of a constant The special object contained the string "kernel-error" which were used to tag VM errors. But it is simplier and removes a little complexity to just tag them with a fixnum constant. --- basis/debugger/debugger-tests.factor | 6 +++--- basis/debugger/debugger.factor | 2 +- basis/io/files/windows/windows-tests.factor | 2 +- basis/math/floats/env/env-tests.factor | 2 +- basis/typed/typed-tests.factor | 10 +++++----- core/arrays/arrays-tests.factor | 7 +++---- core/classes/tuple/tuple-tests.factor | 3 ++- core/continuations/continuations.factor | 5 +---- core/kernel/kernel-tests.factor | 10 +++++----- core/kernel/kernel.factor | 4 +++- core/strings/strings-tests.factor | 2 +- extra/decimals/decimals-tests.factor | 7 +++---- vm/errors.cpp | 2 +- vm/errors.hpp | 2 ++ vm/objects.hpp | 1 - 15 files changed, 32 insertions(+), 33 deletions(-) diff --git a/basis/debugger/debugger-tests.factor b/basis/debugger/debugger-tests.factor index 52b5f559ba..a2aaf0df9d 100644 --- a/basis/debugger/debugger-tests.factor +++ b/basis/debugger/debugger-tests.factor @@ -1,5 +1,5 @@ -USING: accessors alien.syntax continuations debugger kernel literals -namespaces tools.test ; +USING: accessors alien.syntax continuations debugger kernel +kernel.private literals namespaces tools.test ; IN: debugger.tests { } [ [ drop ] [ error. ] recover ] unit-test @@ -11,7 +11,7 @@ IN: debugger.tests T{ test-failure { error { - "kernel-error" + $[ KERNEL-ERROR ] 10 { B{ diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 3857a0328a..866a5685d3 100755 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -151,7 +151,7 @@ HOOK: signal-error. os ( obj -- ) PREDICATE: vm-error < array dup length 2 < [ drop f ] [ { - [ first-unsafe "kernel-error" = ] + [ first-unsafe KERNEL-ERROR = ] [ second-unsafe 0 kernel-error-count 1 - between? ] } 1&& ] if ; diff --git a/basis/io/files/windows/windows-tests.factor b/basis/io/files/windows/windows-tests.factor index c9fb8e1f9b..29f12f11f1 100644 --- a/basis/io/files/windows/windows-tests.factor +++ b/basis/io/files/windows/windows-tests.factor @@ -68,7 +68,7 @@ IN: io.files.windows.tests ] unit-test ! set-file-attributes & save-image -{ ${ "kernel-error" ERROR-IO EIO f } } [ +{ ${ KERNEL-ERROR ERROR-IO EIO f } } [ [ "read-only.image" temp-file { [ ?delete-file ] diff --git a/basis/math/floats/env/env-tests.factor b/basis/math/floats/env/env-tests.factor index 81ee34a26a..e2522e568b 100755 --- a/basis/math/floats/env/env-tests.factor +++ b/basis/math/floats/env/env-tests.factor @@ -111,7 +111,7 @@ os linux? cpu x86.64? and [ ] unit-test : fp-trap-error? ( error -- ? ) - 2 head ${ "kernel-error" ERROR-FP-TRAP } = ; + 2 head ${ KERNEL-ERROR ERROR-FP-TRAP } = ; : test-traps ( traps inputs quot -- quot' fail-quot ) append '[ _ _ with-fp-traps ] [ fp-trap-error? ] ; diff --git a/basis/typed/typed-tests.factor b/basis/typed/typed-tests.factor index 78ec21dc2b..6254813943 100644 --- a/basis/typed/typed-tests.factor +++ b/basis/typed/typed-tests.factor @@ -1,7 +1,7 @@ -USING: accessors effects eval kernel layouts math namespaces -quotations tools.test typed words words.symbol combinators.short-circuit -compiler.tree.debugger prettyprint definitions compiler.units sequences -classes.intersection strings classes.union ; +USING: accessors compiler.units effects eval kernel kernel.private layouts +literals math namespaces quotations tools.test typed words words.symbol +combinators.short-circuit compiler.tree.debugger prettyprint definitions +sequences classes.intersection strings classes.union ; IN: typed.tests TYPED: f+ ( a: float b: float -- c: float ) @@ -18,7 +18,7 @@ TYPED: fix+ ( a: fixnum b: fixnum -- c: fixnum ) ! [ most-positive-fixnum 1 fix+ ] unit-test ! XXX: Check that we throw an error. This used to underflow to the least-positive-fixnum. -[ most-positive-fixnum 1 fix+ ] [ { "kernel-error" 7 } head? ] must-fail-with +[ most-positive-fixnum 1 fix+ ] [ ${ KERNEL-ERROR 7 } head? ] must-fail-with TUPLE: tweedle-dee ; final TUPLE: tweedle-dum ; final diff --git a/core/arrays/arrays-tests.factor b/core/arrays/arrays-tests.factor index aa162751af..dc2683ee0f 100644 --- a/core/arrays/arrays-tests.factor +++ b/core/arrays/arrays-tests.factor @@ -1,6 +1,5 @@ -USING: accessors arrays kernel kernel.private literals sequences -sequences.private growable tools.test vectors layouts system math -vectors.private ; +USING: accessors arrays kernel kernel.private layouts literals math +sequences tools.test vectors ; IN: arrays.tests [ -2 { "a" "b" "c" } nth ] must-fail @@ -22,7 +21,7 @@ IN: arrays.tests [ cell-bits cell log2 - 2^ f ] must-fail ! To big for a fixnum #1045 [ 67 2^ 3 ] [ - ${ "kernel-error" ERROR-OUT-OF-FIXNUM-RANGE 147573952589676412928 f } + ${ KERNEL-ERROR ERROR-OUT-OF-FIXNUM-RANGE 147573952589676412928 f } = ] must-fail-with diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index c702cc03a6..7c2c1f0ca1 100644 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -548,7 +548,8 @@ must-fail-with [ 444444444444444444444444444444444444444444444444433333 >bignum "asdf" declared-types boa ] [ - ${ "kernel-error" ERROR-OUT-OF-FIXNUM-RANGE 444444444444444444444444444444444444444444444444433333 f } = + ${ KERNEL-ERROR ERROR-OUT-OF-FIXNUM-RANGE + 444444444444444444444444444444444444444444444444433333 f } = ] must-fail-with ! Check bignum coercer diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor index c7507a147a..220cef3e8d 100644 --- a/core/continuations/continuations.factor +++ b/core/continuations/continuations.factor @@ -204,9 +204,6 @@ M: condition compute-restarts OBJ-CURRENT-THREAD special-object error-thread set-global current-continuation error-continuation set-global [ original-error set-global ] [ rethrow ] bi - ] ERROR-HANDLER-QUOT set-special-object - ! VM adds this to kernel errors, so that user-space - ! can identify them - "kernel-error" OBJ-ERROR set-special-object ; + ] ERROR-HANDLER-QUOT set-special-object ; PRIVATE> diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor index c461bba7d2..f779a8744e 100644 --- a/core/kernel/kernel-tests.factor +++ b/core/kernel/kernel-tests.factor @@ -30,14 +30,14 @@ IN: kernel.tests ! Make sure we report the correct error on stack underflow [ clear drop ] [ - 2 head ${ "kernel-error" ERROR-DATASTACK-UNDERFLOW } = + 2 head ${ KERNEL-ERROR ERROR-DATASTACK-UNDERFLOW } = ] must-fail-with { } [ :c ] unit-test [ 3 [ { } set-retainstack ] dip ] - [ 2 head ${ "kernel-error" ERROR-RETAINSTACK-UNDERFLOW } = + [ 2 head ${ KERNEL-ERROR ERROR-RETAINSTACK-UNDERFLOW } = ] must-fail-with { } [ :c ] unit-test @@ -56,19 +56,19 @@ IN: kernel.tests >> [ overflow-d ] [ - 2 head ${ "kernel-error" ERROR-DATASTACK-OVERFLOW } = + 2 head ${ KERNEL-ERROR ERROR-DATASTACK-OVERFLOW } = ] must-fail-with { } [ :c ] unit-test [ overflow-d-alt ] [ - 2 head ${ "kernel-error" ERROR-DATASTACK-OVERFLOW } = + 2 head ${ KERNEL-ERROR ERROR-DATASTACK-OVERFLOW } = ] must-fail-with { } [ [ :c ] with-string-writer drop ] unit-test [ overflow-r ] [ - 2 head ${ "kernel-error" ERROR-RETAINSTACK-OVERFLOW } = + 2 head ${ KERNEL-ERROR ERROR-RETAINSTACK-OVERFLOW } = ] must-fail-with { } [ :c ] unit-test diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index 7821a6abea..4b53ca0ac7 100644 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -316,7 +316,6 @@ CONSTANT: OBJ-WALKER-HOOK 3 CONSTANT: OBJ-CALLCC-1 4 CONSTANT: ERROR-HANDLER-QUOT 5 -CONSTANT: OBJ-ERROR 6 CONSTANT: OBJ-CELL-SIZE 7 CONSTANT: OBJ-CPU 8 @@ -428,6 +427,9 @@ CONSTANT: CONTEXT-OBJ-IN-CALLBACK-P 3 ! basis/debugger/debugger.factor ! vm/errors.hpp +! VM adds this to kernel errors, so that user-space can identify them. +CONSTANT: KERNEL-ERROR 0xfac7 + CONSTANT: kernel-error-count 20 CONSTANT: ERROR-EXPIRED 0 diff --git a/core/strings/strings-tests.factor b/core/strings/strings-tests.factor index 7429a83676..e676d92406 100644 --- a/core/strings/strings-tests.factor +++ b/core/strings/strings-tests.factor @@ -59,7 +59,7 @@ unit-test ! Random tester found this [ 2 -7 resize-string ] -[ ${ "kernel-error" ERROR-TYPE 11 -7 } = ] must-fail-with +[ ${ KERNEL-ERROR ERROR-TYPE 11 -7 } = ] must-fail-with ! Make sure 24-bit strings work "hello world" "s" set diff --git a/extra/decimals/decimals-tests.factor b/extra/decimals/decimals-tests.factor index 3b09d3b19d..4a9baced07 100644 --- a/extra/decimals/decimals-tests.factor +++ b/extra/decimals/decimals-tests.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: continuations decimals grouping kernel literals locals -math math.functions math.order math.ratios prettyprint random -sequences tools.test kernel.private ; +USING: continuations decimals grouping kernel kernel.private literals +locals math math.functions math.order random tools.test ; IN: decimals.tests { t } [ @@ -33,7 +32,7 @@ ERROR: decimal-test-failure D1 D2 quot ; 1000 [ drop [ [ 100 D/ ] [ /f ] test-decimal-op ] - [ ${ "kernel-error" ERROR-DIVIDE-BY-ZERO f f } = ] recover + [ ${ KERNEL-ERROR ERROR-DIVIDE-BY-ZERO f f } = ] recover ] all-integers? ] unit-test diff --git a/vm/errors.cpp b/vm/errors.cpp index 8a22337149..c445748711 100644 --- a/vm/errors.cpp +++ b/vm/errors.cpp @@ -57,7 +57,7 @@ void factor_vm::general_error(vm_error_type error, cell arg1_, cell arg2_) { /* Now its safe to allocate and GC */ cell error_object = - allot_array_4(special_objects[OBJ_ERROR], tag_fixnum(error), + allot_array_4(tag_fixnum(KERNEL_ERROR), tag_fixnum(error), arg1.value(), arg2.value()); ctx->push(error_object); diff --git a/vm/errors.hpp b/vm/errors.hpp index 57f0204831..068fa104f9 100644 --- a/vm/errors.hpp +++ b/vm/errors.hpp @@ -3,6 +3,8 @@ namespace factor { // Runtime errors must be kept in sync with: // basis/debugger/debugger.factor // core/kernel/kernel.factor +#define KERNEL_ERROR 0xfac7 + enum vm_error_type { ERROR_EXPIRED = 0, ERROR_IO, diff --git a/vm/objects.hpp b/vm/objects.hpp index 78ff2b23ab..ee9ae61f2c 100644 --- a/vm/objects.hpp +++ b/vm/objects.hpp @@ -11,7 +11,6 @@ enum special_object { OBJ_CALLCC_1, /* used to pass the value in callcc1 */ ERROR_HANDLER_QUOT = 5, /* quotation called when VM throws an error */ - OBJ_ERROR, /* a marker consed onto kernel errors */ OBJ_CELL_SIZE = 7, /* sizeof(cell) */ OBJ_CPU, /* CPU architecture */ -- 2.34.1