steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

started working on catch/throw

cvs
Slava Pestov 2004-07-17 22:35:09 +00:00
parent 6f0b8fb2c7
commit 4f4e27b8c7
15 changed files with 206 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
factor/.FactorInterpreter.java.marks
View File

Binary file not shown.

25
factor/FactorInterpreter.java
View File

@ -38,9 +38,11 @@ public class FactorInterpreter implements FactorObject, Runnable
{
public static final String VERSION = "0.60.6";
// we need to call two words (boot and break) from the kernel
// vocabulary
private static final String KERNEL_VOCAB = "kernel";
// we need to call the 'boot' word from the init vocabulary.
private static final String INIT_VOCAB = "init";
// we need to call the 'throw' word from the errors vocabulary.
private static final String ERRORS_VOCAB = "errors";
// command line arguments are stored here.
public Cons args;
@ -58,6 +60,7 @@ public class FactorInterpreter implements FactorObject, Runnable
public FactorArray callstack = new FactorArray();
public FactorArray datastack = new FactorArray();
public FactorArray namestack = new FactorArray();
public FactorArray catchstack = new FactorArray();
/**
* Maps vocabulary names to vocabularies.
@ -118,6 +121,7 @@ public class FactorInterpreter implements FactorObject, Runnable
this.callstack = (FactorArray)interp.callstack.clone();
this.datastack = (FactorArray)interp.datastack.clone();
this.namestack = (FactorArray)interp.namestack.clone();
this.catchstack = (FactorArray)interp.catchstack.clone();
this.vocabularies = interp.vocabularies;
this.use = interp.use;
this.in = interp.in;
@ -439,7 +443,7 @@ public class FactorInterpreter implements FactorObject, Runnable
call(parser.parse());
}
else
eval(searchVocabulary(KERNEL_VOCAB,"boot"));
eval(searchVocabulary(INIT_VOCAB,"boot"));
//XXX messy
@ -509,15 +513,13 @@ public class FactorInterpreter implements FactorObject, Runnable
datastack.push(error);
try
{
eval(searchVocabulary(KERNEL_VOCAB,"break"));
eval(searchVocabulary(ERRORS_VOCAB,"throw"));
return false;
}
catch(Throwable e2)
{
System.err.println("Exception when calling break:");
System.err.println("Exception when calling throw:");
e.printStackTrace();
System.err.println("Factor callstack:");
System.err.println(callstack);
topLevel();
@ -578,8 +580,8 @@ public class FactorInterpreter implements FactorObject, Runnable
catch(Exception e)
{
callstack.push(callframe);
callframe = createCompiledCallframe(
(FactorWord)obj);
/* callframe = createCompiledCallframe(
(FactorWord)obj); */
while(compiledExceptions != null)
{
callstack.push(compiledExceptions.car);
@ -752,6 +754,9 @@ public class FactorInterpreter implements FactorObject, Runnable
datastack.top = 0;
namestack.top = 0;
namestack.push(global);
catchstack.top = 0;
catchstack.push(searchVocabulary(ERRORS_VOCAB,
"default-error-handler"));
callframe = null;
} //}}}
}

95
library/errors.factor Normal file
View File

@ -0,0 +1,95 @@
!:folding=indent:collapseFolds=1:
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: errors
USE: arithmetic
USE: combinators
USE: continuations
USE: inspector
USE: kernel
USE: lists
USE: namespaces
USE: stack
USE: stdio
USE: strings
USE: unparser
USE: vectors
: catchstack ( -- cs ) catchstack* clone ;
: set-catchstack ( cs -- ) clone set-catchstack* ;
: >c ( catch -- )
#! Push a catch block on the catchstack. Use the catch word
#! instead of invoking this word directly.
catchstack* vector-push ;
: c> ( catch -- )
#! Pop a catch block from the catchstack. Use the catch word
#! instead of invoking this word directly.
catchstack* vector-pop ;
: default-error-handler ( error -- )
#! Print the error and return to the top level.
"Uncaught exception." print
"-------------------" print
terpri
"Datastack:" print
.s
terpri
"Callstack:" print
.r
terpri
"Namestack:" print
.n
terpri
"ERROR: " write error>str print
suspend ;
: save-error ( -- )
#! Save the stacks for most-mortem inspection after an
#! error.
datastack "error-datastack" set
callstack dup vector-pop drop "error-callstack" set
namestack "error-namestack" set
catchstack "error-catchstack" set ;
: catch ( try catch -- )
#! Call the try quotation, restore the datastack to its
#! state before the try quotation, push the error (or f if
#! no error occurred) and call the catch quotation.
[ >c drop call f c> call ] callcc1 ( c> drop )
( try catch error ) rot drop swap ( error catch ) call ;
: rethrow ( error -- )
#! Use rethrow when passing an error on from a catch block.
#! For convinience, this word is a no-op if error is f.
[ c> call ] when* ;
: throw ( error -- )
#! Throw an error. If no catch handlers are installed, the
#! default-error-handler is called.
save-error rethrow ;

