Fix init-hook regression
parent
13290fcd82
commit
7c24a78281
|
@ -6,7 +6,7 @@ strings io.styles vectors words system splitting math.parser
|
||||||
tuples continuations continuations.private combinators
|
tuples continuations continuations.private combinators
|
||||||
generic.math io.streams.duplex classes compiler.units
|
generic.math io.streams.duplex classes compiler.units
|
||||||
generic.standard vocabs threads threads.private init
|
generic.standard vocabs threads threads.private init
|
||||||
kernel.private ;
|
kernel.private libc ;
|
||||||
IN: debugger
|
IN: debugger
|
||||||
|
|
||||||
GENERIC: error. ( error -- )
|
GENERIC: error. ( error -- )
|
||||||
|
@ -63,20 +63,9 @@ M: string error. print ;
|
||||||
[ global [ "Error in print-error!" print drop ] bind ]
|
[ global [ "Error in print-error!" print drop ] bind ]
|
||||||
recover ;
|
recover ;
|
||||||
|
|
||||||
: error-in-thread. ( -- )
|
|
||||||
error-thread get-global
|
|
||||||
"Error in thread " write
|
|
||||||
[
|
|
||||||
dup thread-id #
|
|
||||||
" (" % dup thread-name %
|
|
||||||
", " % dup thread-quot unparse-short % ")" %
|
|
||||||
] "" make
|
|
||||||
swap write-object ":" print nl ;
|
|
||||||
|
|
||||||
SYMBOL: error-hook
|
SYMBOL: error-hook
|
||||||
|
|
||||||
[
|
[
|
||||||
error-in-thread.
|
|
||||||
print-error
|
print-error
|
||||||
restarts.
|
restarts.
|
||||||
nl
|
nl
|
||||||
|
@ -265,6 +254,24 @@ M: no-compilation-unit error.
|
||||||
M: no-vocab summary
|
M: no-vocab summary
|
||||||
drop "Vocabulary does not exist" ;
|
drop "Vocabulary does not exist" ;
|
||||||
|
|
||||||
|
M: check-ptr summary
|
||||||
|
drop "Memory allocation failed" ;
|
||||||
|
|
||||||
|
M: double-free summary
|
||||||
|
drop "Free failed since memory is not allocated" ;
|
||||||
|
|
||||||
|
M: realloc-error summary
|
||||||
|
drop "Memory reallocation failed" ;
|
||||||
|
|
||||||
|
: error-in-thread. ( -- )
|
||||||
|
error-thread get-global
|
||||||
|
"Error in thread " write
|
||||||
|
[
|
||||||
|
dup thread-id #
|
||||||
|
" (" % dup thread-name %
|
||||||
|
", " % dup thread-quot unparse-short % ")" %
|
||||||
|
] "" make swap write-object ":" print nl ;
|
||||||
|
|
||||||
! Hooks
|
! Hooks
|
||||||
M: thread error-in-thread ( error thread -- )
|
M: thread error-in-thread ( error thread -- )
|
||||||
initial-thread get-global eq? [
|
initial-thread get-global eq? [
|
||||||
|
|
|
@ -142,7 +142,6 @@ DEFER: copy-tree-to
|
||||||
|
|
||||||
: copy-tree ( from to -- )
|
: copy-tree ( from to -- )
|
||||||
over directory? [
|
over directory? [
|
||||||
dup make-directories
|
|
||||||
>r dup directory swap r> [
|
>r dup directory swap r> [
|
||||||
>r swap first path+ r> copy-tree-to
|
>r swap first path+ r> copy-tree-to
|
||||||
] 2curry each
|
] 2curry each
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! Copyright (C) 2007 Slava Pestov
|
! Copyright (C) 2007 Slava Pestov
|
||||||
! Copyright (C) 2007 Doug Coleman
|
! Copyright (C) 2007 Doug Coleman
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien assocs continuations init inspector kernel namespaces ;
|
USING: alien assocs continuations init kernel namespaces ;
|
||||||
IN: libc
|
IN: libc
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
@ -25,22 +25,16 @@ PRIVATE>
|
||||||
|
|
||||||
TUPLE: check-ptr ;
|
TUPLE: check-ptr ;
|
||||||
|
|
||||||
M: check-ptr summary drop "Memory allocation failed" ;
|
|
||||||
|
|
||||||
: check-ptr ( c-ptr -- c-ptr )
|
: check-ptr ( c-ptr -- c-ptr )
|
||||||
[ \ check-ptr construct-boa throw ] unless* ;
|
[ \ check-ptr construct-boa throw ] unless* ;
|
||||||
|
|
||||||
TUPLE: double-free ;
|
TUPLE: double-free ;
|
||||||
|
|
||||||
M: double-free summary drop "Free failed since memory is not allocated" ;
|
|
||||||
|
|
||||||
: double-free ( -- * )
|
: double-free ( -- * )
|
||||||
\ double-free construct-empty throw ;
|
\ double-free construct-empty throw ;
|
||||||
|
|
||||||
TUPLE: realloc-error ptr size ;
|
TUPLE: realloc-error ptr size ;
|
||||||
|
|
||||||
M: realloc-error summary drop "Memory reallocation failed" ;
|
|
||||||
|
|
||||||
: realloc-error ( alien size -- * )
|
: realloc-error ( alien size -- * )
|
||||||
\ realloc-error construct-boa throw ;
|
\ realloc-error construct-boa throw ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue