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