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

@@ -1,5 +1,5 @@
-USING: accessors alien.syntax continuations debugger kernel literals
+USING: accessors alien.syntax continuations debugger kernel
-namespaces tools.test ;
+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{

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 ;

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 ]

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? ] ;

basis/typed/typed-tests.factor

@@ -1,7 +1,7 @@
-USING: accessors effects eval kernel layouts math namespaces
+USING: accessors compiler.units effects eval kernel kernel.private layouts
-quotations tools.test typed words words.symbol combinators.short-circuit
+literals math namespaces quotations tools.test typed words words.symbol
-compiler.tree.debugger prettyprint definitions compiler.units sequences
+combinators.short-circuit compiler.tree.debugger prettyprint definitions
-classes.intersection strings classes.union ;
+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

core/arrays/arrays-tests.factor

@@ -1,6 +1,5 @@
-USING: accessors arrays kernel kernel.private literals sequences
+USING: accessors arrays kernel kernel.private layouts literals math
-sequences.private growable tools.test vectors layouts system math
+sequences tools.test vectors ;
-vectors.private ;
 IN: arrays.tests
 
 [ -2 { "a" "b" "c" } nth ] must-fail
@@ -22,7 +21,7 @@ IN: arrays.tests
 [ 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 }
     =
 ] must-fail-with
 

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

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
+    ] 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 ;
 
 PRIVATE>

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

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

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

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
+USING: continuations decimals grouping kernel kernel.private literals
-math math.functions math.order math.ratios prettyprint random
+locals math math.functions math.order random tools.test ;
-sequences tools.test kernel.private ;
 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
 

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);
 

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,

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 */