Fix init-hook regression

db4
Slava Pestov 2008-02-28 01:20:27 -06:00
parent 13290fcd82
commit 7c24a78281
3 changed files with 20 additions and 20 deletions

View File

@ -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? [

View File

@ -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

8
core/libc/libc.factor Normal file → Executable file
View File

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