12
library/namespaces.factor
View File

@ -76,18 +76,18 @@ USE: vectors
#! Push the current namespace.
namestack* vector-peek ; inline
: bind ( namespace quot -- )
#! Execute a quotation with a new namespace on the namespace
#! stack. Compiles if the quotation compiles.
swap namespace-of >n call n> drop ; inline
: extend ( object code -- object )
#! Used in code like this:
#! : <subclass>
#! <superclass> [
#! ....
#! ] extend ;
over [ bind ] dip ; inline
swap namespace-of >n call n> ; inline
: bind ( namespace quot -- )
#! Execute a quotation with a new namespace on the namespace
#! stack. Compiles if the quotation compiles.
extend drop ; inline
: lazy ( var [ a ] -- value )
#! If the value of the variable is f, set the value to the

10
library/platform/jvm/errors.factor
View File

@ -26,6 +26,12 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: errors
USE: strings
: throw ( obj -- )
[ "java.lang.Object" ] "factor.FactorLib" "error" jinvoke-static ;
: catchstack* ( -- cs )
"factor.FactorInterpreter" "catchstack" jvar-get ;
: set-catchstack* ( cs -- )
"factor.FactorInterpreter" "catchstack" jvar-set ;
: error>str ( error -- str ) >str ;

2
library/platform/native/.kernel.factor.marks
View File

@ -1 +1 @@
!a;771;771
!a;2200;2200

1
library/platform/native/boot.factor
View File

@ -49,6 +49,7 @@ primitives,
"/library/combinators.factor"
"/library/cons.factor"
"/library/continuations.factor"
"/library/errors.factor"
"/library/format.factor"
"/library/hashtables.factor"
"/library/init.factor"

2
library/platform/native/cross-compiler.factor
View File

@ -169,4 +169,6 @@ IN: cross-compiler
"/library/platform/native/boot.factor" run-resource
] with-image
! Uncomment this on sparc and powerpc.
! "big-endian" on
"native/factor.image" write-image ;

52
library/platform/native/errors.factor
View File

@ -27,25 +27,23 @@
IN: errors
USE: arithmetic
USE: combinators
USE: continuations
USE: inspector
USE: kernel
USE: lists
USE: namespaces
USE: stack
USE: stdio
USE: strings
USE: unparser
USE: vectors
! This is a very lightweight exception handling system.
! catch stack
! error? --> top of catch stack, save error continuation,
! restore the continuation there
! restore continuation of 'catch' so that the catch is not in
! scope -- it can throw up.
! if top level catches error, it prints a message.
!
! The kernel throws errors as lists. The first element is an
! integer.
: catchstack* ( -- cs ) 6 getenv ;
: catchstack ( -- cs ) catchstack* clone ;
: set-catchstack* ( cs -- ) 6 setenv ;
: set-catchstack ( cs -- ) clone set-catchstack* ;
: kernel-error? ( obj -- ? )
dup cons? [ car fixnum? ] [ drop f ] ifte ;
@ -62,31 +60,21 @@ USE: unparser
"Underflow"
] ?nth ;
: kernel-error% ( error -- )
car error# % ": " % unparse % ;
: kernel-error>str ( error -- )
<% car error# % ": " % unparse % %> ;
: error>str ( error -- str )
: error>str ( error -- str )
dup kernel-error? [
<% kernel-error% %>
kernel-error>str
] [
unparse
] ifte ;
: default-error-handler ( error -- )
#! Print the error and return to the top level.
"Uncaught exception." print
"-------------------" print
"Datastack:" print
.s
"Callstack:" print
.r
"Namestack:" print
.n
terpri
"ERROR: " write error>str print
suspend ;
: throw ( error -- )
#! Throw an error. If no catch handlers are installed, the
#! default-error-handler is called.
default-error-handler ;
DEFER: >c
DEFER: throw
DEFER: default-error-handler
: init-errors ( -- )
64 <vector> set-catchstack*
[ default-error-handler ] >c
[ throw ] 5 setenv ( kernel calls on error ) ;

