Because I was bored this evening, I implemented the clone operators.
Dan?
Brian
# compute the factorial....recursively!
# lets do it for the numbers 0 to 6
main:
set I1,0
$loop:
print "fact of "
print I1
print " is: "
set I0,I1
bsr fact
print I0
print "\n"
inc I1,1
eq I1,7,$done
branch $loop
$done:
end
# I0 is the number to compute
fact:
clonei
lt I0,2,$is_one
set I1,I0
dec I0,1
bsr fact
mul I0,I0,I1
save I0
branch $done
$is_one:
set I0,1
save I0
$done:
popi
restore I0
ret
? test.pasm
? test.inc
? test.list
? fact.pasm
? interp_guts.c
? config.h
? basic_opcodes.c
? DCn.diff
? macro.pbc
? macro.list
? local_label.pbc
? test.pbc
? euclid.pbc
? macro.pasm
? test2.pbc
? test3.pbc
? mytest.pasm
? cequ.code
? assemble.pl-new_macros
? mytest.pbc
? op_info.c
? frame_test.pbc
? fact.pbc
? frame_test.pasm
? clone.diff
? include/parrot/op_info.h
? t/test.pbc
? t/test1.c
? t/test1
Index: core.ops
===================================================================
RCS file: /home/perlcvs/parrot/core.ops,v
retrieving revision 1.4
diff -u -r1.4 core.ops
--- core.ops 2001/10/15 21:18:42 1.4
+++ core.ops 2001/10/16 00:29:05
@@ -1678,6 +1678,35 @@
Parrot_push_p(interpreter);
}
+########################################
+
+=item B<clonei>()
+
+=item B<clonen>()
+
+=item B<clonep>()
+
+=item B<clones>()
+
+Save all the registers of the type indicated in the name of the operation.
+
+=cut
+
+AUTO_OP clonei() {
+ Parrot_clone_i(interpreter);
+}
+
+AUTO_OP clonen() {
+ Parrot_clone_n(interpreter);
+}
+
+AUTO_OP clones() {
+ Parrot_clone_s(interpreter);
+}
+
+AUTO_OP clonep() {
+ Parrot_clone_p(interpreter);
+}
=back
Index: register.c
===================================================================
RCS file: /home/perlcvs/parrot/register.c,v
retrieving revision 1.10
diff -u -r1.10 register.c
--- register.c 2001/10/02 14:01:30 1.10
+++ register.c 2001/10/16 00:29:06
@@ -38,6 +38,39 @@
}
}
+/*=for api register Parrot_clone_i
+ pushes a new integer register frame on the frame stack and
+ copies the last frame to the current frame
+*/
+void
+Parrot_clone_i(struct Parrot_Interp *interpreter) {
+ struct IRegChunk *chunk_base;
+
+ chunk_base = CHUNK_BASE(interpreter->int_reg);
+ /* Do we have any slots left in the current chunk? */
+ if (chunk_base->free) {
+ interpreter->int_reg = &chunk_base->IReg[chunk_base->used++];
+ chunk_base->free--;
+ mem_sys_memcopy(&chunk_base->IReg[chunk_base->used-1],
+ &chunk_base->IReg[chunk_base->used-2],
+ sizeof(struct IReg));
+ }
+ /* Nope, so plan B time. Allocate a new chunk of integer register frames */
+ else {
+ struct IRegChunk *new_chunk;
+ new_chunk = mem_allocate_aligned(sizeof(struct IRegChunk));
+ new_chunk->used = 1;
+ new_chunk->free = FRAMES_PER_INT_REG_CHUNK - 1;
+ new_chunk->next = NULL;
+ new_chunk->prev = chunk_base;
+ chunk_base->next = new_chunk;
+ mem_sys_memcopy(&new_chunk->IReg[0],
+ &chunk_base->IReg[chunk_base->used-1],
+ sizeof(struct IReg));
+ interpreter->int_reg = &new_chunk->IReg[0];
+ }
+}
+
/*=for api register Parrot_pop_i
pops an integer register frame off of the frame stack
*/
@@ -107,6 +140,42 @@
}
}
+/*=for api register Parrot_clone_s
+ pushes a new string register frame on the frame stack and
+ copies the last frame to the current frame
+*/
+void
+Parrot_clone_s(struct Parrot_Interp *interpreter) {
+ struct SRegChunk *chunk_base;
+
+ chunk_base = CHUNK_BASE(interpreter->string_reg);
+ /* Do we have any slots left in the current chunk? */
+ if (chunk_base->free) {
+ interpreter->string_reg = &chunk_base->SReg[chunk_base->used++];
+ chunk_base->free--;
+ mem_sys_memcopy(&chunk_base->SReg[chunk_base->used-1],
+ &chunk_base->SReg[chunk_base->used-2],
+ sizeof(struct SReg));
+ }
+ /* Nope, so plan B time. Allocate a new chunk of string register frames */
+ else {
+ struct SRegChunk *new_chunk;
+ new_chunk = mem_allocate_aligned(sizeof(struct SRegChunk));
+ new_chunk->used = 1;
+ new_chunk->free = FRAMES_PER_STR_REG_CHUNK - 1;
+ new_chunk->next = NULL;
+ new_chunk->prev = chunk_base;
+ chunk_base->next = new_chunk;
+ mem_sys_memcopy(&new_chunk->SReg[0],
+ &chunk_base->SReg[chunk_base->used-1],
+ sizeof(struct SReg));
+ interpreter->string_reg = &new_chunk->SReg[0];
+ /* Gotta NULL them out as some string
+ functions depend on NULL strings */
+ Parrot_clear_s(interpreter);
+ }
+}
+
/*=for api register Parrot_pop_s
pops a string register frame off of the frame stack
*/
@@ -173,6 +242,39 @@
}
}
+/*=for api register Parrot_clone_n
+ pushes a new numeric register frame on the frame stack and copy the
+ previous frame to the current frame
+*/
+void
+Parrot_clone_n(struct Parrot_Interp *interpreter) {
+ struct NRegChunk *chunk_base;
+
+ chunk_base = CHUNK_BASE(interpreter->num_reg);
+ /* Do we have any slots left in the current chunk? */
+ if (chunk_base->free) {
+ interpreter->num_reg = &chunk_base->NReg[chunk_base->used++];
+ chunk_base->free--;
+ mem_sys_memcopy(&chunk_base->NReg[chunk_base->used-1],
+ &chunk_base->NReg[chunk_base->used-2],
+ sizeof(struct NReg));
+ }
+ /* Nope, so plan B time. Allocate a new chunk of float register frames */
+ else {
+ struct NRegChunk *new_chunk;
+ new_chunk = mem_allocate_aligned(sizeof(struct NRegChunk));
+ new_chunk->used = 1;
+ new_chunk->free = FRAMES_PER_NUM_REG_CHUNK - 1;
+ new_chunk->next = NULL;
+ new_chunk->prev = chunk_base;
+ chunk_base->next = new_chunk;
+ mem_sys_memcopy(&new_chunk->NReg[0],
+ &chunk_base->NReg[chunk_base->used-1],
+ sizeof(struct NReg));
+ interpreter->num_reg = &new_chunk->NReg[0];
+ }
+}
+
/*=for api register Parrot_pop_n
pops a numeric register frame off of the frame stack
*/
@@ -235,6 +337,41 @@
new_chunk->next = NULL;
new_chunk->prev = chunk_base;
chunk_base->next = new_chunk;
+ interpreter->pmc_reg = &new_chunk->PReg[0];
+ /* Gotta NULL them out or we might GC Wrong things later */
+ Parrot_clear_p(interpreter);
+ }
+}
+
+/*=for api register Parrot_clone_p
+ pushes a new PMC register frame on the frame stack and copy the
+ previous frame to the current frame
+*/
+void
+Parrot_clone_p(struct Parrot_Interp *interpreter) {
+ struct PRegChunk *chunk_base;
+
+ chunk_base = CHUNK_BASE(interpreter->pmc_reg);
+ /* Do we have any slots left in the current chunk? */
+ if (chunk_base->free) {
+ interpreter->pmc_reg = &chunk_base->PReg[chunk_base->used++];
+ chunk_base->free--;
+ mem_sys_memcopy(&chunk_base->PReg[chunk_base->used-1],
+ &chunk_base->PReg[chunk_base->used-2],
+ sizeof(struct PReg));
+ }
+ /* Nope, so plan B time. Allocate a new chunk of float register frames */
+ else {
+ struct PRegChunk *new_chunk;
+ new_chunk = mem_allocate_aligned(sizeof(struct PRegChunk));
+ new_chunk->used = 1;
+ new_chunk->free = FRAMES_PER_PMC_REG_CHUNK - 1;
+ new_chunk->next = NULL;
+ new_chunk->prev = chunk_base;
+ chunk_base->next = new_chunk;
+ mem_sys_memcopy(&new_chunk->PReg[0],
+ &chunk_base->PReg[chunk_base->used-1],
+ sizeof(struct PReg));
interpreter->pmc_reg = &new_chunk->PReg[0];
/* Gotta NULL them out or we might GC Wrong things later */
Parrot_clear_p(interpreter);
Index: include/parrot/register.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/register.h,v
retrieving revision 1.6
diff -u -r1.6 register.h
--- include/parrot/register.h 2001/10/06 01:04:47 1.6
+++ include/parrot/register.h 2001/10/16 00:29:07
@@ -77,6 +77,11 @@
void Parrot_push_s(struct Parrot_Interp *);
void Parrot_push_p(struct Parrot_Interp *);
+void Parrot_clone_i(struct Parrot_Interp *);
+void Parrot_clone_n(struct Parrot_Interp *);
+void Parrot_clone_s(struct Parrot_Interp *);
+void Parrot_clone_p(struct Parrot_Interp *);
+
void Parrot_pop_i(struct Parrot_Interp *);
void Parrot_pop_n(struct Parrot_Interp *);
void Parrot_pop_s(struct Parrot_Interp *);
