The included patch requires a new file t/op/exceptions.t, which tests basic exception
handling, in this case divide-by-zero.
Patch was generated against latest CVS, but it shouldn't matter -that- much.
-Jeff
<[EMAIL PROTECTED]>
diff --recursive -C 2 parrot_cvs/MANIFEST parrot/MANIFEST
*** parrot_cvs/MANIFEST Wed Oct 24 07:36:57 2001
--- parrot/MANIFEST Wed Oct 24 07:37:22 2001
***************
*** 108,111 ****
--- 108,112 ----
t/op/basic.t
t/op/bitwise.t
+ t/op/exception.t
t/op/integer.t
t/op/number.t
Only in parrot/: Makefile
diff --recursive -C 2 parrot_cvs/Parrot/Assembler.pm parrot/Parrot/Assembler.pm
*** parrot_cvs/Parrot/Assembler.pm Wed Oct 24 07:36:57 2001
--- parrot/Parrot/Assembler.pm Wed Oct 24 07:54:22 2001
***************
*** 110,114 ****
=cut
! my(%type_to_suffix)=('I'=>'i', 'N'=>'n',
'S'=>'s', 'P'=>'p',
'i'=>'ic', 'n'=>'nc',
--- 110,115 ----
=cut
! my(%type_to_suffix)=('E'=>'e',
! 'I'=>'i', 'N'=>'n',
'S'=>'s', 'P'=>'p',
'i'=>'ic', 'n'=>'nc',
***************
*** 923,927 ****
#
! if (m/^([INPS])\d+$/) { # a register.
push @arg_t,lc($1);
} elsif (m/^\[([a-z]+):(\d+)\s*\]$/) { # string constant
--- 924,928 ----
#
! if (m/^([EINPS])\d+$/) { # a register.
push @arg_t,lc($1);
} elsif (m/^\[([a-z]+):(\d+)\s*\]$/) { # string constant
***************
*** 945,949 ****
#
! my @grep_ops = grep($_ =~ /^$opcode(?:_(?:(?:[ins]c?)|p))+$/, keys(%opcodes));
foreach my $op (@grep_ops) {
--- 946,950 ----
#
! my @grep_ops = grep($_ =~ /^$opcode(?:_(?:(?:[eins]c?)|p))+$/, keys(%opcodes));
foreach my $op (@grep_ops) {
***************
*** 1056,1059 ****
--- 1057,1061 ----
my %rtype_map = (
+ "e" => "E",
"i" => "I",
"n" => "N",
***************
*** 1092,1100 ****
#
! if($rtype eq "I" || $rtype eq "N" || $rtype eq "P" || $rtype eq "S") {
# its a register argument
! $args[$_] =~ s/^[INPS](\d+)$/$1/i
! or error("Expected m/[INPS]\\d+/, but got '$args[$_]'!", $file, $line);
error("Register $1 out of range (should be 0-31) in '$opcode'",$file,$line) if
$1 < 0 or $1 > 31;
--- 1094,1102 ----
#
! if($rtype eq "E" || $rtype eq "I" || $rtype eq "N" || $rtype eq "P" || $rtype eq
"S") {
# its a register argument
! $args[$_] =~ s/^[EINPS](\d+)$/$1/i
! or error("Expected m/[EINPS]\\d+/, but got '$args[$_]'!", $file, $line);
error("Register $1 out of range (should be 0-31) in '$opcode'",$file,$line) if
$1 < 0 or $1 > 31;
Only in parrot/Parrot: Config.pm
Only in parrot/Parrot: Types.pm
diff --recursive -C 2 parrot_cvs/Types_pm.in parrot/Types_pm.in
*** parrot_cvs/Types_pm.in Wed Oct 24 07:36:57 2001
--- parrot/Types_pm.in Wed Oct 24 07:39:58 2001
***************
*** 35,38 ****
--- 35,39 ----
my %how_to_pack = (
+ E => $pack_type{op},
I => $pack_type{op},
i => $pack_type{op},
Only in parrot/classes: intclass.o
diff --recursive -C 2 parrot_cvs/config_h.in parrot/config_h.in
*** parrot_cvs/config_h.in Wed Oct 24 07:36:57 2001
--- parrot/config_h.in Wed Oct 24 07:53:11 2001
***************
*** 24,31 ****
--- 24,33 ----
#define FRAMES_PER_PMC_REG_CHUNK FRAMES_PER_CHUNK
#define FRAMES_PER_NUM_REG_CHUNK FRAMES_PER_CHUNK
+ #define FRAMES_PER_EXC_REG_CHUNK FRAMES_PER_CHUNK
#define FRAMES_PER_INT_REG_CHUNK FRAMES_PER_CHUNK
#define FRAMES_PER_STR_REG_CHUNK FRAMES_PER_CHUNK
#define MASK_STACK_CHUNK_LOW_BITS ${stacklow}
+ #define MASK_EXC_CHUNK_LOW_BITS ${intlow}
#define MASK_INT_CHUNK_LOW_BITS ${intlow}
#define MASK_NUM_CHUNK_LOW_BITS ${numlow}
diff --recursive -C 2 parrot_cvs/core.ops parrot/core.ops
*** parrot_cvs/core.ops Wed Oct 24 07:36:57 2001
--- parrot/core.ops Wed Oct 24 07:56:30 2001
***************
*** 120,123 ****
--- 120,127 ----
########################################
+ =item B<set>(e, i)
+
+ =item B<set>(i, e)
+
=item B<set>(i, i)
***************
*** 136,141 ****
=cut
! AUTO_OP set(i, i|ic) {
$1 = $2;
}
--- 140,148 ----
=cut
+ AUTO_OP set(e, i) {
+ $1 = $2;
+ }
! AUTO_OP set(i, e|i|ic) {
$1 = $2;
}
***************
*** 684,688 ****
AUTO_OP div(i, i|ic, i|ic) {
! $1 = $2 / $3;
}
--- 691,701 ----
AUTO_OP div(i, i|ic, i|ic) {
! INTVAL z = $3;
!
! if(z == 0) {
! interpreter->exc_reg->registers[0] = 1;
! } else {
! $1 = $2 / $3;
! }
}
***************
*** 1504,1507 ****
--- 1517,1522 ----
########################################
+ =item B<pope>()
+
=item B<popi>()
***************
*** 1517,1520 ****
--- 1532,1539 ----
=cut
+ AUTO_OP pope() {
+ Parrot_pop_e(interpreter);
+ }
+
AUTO_OP popi() {
Parrot_pop_i(interpreter);
***************
*** 1536,1539 ****
--- 1555,1560 ----
########################################
+ =item B<pushe>()
+
=item B<pushi>()
***************
*** 1547,1550 ****
--- 1568,1575 ----
=cut
+
+ AUTO_OP pushe() {
+ Parrot_push_e(interpreter);
+ }
AUTO_OP pushi() {
diff --recursive -C 2 parrot_cvs/disassemble.pl parrot/disassemble.pl
*** parrot_cvs/disassemble.pl Wed Oct 24 07:36:57 2001
--- parrot/disassemble.pl Wed Oct 24 07:43:50 2001
***************
*** 119,122 ****
--- 119,123 ----
my %rtype_map = (
+ "e" => "E",
"i" => "I",
"n" => "N",
***************
*** 187,191 ****
$offset += $unpack_size;
! if($type =~ m/^[INPS]$/) { # Register
push @{$pasm{$op_start}[3]}, $type . $arg;
} elsif($type eq "D") { # destination address
--- 188,192 ----
$offset += $unpack_size;
! if($type =~ m/^[EINPS]$/) { # Register
push @{$pasm{$op_start}[3]}, $type . $arg;
} elsif($type eq "D") { # destination address
Only in parrot/include/parrot: config.h
diff --recursive -C 2 parrot_cvs/include/parrot/interpreter.h
parrot/include/parrot/interpreter.h
*** parrot_cvs/include/parrot/interpreter.h Wed Oct 24 07:36:57 2001
--- parrot/include/parrot/interpreter.h Wed Oct 24 07:44:53 2001
***************
*** 19,22 ****
--- 19,23 ----
struct Parrot_Interp {
+ struct EReg *exc_reg; /* Current top of exception reg stack */
struct IReg *int_reg; /* Current top of int reg stack */
struct NReg *num_reg; /* Current top of the float reg stack */
***************
*** 24,27 ****
--- 25,29 ----
struct PReg *pmc_reg; /* Current top of the PMC stack */
struct Stack_Entry *stack_top; /* Current top of the generic stack */
+ struct ERegChunk *exc_reg_base; /* base of the exc reg stack */
struct IRegChunk *int_reg_base; /* base of the int reg stack */
struct NRegChunk *num_reg_base; /* Base of the float reg stack */
diff --recursive -C 2 parrot_cvs/include/parrot/op.h parrot/include/parrot/op.h
*** parrot_cvs/include/parrot/op.h Wed Oct 24 07:36:57 2001
--- parrot/include/parrot/op.h Wed Oct 24 07:45:18 2001
***************
*** 31,34 ****
--- 31,35 ----
PARROT_ARG_SC,
+ PARROT_ARG_E,
PARROT_ARG_I,
PARROT_ARG_N,
diff --recursive -C 2 parrot_cvs/include/parrot/register.h
parrot/include/parrot/register.h
*** parrot_cvs/include/parrot/register.h Wed Oct 24 07:36:57 2001
--- parrot/include/parrot/register.h Wed Oct 24 07:46:50 2001
***************
*** 16,19 ****
--- 16,23 ----
#include "parrot/parrot.h"
+ struct EReg {
+ INTVAL registers[NUM_REGISTERS];
+ };
+
struct IReg {
INTVAL registers[NUM_REGISTERS];
***************
*** 32,35 ****
--- 36,47 ----
};
+ struct ERegChunk {
+ INTVAL used;
+ INTVAL free;
+ struct ERegChunk *next;
+ struct ERegChunk *prev;
+ struct EReg EReg[FRAMES_PER_CHUNK];
+ };
+
struct IRegChunk {
INTVAL used;
***************
*** 66,69 ****
--- 78,82 ----
/* These macros masks off the low bits of a register chunk address,
since we're guaranteed to be aligned */
+ #define EXC_CHUNK_BASE(x) (void *)(MASK_EXC_CHUNK_LOW_BITS & (ptrcast_t)x)
#define INT_CHUNK_BASE(x) (void *)(MASK_INT_CHUNK_LOW_BITS & (ptrcast_t)x)
#define NUM_CHUNK_BASE(x) (void *)(MASK_NUM_CHUNK_LOW_BITS & (ptrcast_t)x)
***************
*** 76,79 ****
--- 89,93 ----
void Parrot_clear_n(struct Parrot_Interp *);
+ void Parrot_push_e(struct Parrot_Interp *);
void Parrot_push_i(struct Parrot_Interp *);
void Parrot_push_n(struct Parrot_Interp *);
***************
*** 86,89 ****
--- 100,104 ----
void Parrot_clone_p(struct Parrot_Interp *);
+ void Parrot_pop_e(struct Parrot_Interp *);
void Parrot_pop_i(struct Parrot_Interp *);
void Parrot_pop_n(struct Parrot_Interp *);
diff --recursive -C 2 parrot_cvs/interpreter.c parrot/interpreter.c
*** parrot_cvs/interpreter.c Wed Oct 24 07:36:57 2001
--- parrot/interpreter.c Wed Oct 24 07:47:56 2001
***************
*** 128,131 ****
--- 128,132 ----
/* Set up the initial register chunks */
+ interpreter->exc_reg_base = mem_allocate_aligned(sizeof(struct ERegChunk));
interpreter->int_reg_base = mem_allocate_aligned(sizeof(struct IRegChunk));
interpreter->num_reg_base = mem_allocate_aligned(sizeof(struct NRegChunk));
***************
*** 134,141 ****
--- 135,149 ----
/* Set up the initial register frame pointers */
+ interpreter->exc_reg = &interpreter->exc_reg_base->EReg[0];
interpreter->int_reg = &interpreter->int_reg_base->IReg[0];
interpreter->num_reg = &interpreter->num_reg_base->NReg[0];
interpreter->string_reg = &interpreter->string_reg_base->SReg[0];
interpreter->pmc_reg = &interpreter->pmc_reg_base->PReg[0];
+
+ /* Initialize the exception register chunk */
+ interpreter->exc_reg_base->used = 1;
+ interpreter->exc_reg_base->free = FRAMES_PER_EXC_REG_CHUNK - 1;
+ interpreter->exc_reg_base->next = NULL;
+ interpreter->exc_reg_base->prev = NULL;
/* Initialize the integer register chunk */
diff --recursive -C 2 parrot_cvs/ops2c.pl parrot/ops2c.pl
*** parrot_cvs/ops2c.pl Wed Oct 24 07:36:57 2001
--- parrot/ops2c.pl Wed Oct 24 07:48:19 2001
***************
*** 221,224 ****
--- 221,225 ----
'op' => "cur_opcode[%ld]",
+ 'e' => "interpreter->exc_reg->registers[cur_opcode[%ld]]",
'i' => "interpreter->int_reg->registers[cur_opcode[%ld]]",
'n' => "interpreter->num_reg->registers[cur_opcode[%ld]]",
diff --recursive -C 2 parrot_cvs/pbc2c.pl parrot/pbc2c.pl
*** parrot_cvs/pbc2c.pl Wed Oct 24 07:36:57 2001
--- parrot/pbc2c.pl Wed Oct 24 07:48:44 2001
***************
*** 208,211 ****
--- 208,212 ----
my %arg_maps = (
+ 'e' => "interpreter->exc_reg->registers[%ld]",
'i' => "interpreter->int_reg->registers[%ld]",
'n' => "interpreter->num_reg->registers[%ld]",
diff --recursive -C 2 parrot_cvs/register.c parrot/register.c
*** parrot_cvs/register.c Wed Oct 24 07:36:57 2001
--- parrot/register.c Wed Oct 24 07:51:19 2001
***************
*** 13,16 ****
--- 13,42 ----
#include "parrot/parrot.h"
+ /*=for api register Parrot_push_e
+ pushes a new exception register frame on the frame stack
+ */
+ void
+ Parrot_push_e(struct Parrot_Interp *interpreter) {
+ struct ERegChunk *chunk_base;
+
+ chunk_base = EXC_CHUNK_BASE(interpreter->exc_reg);
+ /* Do we have any slots left in the current chunk? */
+ if (chunk_base->free) {
+ interpreter->exc_reg = &chunk_base->EReg[chunk_base->used++];
+ chunk_base->free--;
+ }
+ /* Nope, so plan B time. Allocate a new chunk of exc register frames */
+ else {
+ struct ERegChunk *new_chunk;
+ new_chunk = mem_allocate_aligned(sizeof(struct ERegChunk));
+ new_chunk->used = 1;
+ new_chunk->free = FRAMES_PER_EXC_REG_CHUNK - 1;
+ new_chunk->next = NULL;
+ new_chunk->prev = chunk_base;
+ chunk_base->next = new_chunk;
+ interpreter->exc_reg = &new_chunk->EReg[0];
+ }
+ }
+
/*=for api register Parrot_push_i
pushes a new integer register frame on the frame stack
***************
*** 69,72 ****
--- 95,127 ----
sizeof(struct IReg));
interpreter->int_reg = &new_chunk->IReg[0];
+ }
+ }
+
+ /*=for api register Parrot_pop_e
+ pops an exception register frame off of the frame stack
+ */
+ void
+ Parrot_pop_e(struct Parrot_Interp *interpreter) {
+ struct ERegChunk *chunk_base;
+ chunk_base = EXC_CHUNK_BASE(interpreter->exc_reg);
+ /* Is there more than one register frame in use? */
+ if (chunk_base->used > 1) {
+ chunk_base->used--;
+ chunk_base->free++;
+ interpreter->exc_reg = &chunk_base->EReg[chunk_base->used - 1];
+ }
+ /* nope. Walk back */
+ else {
+ /* Can we even walk back? */
+ if (chunk_base->prev) {
+ /* Do so. We don't need to adjust used/free, since they're
+ already OK for the "We're full" case */
+ chunk_base = chunk_base->prev;
+ interpreter->exc_reg = &chunk_base->EReg[chunk_base->used - 1];
+ }
+ /* Nope. So pitch a fit */
+ else {
+ INTERNAL_EXCEPTION(NO_REG_FRAMES, "No more E register frames to pop!");
+ }
}
}
Only in parrot/t/op: exception.t
Only in parrot/t/op: integer19.out
Only in parrot/t/op: integer19.pasm
Only in parrot/t/op: string1.out
Only in parrot/t/op: string1.pasm
#! perl -w
use Parrot::Test tests => 4;
# Test set operations
output_is(<<'CODE', <<'OUTPUT', "set");
set I0,5
set E0,I0
set I1,E0
print I1
print "\n"
end
CODE
5
OUTPUT
# Test exception stack push
output_is(<<'CODE', <<'OUTPUT', "pushe");
set I0,5
set E0,I0
pushe
set I1,E0
print I1
print "\n"
end
CODE
0
OUTPUT
# Test exception stack
output_is(<<'CODE', <<'OUTPUT', "set");
set I0,5
set I1,-7
set E0,I0
pushe
set E0,I1
pope
set I0,E0
print I0
print "\n"
end
CODE
5
OUTPUT
# It would be very embarrassing if these didn't work...
output_is(<<'CODE', <<'OUTPUT', "divide-by-zero exception");
set I1,5
div I0,I1,0
set I2,E0
print I2
print "\n"
end
CODE
1
OUTPUT
