Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Forth can now generate code for words on the fly and execute them.

This has required a lot of nasty hackery that breaks the tests, but
we can live with that for the moment.

Runtime code generation works mostly, but for some reason the sequence
"jsr xxxx" where xxxx is an immediate address rather than a register
generates bad code. Weird, and go figure. That needs fixing at some
point, as I expect it'll be common in on-the-fly code generation.


git-svn-id: https://svn.parrot.org/parrot/trunk@4583 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
commit 3168931ab316092fd79607282a7f580bed08278f 1 parent 578f53f
Dan Sugalski authored
View
1  classes/closure.pmc
@@ -21,6 +21,7 @@ pmclass Closure extends Sub {
PMC_sub(SELF) = new_closure(INTERP);
SELF->cache.struct_val = NULL;
PObj_custom_mark_destroy_SETALL(SELF);
+ printf("Address of base segment is %p\n", ((struct Parrot_Sub *)PMC_sub(SELF))->seg->base.pf->byte_code);
}
void mark () {
View
9 classes/eval.pmc
@@ -63,6 +63,15 @@ pmclass Eval extends Closure {
return next;
}
+ INTVAL get_integer_keyed (PMC* key) {
+ opcode_t *code = ((struct PackFile *)SELF->cache.struct_val)->byte_code;
+/* int i = 0;
+ for (i=0; i < 16; i++) {
+ printf("At %p there is an %i\n", code+i, *(code+i));
+ }*/
+ return (INTVAL) code;
+ }
+
STRING* get_string () {
size_t size;
opcode_t *packed;
View
4 classes/nci.pmc
@@ -52,4 +52,8 @@ pmclass NCI need_ext {
func(INTERP, SELF);
return next;
}
+ INTVAL get_integer () {
+ return((INTVAL)PMC_data(SELF));
+ }
+
}
View
8 classes/sub.pmc
@@ -20,6 +20,7 @@ pmclass Sub {
PMC_sub(SELF) = new_sub(INTERP, sizeof(struct Parrot_Sub));
SELF->cache.struct_val = NULL;
PObj_custom_mark_destroy_SETALL(SELF);
+ printf("Address of base segment is %p\n", ((struct Parrot_Sub *)PMC_sub(SELF))->seg->base.pf->byte_code);
}
void destroy () {
@@ -44,6 +45,13 @@ pmclass Sub {
return (INTVAL) SELF->cache.struct_val;
}
+ /* This just unconditionally returns the start of bytecode. It's
+ wrong, wrong, wrong, *WRONG*. And there's no other good way, so
+ it's here for now. -DRS */
+ INTVAL get_integer_keyed (PMC* key) {
+ return (INTVAL)(((struct Parrot_Sub *)PMC_sub(SELF))->seg->base.pf->byte_code);
+ }
+
INTVAL defined () {
return SELF->cache.struct_val != NULL;
}
View
37 languages/forth/forth.pasm
@@ -26,6 +26,10 @@
.constant TempInt I5
.constant TempInt2 I6
.constant TempInt3 I7
+
+.constant StartOp I12
+.constant EndOp I13
+
.constant InternalInt I27
.constant Status I12
@@ -61,9 +65,17 @@
.constant TempPMC P27
+VeryBeginning:
+ set_addr .StartOp, VeryBeginning
+ set_addr .EndOp, VeryEnd
+ print "We go from "
+ print .StartOp
+ print " to "
+ print .EndOp
+ print "\n"
+
# We need a PMC for the compiler
compreg .PASMCompiler, "PASM"
-
bsr InitializeCoreOps
set .Mode, .InterpretMode
@@ -97,12 +109,17 @@ DonePromptString:
# Invoke the compiler
bsr CompileString
# Snag the address of the new body
- set .TempInt, .CompiledWordPMC
+ set .TempInt, .CompiledWordPMC[1]
# Add the PMC to the user ops slot so it doesn't disappear
- set .UserOps[.OpName], .CompiledWordPMC
+# set .UserOps[.OpName], .CompiledWordPMC
# Put the actual function address into the core ops hash, since
# it is now a core op
set .CoreOps[.OpName], .TempInt
+ print "Address for "
+ print .OpName
+ print " is "
+ print .TempInt
+ print "\n"
.endm
InitializeCoreOps:
@@ -601,6 +618,11 @@ MaybeInterpretWord:
NotInt:
set .TempInt, .CoreOps[.CurrentWord]
eq .TempInt, 0, UserWord
+ print "Calling into "
+ print .CurrentWord
+ print " at "
+ print .TempInt
+ print "\n"
jsr .TempInt
branch DoneInterpretWord
@@ -995,9 +1017,10 @@ CompileWord:
if .TempInt, CompileWord
# Add in the return
- concat .NewBodyString, "end\n"
+ concat .NewBodyString, "ret\n"
# Compile the string
+ print .NewBodyString
compile .CompiledWordPMC, .PASMCompiler, .NewBodyString
# And we're done
@@ -1105,11 +1128,15 @@ AddStringConstant:
AddPlainWord:
set .TempInt, .CoreOps[.CurrentWord]
- concat .NewBodyString, "jsr "
+ concat .NewBodyString, "set I27, "
set .TempString, .TempInt
concat .NewBodyString, .TempString
+ concat .NewBodyString, "\njsr I27"
concat .NewBodyString, "\n"
ret
AddControlStruct:
ret
+
+VeryEnd:
+ end
View
4 ops/core.ops
@@ -1048,6 +1048,10 @@ inline op compreg(OUT PMC, in STR) {
goto NEXT();
}
+inline op bogus() {
+ goto NEXT();
+}
+
=back
=cut
View
2  ops/ops.num
@@ -773,7 +773,7 @@ getclass_p_sc 745
singleton_p 746
class_p_p 747
classname_s_p 748
-#instantiate_p_p 749
+bogus 749
new_p_i 750
new_p_ic 751
new_p_i_p 752
View
7 src/runops_cores.c
@@ -91,6 +91,7 @@ runops_slow_core(struct Parrot_Interp *interpreter, opcode_t *pc)
#define code_end (interpreter->code->byte_code + \
interpreter->code->cur_cs->base.size)
+
#ifdef USE_TRACE_INTERP
if (Interp_flags_TEST(interpreter, PARROT_TRACE_FLAG)) {
trace_i = make_interpreter(NO_FLAGS);
@@ -111,7 +112,7 @@ runops_slow_core(struct Parrot_Interp *interpreter, opcode_t *pc)
trace_op(interpreter, code_start, code_end, pc);
#endif
- while (pc && pc >= code_start && pc < code_end) {
+ while (pc) {/* && pc >= code_start && pc < code_end) {*/
interpreter->cur_pc = pc;
if (Interp_flags_TEST(interpreter, PARROT_PROFILE_FLAG)) {
interpreter->profile->data[*pc].numcalls++;
@@ -143,11 +144,11 @@ runops_slow_core(struct Parrot_Interp *interpreter, opcode_t *pc)
}
#endif
- if (pc && (pc < code_start || pc >= code_end)) {
+ /* if (pc && (pc < code_start || pc >= code_end)) {
internal_exception(INTERP_ERROR,
"Error: Control left bounds of byte-code block (now at location %d)!\n",
(int)(pc - code_start));
- }
+ }*/
#undef code_stat
#undef code_end
return pc;
Please sign in to comment.
Something went wrong with that request. Please try again.