examples/compilers/japhc.c

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