cvsuser 02/11/14 21:49:07
Modified: . MANIFEST core.ops sub.c
Log:
Jonathan Sillito:
The attached patch implements a very complete set of lexical scope
semantics. For those that have been following along, here are some
highlights.
- supports (fast) access by lexical position, rather than just by name
- adds a couple more ops and some variations, including push_pad and
peek_pad
- adds a couple of keyed vtable functions for Scratchpad PMCs, so the
following work in a similar way to the various flavours of find_lex and
store_lex. The difference is that the find_lex and store_lex ops work
implicitly on the current pad, while these let you explicitly specify a pad
new_pad P20, 0 # does not push on stack
set P20[0;"foo"], P0 # like: store_lex Ix, Sy, Pz
set P20[0;0], P0 # like: store_lex Ix, Iy, Pz
set P20["foo"], P0 # like: store_lex Sx, Py
set P20[0], P0 # like: store_lex Ix, Py
set P3, P20[0;"foo"] # like: find_lex Px, Iy, Sz
set P3, P20[0;0] # like: find_lex Px, Iy, Iz
set P4, P20["foo"] # like: find_lex Px, Sy
set P4, P20[0] # like: find_lex Px, Iy
- not based on PerlHash
Revision Changes Path
1.251 +2 -0 parrot/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.250
retrieving revision 1.251
diff -u -w -r1.250 -r1.251
--- MANIFEST 14 Nov 2002 05:33:01 -0000 1.250
+++ MANIFEST 15 Nov 2002 05:49:06 -0000 1.251
@@ -36,6 +36,7 @@
classes/pmc2c.pl
classes/pointer.pmc
classes/scalar.pmc
+classes/scratchpad.pmc
classes/sub.pmc
config/auto/alignptrs.pl
config/auto/alignptrs/test_c.in
@@ -1627,6 +1628,7 @@
t/pmc/perlint.t
t/pmc/perlstring.t
t/pmc/pmc.t
+t/pmc/scratchpad.t
t/pmc/sub.t
t/src/basic.t
t/src/exit.t
1.228 +117 -20 parrot/core.ops
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/core.ops,v
retrieving revision 1.227
retrieving revision 1.228
diff -u -w -r1.227 -r1.228
--- core.ops 8 Nov 2002 05:18:39 -0000 1.227
+++ core.ops 15 Nov 2002 05:49:06 -0000 1.228
@@ -3643,22 +3643,68 @@
########################################
-=item B<new_pad>()
+=item B<new_pad>(in INT)
-Create a new lexical scope pad and push it onto the
-current lexical scope stack.
+Create a new lexical scope pad with static nesting depth $1
+and push it onto the lexical scope stack. Static depths 0
+through $1 - 1, inclusive, are copied from the current static
+nesting.
+
+=item B<new_pad>(out PMC, in INT)
+
+Create a new lexical scope pad with static nesting depth $2
+and store it in $1 (do NOT push on the stack). Static depths 0
+through $2 - 1, inclusive, are copied from the current static
+nesting.
=item B<pop_pad>()
Pop the current lexical scope pad off the stack
+=item B<pop_pad>(out PMC)
+
+Pop the current lexical scope pad off the stack and store
+it in $1 (XXX JPS: not implemented yet).
+
+=item B<peek_pad>(out PMC)
+
+Store the current lexical scope pad (i.e. the one at the
+top of the lexical pad stack) in $1.
+
=item B<store_lex>(in STR, in PMC)
-Store object $2 as lexical symbol $1
+Store object $2 as lexical symbol $1. $1 must have already been
+created at some static depth.
+
+=item B<store_lex>(in INT, in STR, in PMC)
+
+Store object $3 as lexical $2 at depth $1. If [$1, $2] does not
+exist, it will be created. If $1 is negative, count out from the
+current lexical scope; otherwise, count in from the outermost scope.
+So store_lex -1, .... will operate on the current pad.
+
+=item B<store_lex>(in INT, in INT, in PMC)
+
+Store object $3 at lexical position $2 at depth $1. If [$1, $2] does
+not exist, it will be created. If $1 is negative, count out from the
+current lexical scope; otherwise, count in from the outermost scope.
+So store_lex -1, .... will operate on the current pad.
=item B<find_lex>(out PMC, in STR)
-Find the lexical variable named $2 and store it in $1
+Find the lexical variable named $2 (at any depth) and store it in $1.
+
+=item B<find_lex>(out PMC, in INT, in STR)
+
+Find the lexical variable named $3 at depth $2 and store it in $1.
+If $2 is negative the, count out from the current lexical scope;
+otherwise, count up from the outermost scope.
+
+=item B<find_lex>(out PMC, in INT, in INT)
+
+Find the lexical variable at position $3 at depth $2 and store it in
+$1. If $2 is negative the, count out from the current lexical scope;
+otherwise, count up from the outermost scope.
=item B<store_global>(in STR, in PMC)
@@ -3670,36 +3716,87 @@
=cut
-op new_pad() {
- PMC* hash = pmc_new(interpreter, enum_class_PerlHash);
- stack_push(interpreter, &interpreter->ctx.pad_stack, hash, STACK_ENTRY_PMC,
STACK_CLEANUP_NULL);
+op new_pad(in INT) {
+ PMC * pad;
+ PMC * parent = (PMC *)stack_peek(interpreter,
+ interpreter->ctx.pad_stack, NULL);
+ pad = scratchpad_new(interpreter, parent, $1);
+ stack_push(interpreter, &interpreter->ctx.pad_stack, pad,
+ STACK_ENTRY_PMC, STACK_CLEANUP_NULL);
+ goto NEXT();
+}
+
+op new_pad(out PMC, in INT) {
+ PMC * parent = (PMC *)stack_peek(interpreter,
+ interpreter->ctx.pad_stack, NULL);
+ $1 = scratchpad_new(interpreter, parent, $2);
+ goto NEXT();
+}
+op push_pad(in PMC) {
+ stack_push(interpreter, &interpreter->ctx.pad_stack, $1,
+ STACK_ENTRY_PMC, STACK_CLEANUP_NULL);
goto NEXT();
}
op pop_pad() {
- stack_pop(interpreter, &interpreter->ctx.pad_stack, NULL, STACK_ENTRY_PMC);
+ stack_pop(interpreter, &interpreter->ctx.pad_stack,
+ NULL, STACK_ENTRY_PMC);
+ goto NEXT();
+}
+
+op peek_pad(out PMC) {
+ $1 = (PMC*)stack_peek(interpreter,
+ interpreter->ctx.pad_stack, NULL);
goto NEXT();
}
op store_lex(in STR, in PMC) {
- PMC * hash = NULL;
- PMC * key = key_new_string(interpreter, $1);
- Stack_entry_type type = NO_STACK_ENTRY_TYPE;
- hash = (PMC *)stack_peek(interpreter, interpreter->ctx.pad_stack, &type);
- hash->vtable->set_pmc_keyed(interpreter, hash, key, $2, NULL);
+ PMC * pad = (PMC *)stack_peek(interpreter,
+ interpreter->ctx.pad_stack, NULL);
+ scratchpad_store(interpreter, pad, $1, 0, $2);
+ goto NEXT();
+}
+
+op store_lex(in INT, in STR, in PMC) {
+ PMC * pad = (PMC *)stack_peek(interpreter,
+ interpreter->ctx.pad_stack, NULL);
+ scratchpad_store_index(interpreter, pad, $1, $2, 0, $3);
+ goto NEXT();
+}
+
+op store_lex(in INT, in INT, in PMC) {
+ PMC * pad = (PMC *)stack_peek(interpreter,
+ interpreter->ctx.pad_stack, NULL);
+ scratchpad_store_index(interpreter, pad, $1, NULL, $2, $3);
goto NEXT();
}
op find_lex(out PMC, in STR) {
- PMC * hash = NULL;
- PMC * key = key_new_string(interpreter, $2);
- Stack_entry_type type = NO_STACK_ENTRY_TYPE;
- hash = (PMC *)stack_peek(interpreter, interpreter->ctx.pad_stack, &type);
- $1 = hash->vtable->get_pmc_keyed(interpreter, hash, key);
+ PMC * pad = (PMC *)stack_peek(interpreter,
+ interpreter->ctx.pad_stack, NULL);
+ $1 = scratchpad_get(interpreter, pad, $2, 0);
+ goto NEXT();
+}
- /* FIXME: should the not found case be an internal_exception ? */
+op find_lex(out PMC, in INT) {
+ PMC * pad = (PMC *)stack_peek(interpreter,
+ interpreter->ctx.pad_stack, NULL);
+ $1 = scratchpad_get(interpreter, pad, NULL, $2);
+ goto NEXT();
+}
+
+op find_lex(out PMC, in INT, in STR) {
+ PMC * pad = (PMC *)stack_peek(interpreter,
+ interpreter->ctx.pad_stack, NULL);
+ $1 = scratchpad_get_index(interpreter, pad, $2, $3, 0);
+ goto NEXT();
+}
+op find_lex(out PMC, in INT, in INT) {
+ PMC * pad = (PMC *)stack_peek(interpreter,
+ interpreter->ctx.pad_stack, NULL);
+ $1 = scratchpad_get_index(interpreter, pad, $2, NULL, $3);
goto NEXT();
}
1.9 +194 -2 parrot/sub.c
Index: sub.c
===================================================================
RCS file: /cvs/public/parrot/sub.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- sub.c 2 Nov 2002 14:57:47 -0000 1.8
+++ sub.c 15 Nov 2002 05:49:06 -0000 1.9
@@ -1,7 +1,7 @@
/* sub.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: sub.c,v 1.8 2002/11/02 14:57:47 josh Exp $
+ * $Id: sub.c,v 1.9 2002/11/15 05:49:06 sfink Exp $
* Overview:
* Sub-routines, co-routines and other fun stuff...
* Data Structure and Algorithms:
@@ -64,6 +64,198 @@
}
/*
+ * Uses scope_index to find and return the appropriate scope.
+ */
+static struct Parrot_Lexicals *
+scratchpad_index(struct Parrot_Interp* interpreter, PMC* pad,
+ INTVAL scope_index)
+{
+ /* if scope_index is negative we count out from current pad */
+ scope_index = scope_index < 0 ?
+ pad->cache.int_val + scope_index : scope_index;
+
+ if (scope_index >= pad->cache.int_val || scope_index < 0) {
+ internal_exception(-1, "Pad index out of range");
+ return NULL;
+ }
+
+ return ((struct Parrot_Lexicals **)pad->data)[scope_index];
+}
+
+/*
+ * Returns the position of the lexical variable corresponding to
+ * name. If such a variable can not be found the length of the list
+ * is returned (i.e. the position that this new lexical should be
+ * stored in).
+ */
+static INTVAL
+lexicals_get_position(struct Parrot_Interp * interp,
+ struct Parrot_Lexicals *lex, STRING* name)
+{
+ STRING * cur;
+ INTVAL pos;
+
+ for (pos = 0; pos < list_length(interp, lex->names); pos++) {
+ cur = *(STRING**)list_get(interp, lex->names, pos, enum_type_STRING);
+ if (cur && string_compare(interp, cur, name) == 0) {
+ break;
+ }
+ }
+
+ return pos;
+}
+
+/*
+ * Returns first lexical scope and position where name is found, or
+ * NULL if it can not be found.
+ */
+static struct Parrot_Lexicals *
+scratchpad_find(struct Parrot_Interp* interp, PMC* pad, STRING * name,
+ INTVAL * position)
+{
+ INTVAL i, pos = 0;
+ struct Parrot_Lexicals * lex = NULL;
+
+ for (i = pad->cache.int_val - 1; i >= 0; i--) {
+ lex = ((struct Parrot_Lexicals **)pad->data)[i];
+ pos = lexicals_get_position(interp, lex, name);
+ if (pos == list_length(interp, lex->names))
+ lex = NULL;
+ else
+ break;
+ }
+
+ *position = pos;
+ return lex;
+}
+
+/*
+ * Creates and initializes a new Scratchpad PMC.
+ */
+PMC*
+scratchpad_new(struct Parrot_Interp * interp, PMC * base, INTVAL depth)
+{
+ struct Parrot_Lexicals * lex;
+ PMC * pad_pmc = pmc_new(interp, enum_class_Scratchpad);
+ pad_pmc->cache.int_val = 0;
+
+ if ((base && depth > base->cache.int_val) || (!base && depth != 0)) {
+ internal_exception(-1, "-scratch_pad: too deep\n");
+ return NULL;
+ }
+
+ /* XXX JPS: should we use a List * here instead? */
+ pad_pmc->data = mem_sys_allocate((depth + 1) *
+ sizeof(struct Parrot_Lexicals));
+
+ if (base) {
+ memcpy(pad_pmc->data, base->data, depth *
+ sizeof(struct Parrot_Lexicals));
+ }
+
+ lex = mem_sys_allocate(sizeof(struct Parrot_Lexicals));
+ lex->values = list_new(interp, enum_type_PMC);
+ lex->names = list_new(interp, enum_type_STRING);
+
+ ((struct Parrot_Lexicals **)pad_pmc->data)[depth] = lex;
+ pad_pmc->cache.int_val = depth + 1;
+ return pad_pmc;
+}
+
+/*
+ * Routines for storing and reading lexicals in Scratchpad's. These
+ * take both a name and a position, however in general only one of
+ * these will be considered. This is to support both by name access
+ * and by position (which is faster). If by position access is intended
+ * name should be passed as NULL.
+ */
+
+void
+scratchpad_store(struct Parrot_Interp * interp, PMC * pad,
+ STRING * name, INTVAL position, PMC* value)
+{
+ INTVAL i;
+ struct Parrot_Lexicals * lex;
+
+ if (name) {
+ /* use name to find lex and position */
+ lex = scratchpad_find(interp, pad, name, &position);
+ if (!lex) internal_exception(-1, "Lexical not found");
+ }
+ else {
+ /* assume current lexical pad */
+ lex = scratchpad_index(interp, pad, -1);
+ }
+
+ list_assign(interp, lex->values, position, value, enum_type_PMC);
+}
+
+void
+scratchpad_store_index(struct Parrot_Interp * interp, PMC * pad,
+ INTVAL scope_index, STRING * name, INTVAL position,
+ PMC* value)
+{
+ INTVAL i;
+ struct Parrot_Lexicals * lex;
+
+ lex = scratchpad_index(interp, pad, scope_index);
+
+ if (name) {
+ position = lexicals_get_position(interp, lex, name);
+ }
+
+ if (position == list_length(interp, lex->names)) {
+ if (!name) {
+ /* no name for new variable, give it a default name of "" */
+ /* XXX JPS: is this the way to make an empty string? */
+ name = string_make(interp, "", 9,0,0,0);
+ }
+ list_assign(interp, lex->names, position, name, enum_type_STRING);
+ }
+
+ list_assign(interp, lex->values, position, value, enum_type_PMC);
+}
+
+PMC *
+scratchpad_get(struct Parrot_Interp * interp, PMC * pad, STRING * name,
+ INTVAL position)
+{
+ INTVAL i;
+ struct Parrot_Lexicals * lex = NULL;
+
+ if (name) lex = scratchpad_find(interp, pad, name, &position);
+ else lex = scratchpad_index(interp, pad, -1);
+
+ if (!lex) internal_exception(-1, "Lexical not found");
+
+ return *(PMC **)list_get(interp, lex->values, position, enum_type_PMC);
+}
+
+PMC *
+scratchpad_get_index(struct Parrot_Interp * interp, PMC * pad,
+ INTVAL scope_index, STRING * name, INTVAL position)
+{
+ struct Parrot_Lexicals * lex = scratchpad_index(interp, pad, scope_index);
+
+ if (name) {
+ position = lexicals_get_position(interp, lex, name);
+ }
+
+ if (!lex || position < 0 || position >= list_length(interp, lex->values)) {
+ internal_exception(-1, "Lexical not found");
+ }
+
+ return *(PMC **)list_get(interp, lex->values, position, enum_type_PMC);
+}
+
+PMC *
+lexicals_mark(struct Parrot_Interp * interp, struct Parrot_Lexicals *lex, PMC *
last)
+{
+ last = list_mark(interp, lex->names, last);
+ return list_mark(interp, lex->values, last);
+}
+
+/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
