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.
15 files changed:
-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
IN: debugger.tests
{ } [ [ drop ] [ error. ] recover ] unit-test
T{ test-failure
{ error
{
T{ test-failure
{ error
{
PREDICATE: vm-error < array
dup length 2 < [ drop f ] [
{
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 ;
[ second-unsafe 0 kernel-error-count 1 - between? ]
} 1&&
] if ;
] unit-test
! set-file-attributes & save-image
] 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 ]
[
"read-only.image" temp-file {
[ ?delete-file ]
] unit-test
: fp-trap-error? ( error -- ? )
] 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? ] ;
: test-traps ( traps inputs quot -- quot' fail-quot )
append '[ _ _ with-fp-traps ] [ fp-trap-error? ] ;
-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 )
IN: typed.tests
TYPED: f+ ( a: float b: float -- c: float )
! [ 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+ ] 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
TUPLE: tweedle-dee ; final
TUPLE: tweedle-dum ; final
-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
IN: arrays.tests
[ -2 { "a" "b" "c" } nth ] must-fail
[ cell-bits cell log2 - 2^ f <array> ] must-fail
! To big for a fixnum #1045
[ 67 2^ 3 <array> ] [
[ cell-bits cell log2 - 2^ f <array> ] must-fail
! To big for a fixnum #1045
[ 67 2^ 3 <array> ] [
- ${ "kernel-error" ERROR-OUT-OF-FIXNUM-RANGE 147573952589676412928 f }
+ ${ KERNEL-ERROR ERROR-OUT-OF-FIXNUM-RANGE 147573952589676412928 f }
[ 444444444444444444444444444444444444444444444444433333 >bignum "asdf" declared-types boa ]
[
[ 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
] must-fail-with
! Check bignum coercer
OBJ-CURRENT-THREAD special-object error-thread set-global
current-continuation error-continuation set-global
[ original-error set-global ] [ rethrow ] bi
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 ;
! Make sure we report the correct error on stack underflow
[ clear drop ] [
! 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 ]
] 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
] must-fail-with
{ } [ :c ] unit-test
- 2 head ${ "kernel-error" ERROR-DATASTACK-OVERFLOW } =
+ 2 head ${ KERNEL-ERROR ERROR-DATASTACK-OVERFLOW } =
] must-fail-with
{ } [ :c ] unit-test
[ overflow-d-alt ] [
] 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 ] [
] 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
] must-fail-with
{ } [ :c ] unit-test
CONSTANT: OBJ-CALLCC-1 4
CONSTANT: ERROR-HANDLER-QUOT 5
CONSTANT: OBJ-CALLCC-1 4
CONSTANT: ERROR-HANDLER-QUOT 5
CONSTANT: OBJ-CELL-SIZE 7
CONSTANT: OBJ-CPU 8
CONSTANT: OBJ-CELL-SIZE 7
CONSTANT: OBJ-CPU 8
! basis/debugger/debugger.factor
! vm/errors.hpp
! 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
CONSTANT: kernel-error-count 20
CONSTANT: ERROR-EXPIRED 0
! Random tester found this
[ 2 -7 resize-string ]
! 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
! Make sure 24-bit strings work
"hello world" "s" set
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
! 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 } [
IN: decimals.tests
{ t } [
1000 [
drop
[ [ 100 D/ ] [ /f ] test-decimal-op ]
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
] all-integers?
] unit-test
/* Now its safe to allocate and GC */
cell error_object =
/* 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);
arg1.value(), arg2.value());
ctx->push(error_object);
// Runtime errors must be kept in sync with:
// basis/debugger/debugger.factor
// core/kernel/kernel.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,
enum vm_error_type {
ERROR_EXPIRED = 0,
ERROR_IO,
OBJ_CALLCC_1, /* used to pass the value in callcc1 */
ERROR_HANDLER_QUOT = 5, /* quotation called when VM throws an error */
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 */
OBJ_CELL_SIZE = 7, /* sizeof(cell) */
OBJ_CPU, /* CPU architecture */