17
library/platform/native/image.factor
View File

@ -288,14 +288,27 @@ IN: cross-compiler
: byte2 ( num -- byte ) 8 shift> HEX: ff bitand ;
: byte3 ( num -- byte ) HEX: ff bitand ;
: >little-endian ( word -- word )
: write-little-endian ( word -- )
dup byte3 >char write
dup byte2 >char write
dup byte1 >char write
byte0 >char write ;
: write-big-endian ( word -- )
dup byte0 >char write
dup byte1 >char write
dup byte2 >char write
byte3 >char write ;
: write-word ( word -- )
"big-endian" get [
write-big-endian
] [
write-little-endian
] ifte ;
: write-image ( image file -- )
<filebw> [ [ >little-endian ] vector-each ] with-stream ;
<filebw> [ [ write-word ] vector-each ] with-stream ;
: with-image ( quot -- image )
<namespace> [

12
library/platform/native/init.factor
View File

@ -49,16 +49,6 @@ USE: vocabularies
USE: words
USE: unparser
: init-namespaces ( -- )
64 <vector> set-namestack* global >n ;
: init-stdio ( -- )
stdin stdout <native-stream> <ansi-stream> "stdio" set ;
: init-error-handler ( -- )
#! The kernel calls this quotation when an error is raised.
[ throw ] 5 setenv ;
IN: kernel
: boot ( -- )
@ -70,7 +60,7 @@ IN: kernel
t "interactive" set
init-stdio
init-error-handler
init-errors
init-search-path
init-scratchpad
init-styles

35
library/platform/native/kernel.factor
View File

@ -1,6 +1,37 @@
!:folding=none:collapseFolds=1:
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: namespaces
DEFER: init-namespaces
IN: kernel
USE: arithmetic
USE: combinators
USE: errors
USE: lists
USE: logic
USE: namespaces
@ -52,9 +83,9 @@ USE: words
] cond ;
: toplevel ( -- )
init-namespaces
init-errors
0 <vector> set-datastack
0 <vector> set-namestack
global >n
0 <vector> set-callstack ;
!!! HACK

4
library/platform/native/namespaces.factor
View File

@ -35,6 +35,7 @@ USE: stack
USE: vectors
DEFER: namespace
DEFER: >n
: namestack* ( -- ns ) 3 getenv ;
: set-namestack* ( ns -- ) 3 setenv ;
@ -42,6 +43,9 @@ DEFER: namespace
: global ( -- g ) 4 getenv ;
: set-global ( g -- ) 4 setenv ;
: init-namespaces ( -- )
64 <vector> set-namestack* global >n ;
: namespace-buckets 23 ;
: <namespace> ( -- n )

3
library/platform/native/stream.factor
View File

@ -42,3 +42,6 @@ USE: namespaces
( -- string )
[ "in" get read-line-8 ] "freadln" set
] extend ;
: init-stdio ( -- )
stdin stdout <native-stream> "stdio" set ;

14
native/cons.c
View File

@ -10,18 +10,8 @@ CELL cons(CELL car, CELL cdr)
void primitive_consp(void)
{
switch(TAG(env.dt))
{
case EMPTY_TYPE:
check_non_empty(env.dt);
break;
case CONS_TYPE:
env.dt = T;
break;
default:
env.dt = F;
break;
}
check_non_empty(env.dt);
env.dt = tag_boolean(typep(CONS_TYPE,env.dt));
}
void primitive_cons(void)