1 /*
2 * Copyright (C) 2004-2008, Parrot Foundation.
3 */
4
5 /*
6
7 =head1 NAME
8
9 examples/compiler/japhc.c
10
11 =head1 DESCRIPTION
12
13 example compiler used by japh16.pasm
14
15 Note that this example is broken and needs to be refactored to changed Parrot APIs.
16
17 =head1 SYNOPSIS
18
19
20 $ make -C examples/compilers/
21 $ parrot examples/japh/japh16.pasm
22
23 =head2 Functions
24
25 =over 4
26
27 =cut
28
29 */
30
31 #include "parrot/parrot.h"
32 #define CONST_STRING(i, s) Parrot_str_new_constant((i), (s))
33 #define CONST_STRING_GEN(i, s) Parrot_str_new_constant((i), (s))
34 #include "pmc/pmc_sub.h"
35
36 #define C_DEBUG 0
37
38 #if C_DEBUG
39 # include <stdio.h>
40 # define cdebug(x) fprintf (x)
41 #else
42 # define cdebug(x)
43 #endif
44
45 INTVAL dynpmc_class_JaPHC;
46 PMC* japh_compiler(PARROT_INTERP, const char *s);
47
48 /*
49
50 =item C<void Parrot_lib_japhc_init(PARROT_INTERP, PMC* lib)>
51
52 loadlib calls the load and init hooks
53 we use init to register the compiler
54
55 =cut
56
57 */
58
59 void
Parrot_lib_japhc_init(PARROT_INTERP,PMC * lib)60 Parrot_lib_japhc_init(PARROT_INTERP, PMC* lib)
61 {
62 STRING *whoami;
63
64 cdebug((stderr, "japhc_init\n"));
65 whoami = CONST_STRING_GEN(interp, "JaPHC");
66 dynpmc_class_JaPHC = Parrot_pmc_register_new_type(interp, whoami);
67 /* Parrot_JaPHC_class_init(interp, dynpmc_class_JaPHC, 0); */
68 /* Parrot_compreg(interp, whoami, japh_compiler); */
69 }
70
71
72 /*
73
74 =item C<static int unescape(char *string)>
75
76 Unescape a string.
77
78 =cut
79
80 */
81
82 static int
unescape(char * string)83 unescape(char *string)
84 {
85 char *start, *p;
86
87 for (start = p = string ; *string; string++) {
88 if (*string == '\\' && string[1]) {
89 switch (*++string) {
90 case 'n':
91 *p++ = '\n';
92 break;
93 default:
94 *p++ = *string;
95 break;
96 }
97 }
98 else
99 *p++ = *string;
100 }
101 *p = 0;
102 return p - start;
103 }
104
105 /*
106
107 =item C<static int add_const_str(PARROT_INTERP, PackFile_ConstTable *consts,
108 char *str)>
109
110 add constant string to constant_table
111
112 =cut
113
114 */
115
116 static int
add_const_str(PARROT_INTERP,PackFile_ConstTable * consts,char * str)117 add_const_str(PARROT_INTERP, PackFile_ConstTable *consts, char *str)
118 {
119 int k, l;
120 char *o;
121 char *buf = o = strdup(str);
122
123 /*
124 * TODO strip delimiters in lexer, this needs adjustment in printint strings
125 */
126 if (*buf == '"') {
127 buf++;
128 l = unescape(buf);
129 if (l)
130 buf[--l] = '\0';
131 }
132 else if (*buf == '\'') {
133 buf++;
134 l = strlen(buf);
135 if (l)
136 buf[--l] = '\0';
137 }
138 else {
139 l = unescape(buf);
140 }
141
142 /* Update the constant count and reallocate */
143 k = ++consts->const_count;
144 if (consts->constants == NULL)
145 consts->constants = mem_sys_allocate(
146 k * sizeof (PackFile_Constant *));
147 else
148 consts->constants = mem_sys_realloc(consts->constants,
149 k * sizeof (PackFile_Constant *));
150
151 /* Allocate a new constant. FIXME! */
152 consts->constants[--k] = PackFile_Constant_new(interp);
153 consts->constants[k]->type = PFC_STRING;
154 consts->constants[k]->u.string = Parrot_str_new_init(interp, buf,
155 (UINTVAL) l, Parrot_latin1_encoding_ptr, 0);
156 free(o);
157 return k;
158 }
159
160 /*
161
162 =item C<PMC* japh_compiler(PARROT_INTERP, const char *program)>
163
164 simple compiler - no error checking
165
166 =cut
167
168 */
169
170 PMC*
japh_compiler(PARROT_INTERP,const char * program)171 japh_compiler(PARROT_INTERP, const char *program)
172 {
173 PackFile_ByteCode *cur_cs, *old_cs;
174 PackFile_ConstTable *consts;
175 opcode_t* pc;
176 const char *p;
177 PMC *sub;
178 Parrot_sub *sub_data;
179
180 #define CODE_SIZE 128
181 cdebug((stderr, "japh_compiler '%s'\n", program));
182
183 /*
184 * need some packfile segments
185 */
186 cur_cs = PF_create_default_segs(interp, "JAPHc", 1);
187 old_cs = Parrot_pf_switch_to_cs(interp, cur_cs, 0);
188 /*
189 * alloc byte code mem
190 */
191 cur_cs->base.data = mem_sys_allocate(CODE_SIZE * sizeof (opcode_t));
192 cur_cs->base.size = CODE_SIZE;
193 consts = cur_cs->const_table;
194 /*
195 * now start compiling
196 */
197 pc = cur_cs->base.data;
198 for (p = program; *p; ++p) {
199 switch (*p) {
200 case 'p': /* print_sc */
201 *pc++ = interp->op_lib->op_code("print_sc", 1);
202 /* const follows */
203 ++p;
204 switch (*p) {
205 case 'J':
206 *pc++ = add_const_str(interp, consts, "Just ");
207 break;
208 case 'a':
209 *pc++ = add_const_str(interp, consts, "another ");
210 break;
211 case 'P':
212 *pc++ = add_const_str(interp, consts, "Parrot ");
213 break;
214 case 'H':
215 *pc++ = add_const_str(interp, consts, "Hacker");
216 break;
217 case 'n':
218 *pc++ = add_const_str(interp, consts, "\n");
219 break;
220 }
221 break;
222 case 'e': /* end */
223 *pc++ = interp->op_lib->op_code("invoke_p", 1);
224 *pc++ = 1;
225 break;
226 }
227 }
228 if (old_cs) {
229 /* restore old byte_code, */
230 (void)Parrot_pf_switch_to_cs(interp, old_cs, 0);
231 }
232 /*
233 * create sub PMC
234 */
235 sub = pmc_new(interp, enum_class_Eval);
236 PMC_get_sub(interp, sub, sub_data);
237 sub_data->seg = cur_cs;
238 sub_data->address = cur_cs->base.data;
239 sub_data->end = cur_cs->base.data + cur_cs->base.size;
240 sub_data->name = string_from_literal(interp, "JaPHC");
241 return sub;
242 }
243
244 /*
245
246 =back
247
248 =cut
249
250 */
251
252 /*
253 * Local variables:
254 * c-file-style: "parrot"
255 * End:
256 * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
257 */
258