cvsuser 03/01/16 09:27:03
Modified: languages/imcc imcc.l main.c parser.h parser_util.c pbc.c
Added: languages/imcc/t/syn eval.t
Log:
eval #1 imcc
Revision Changes Path
1.23 +6 -3 parrot/languages/imcc/imcc.l
Index: imcc.l
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/imcc.l,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -w -r1.22 -r1.23
--- imcc.l 14 Jan 2003 13:20:09 -0000 1.22
+++ imcc.l 16 Jan 2003 17:26:57 -0000 1.23
@@ -46,8 +46,11 @@
BEGIN(emit);
}
if (pasm_file && YYSTATE != emit) {
+ if (pasm_file == 1) {
BEGIN(emit);
- return pasm_file == 1 ? EMIT : 0;
+ return EMIT;
+ }
+ return 0;
}
<INITIAL,emit>{EOL} {
@@ -173,7 +176,7 @@
yylval.s = str_dup(yytext); /* XXX delete quotes, -> emit, pbc */
return(STRINGC);
}
-<emit>{CHARCONSTANT} {
+<emit,INITIAL>{CHARCONSTANT} {
yylval.s = str_dup(yytext);
return(STRINGC);
}
1.7 +2 -0 parrot/languages/imcc/main.c
Index: main.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/main.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- main.c 14 Jan 2003 13:20:09 -0000 1.6
+++ main.c 16 Jan 2003 17:26:57 -0000 1.7
@@ -181,6 +181,8 @@
interpreter->DOD_block_level++;
sourcefile = parseflags(interpreter, &argc, &argv);
+ /* register compilers to parrot core */
+ register_compilers(interpreter);
/* default optimizations, s. optimizer.c */
if (!*optimizer_opt)
1.4 +3 -0 parrot/languages/imcc/parser.h
Index: parser.h
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/parser.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- parser.h 14 Jan 2003 13:20:09 -0000 1.3
+++ parser.h 16 Jan 2003 17:26:57 -0000 1.4
@@ -27,6 +27,9 @@
int yyparse(void);
void op_fullname(char * dest, const char * name, SymReg * args[], int nargs);
void open_comp_unit(void);
+void register_compilers(Parrot_Interp interpreter);
+void *imcc_eval_pasm(Parrot_Interp interpreter, const char *s);
+void *imcc_eval_pir (Parrot_Interp interpreter, const char *s);
#endif
1.5 +75 -0 parrot/languages/imcc/parser_util.c
Index: parser_util.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/parser_util.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- parser_util.c 14 Jan 2003 13:20:09 -0000 1.4
+++ parser_util.c 16 Jan 2003 17:26:57 -0000 1.5
@@ -17,6 +17,8 @@
#define _PARSER
#include "imc.h"
+#include "parrot/method_util.h"
+#include "parrot/interp_guts.h"
#include "pbc.h"
#include "parser.h"
@@ -100,6 +102,79 @@
nargs = n;
keyvec = keys;
return iANY(name, fmt, regs, emit);
+}
+
+/* imcc_eval(interp*, const char*)
+ *
+ * evaluate a pasm or imcc string
+ *
+ */
+extern void* yy_scan_string(const char *);
+
+static void *imcc_eval(Parrot_Interp interpreter, const char *s)
+{
+ /* imcc always compiles to interp->code->byte_code
+ * save old pointer, make new
+ */
+ size_t code_size = interpreter->code->byte_code_size;
+ void *code = interpreter->code->byte_code;
+ opcode_t *pc;
+
+ /* reset line number */
+ line = 0;
+ yy_scan_string(s);
+ /* s. also e_pbc_open for reusing code/consts ... */
+ emit_open(1, NULL);
+ /* XXX this may move an existing byte_code */
+ /* XXX where to put constants */
+ yyparse();
+ emit_close();
+
+ pc = (opcode_t *) ((char*)interpreter->code->byte_code + code_size);
+ /* XXX test */
+ /* runops_slow_core(interpreter, pc);
+ while (pc) {
+ DO_OP(pc, interpreter);
+ }
+ */
+ /* XXX restore old byte_code, */
+ /*interpreter->code->byte_code_size = code_size; */
+ interpreter->code->byte_code = code;
+ return pc;
+}
+
+void *imcc_eval_pasm(Parrot_Interp interpreter, const char *s)
+{
+ pasm_file = 1;
+ expect_pasm = 0;
+ return imcc_eval(interpreter, s);
+}
+
+void *imcc_eval_pir (Parrot_Interp interpreter, const char *s)
+{
+ pasm_file = 0;
+ expect_pasm = 0;
+ return imcc_eval(interpreter, s);
+}
+
+/* tell the parrot core, which compilers we provide */
+void register_compilers(Parrot_Interp interpreter)
+{
+ STRING *pasm = string_make(interpreter, "PASM", 4, NULL,0,NULL);
+ STRING *pir = string_make(interpreter, "PIR", 3, NULL,0,NULL);
+ PMC * func;
+ Parrot_csub_t pa = (Parrot_csub_t) F2DPTR(imcc_eval_pasm);
+ Parrot_csub_t pi = (Parrot_csub_t) F2DPTR(imcc_eval_pir);
+
+ func = pmc_new(interpreter, enum_class_Compiler);
+ Parrot_compreg(interpreter, pasm, func);
+ func->vtable->set_string_keyed(interpreter, func, (PMC*)F2DPTR(pa),
+ string_make(interpreter, "pIt", 3, NULL,0,NULL));
+
+ func = pmc_new(interpreter, enum_class_Compiler);
+ Parrot_compreg(interpreter, pir, func);
+ func->vtable->set_string_keyed(interpreter, func, (PMC*)F2DPTR(pi),
+ string_make(interpreter, "pIt", 3, NULL,0,NULL));
}
/*
1.11 +12 -5 parrot/languages/imcc/pbc.c
Index: pbc.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/pbc.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -w -r1.10 -r1.11
--- pbc.c 14 Jan 2003 13:20:09 -0000 1.10
+++ pbc.c 16 Jan 2003 17:26:57 -0000 1.11
@@ -35,11 +35,6 @@
*
*/
-int e_pbc_open(char *dummy) {
- int ok = 0;
- return ok;
-}
-
/* globals store the state between individual e_pbc_emit calls
* which happen per subroutine.
*
@@ -68,6 +63,18 @@
} globals;
static int nsubs;
+
+int e_pbc_open(char *dummy) {
+ int ok = 0;
+ /* TODO free the old stuff
+ * should we keep labels, consts and so on for eval?
+ */
+#if 0
+ globals.subs = NULL;
+ nsubs = 0;
+#endif
+ return ok;
+}
/* get size of bytecode in ops till now */
static int get_old_size(void)
1.1 parrot/languages/imcc/t/syn/eval.t
Index: eval.t
===================================================================
#!perl
use strict;
use TestCompiler tests => 2;
use Test::More qw(skip);
##############################
output_is(<<'CODE', <<'OUT', "eval pasm");
.sub _test
$S0 = 'set S1, "in eval\n"'
concat $S0, "\n"
concat $S0, "print S1\nend\n"
compreg $P0, "PASM"
compile P0, $P0, $S0
invoke
print "back\n"
end
.end
CODE
in eval
back
OUT
output_is(<<'CODE', <<'OUT', "eval pir");
.sub _test
$S1 = ".sub _foo\n"
concat $S1, '$S1 = "42\n"'
concat $S1, "\nprint $S1\nend\n"
concat $S1, "\n.end\n"
compreg $P0, "PIR"
compile P0, $P0, $S1
invoke
print "back\n"
noop # filler to avoid realloc of code ;-)
end
.end
CODE
42
back
OUT
