languages/WMLScript/pmc/wmlsbytecode.pmc

   1 /*
   2 Copyright (C) 2006-2008, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 pmc/wmlsbytecode - WMLScript bytecode loader
   8
   9 =head1 DESCRIPTION
  10
  11 This singleton PMC holds a factory.
  12
  13 =head2 Methods
  14
  15 =over 4
  16
  17 =cut
  18
  19 */
  20
  21 #include "parrot/embed.h"
  22
  23 static PMC * WmlsBytecode_PMC;
  24 static PMC * script;
  25 static const char * bytecode;
  26 static UINTVAL maxi;
  27 static const char *fp;
  28
  29 static void _init(Interp *interp, STRING *str)
  30 {
  31     bytecode = Parrot_string_cstring(interp, str);
  32     maxi     = string_length(interp, str);
  33     fp       = (const char *)bytecode;
  34 }
  35
  36 #define _info_get()     (UINTVAL)(&bytecode[maxi] - fp)
  37 #define _get_pos()      (fp)
  38 #define _get_c()        (*(fp++))
  39
  40 static unsigned short _get_mb16(void)
  41 {
  42     unsigned short value;
  43     unsigned char c;
  44
  45     value = 0;
  46     for (;;) {
  47         c = _get_c();
  48         value <<= 7;
  49         value += (c & 0x7F);
  50         if ((c & 0x80) == 0)
  51             break;
  52     }
  53     return value;
  54 }
  55
  56 static unsigned int _get_mb32(void)
  57 {
  58     unsigned int value;
  59     unsigned char c;
  60
  61     value = 0;
  62     for (;;) {
  63         c = _get_c();
  64         value <<= 7;
  65         value += (c & 0x7F);
  66         if ((c & 0x80) == 0)
  67             break;
  68     }
  69     return value;
  70 }
  71
  72 static unsigned char _get_uint8(void)
  73 {
  74     return _get_c();
  75 }
  76
  77 static unsigned short _get_uint16(void)
  78 {
  79     unsigned short value;
  80     unsigned char c;
  81
  82     c = _get_c();
  83     value = c & 0xFF;
  84     c = _get_c();
  85     value <<= 8;
  86     value += (c & 0xFF);
  87     return value;
  88 }
  89
  90 static char _get_int8(void)
  91 {
  92     return (char)_get_c();
  93 }
  94
  95 static short _get_int16(void)
  96 {
  97     short value;
  98     unsigned char c;
  99
 100     c = _get_c();
 101     value = c & 0xFF;
 102     c = _get_c();
 103     value <<= 8;
 104     value += (c & 0xFF);
 105     return value;
 106 }
 107
 108 static int _get_int32(void)
 109 {
 110     short value;
 111     unsigned char c;
 112
 113     c = _get_c();
 114     value = c & 0xFF;
 115     c = _get_c();
 116     value <<= 8;
 117     value += (c & 0xFF);
 118     c = _get_c();
 119     value <<= 8;
 120     value += (c & 0xFF);
 121     c = _get_c();
 122     value <<= 8;
 123     value += (c & 0xFF);
 124     return value;
 125 }
 126
 127 static float _get_float32(void)
 128 {
 129     float value;
 130     unsigned char *ptr = (unsigned char *)&value;
 131
 132 #if PARROT_BIGENDIAN
 133     ptr[3] = _get_c();
 134     ptr[2] = _get_c();
 135     ptr[1] = _get_c();
 136     ptr[0] = _get_c();
 137 #else
 138     ptr[0] = _get_c();
 139     ptr[1] = _get_c();
 140     ptr[2] = _get_c();
 141     ptr[3] = _get_c();
 142 #endif
 143
 144     return value;
 145 }
 146
 147 static int _load_header(Interp *interp)
 148 {
 149     UINTVAL VersionNumber;
 150     UINTVAL CodeSize;
 151
 152     VersionNumber = _get_uint8();
 153
 154     if (VersionNumber != 0x01)
 155         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ILL_INHERIT,
 156             "incorrect version");
 157
 158     VTABLE_set_integer_keyed_str(interp, script,
 159         const_string(interp, "VersionNumber"), VersionNumber);
 160
 161     CodeSize = _get_mb32();
 162
 163     if (CodeSize != _info_get())
 164         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ILL_INHERIT,
 165             "incorrect code size");
 166
 167     VTABLE_set_integer_keyed_str(interp, script,
 168         const_string(interp, "CodeSize"), CodeSize);
 169
 170     return 0;
 171 }
 172
 173 static int _load_constant_pool(Interp *interp)
 174 {
 175     UINTVAL NumberOfConstants;
 176     UINTVAL CharacterSet;
 177     UINTVAL idx;
 178     PMC * Constants;
 179
 180     NumberOfConstants = _get_mb16();
 181     Constants = pmc_new(interp, pmc_type(interp,
 182           const_string(interp, "Wmls::Constants")));
 183     VTABLE_set_integer_native(interp, Constants, NumberOfConstants);
 184     VTABLE_set_pmc_keyed_str(interp, script,
 185         const_string(interp, "Constants"), Constants);
 186
 187     CharacterSet = _get_mb16();
 188     VTABLE_set_integer_keyed_str(interp, script,
 189         const_string(interp, "CharacterSet"), CharacterSet);
 190
 191     for (idx = 0; idx < NumberOfConstants; idx++) {
 192         PMC * Constant;
 193         UINTVAL ConstantType = _get_uint8();
 194         switch (ConstantType) {
 195         case 0:
 196         {
 197             INTVAL ConstantInteger8 = _get_int8();
 198             Constant = pmc_new(interp, pmc_type(interp,
 199               const_string(interp, "Wmls::ConstantInteger")));
 200             VTABLE_set_integer_native(interp, Constant, ConstantInteger8);
 201             break;
 202         }
 203         case 1:
 204         {
 205             INTVAL ConstantInteger16 = _get_int16();
 206             Constant = pmc_new(interp, pmc_type(interp,
 207               const_string(interp, "Wmls::ConstantInteger")));
 208             VTABLE_set_integer_native(interp, Constant, ConstantInteger16);
 209             break;
 210         }
 211         case 2:
 212         {
 213             INTVAL ConstantInteger32 = _get_int32();
 214             Constant = pmc_new(interp, pmc_type(interp,
 215               const_string(interp, "Wmls::ConstantInteger")));
 216             VTABLE_set_integer_native(interp, Constant, ConstantInteger32);
 217             break;
 218         }
 219         case 3:
 220         {
 221             FLOATVAL ConstantFloat32 = _get_float32();
 222             Constant = pmc_new(interp, pmc_type(interp,
 223               const_string(interp, "Wmls::ConstantFloat")));
 224             VTABLE_set_number_native(interp, Constant, ConstantFloat32);
 225             break;
 226         }
 227         case 4:
 228         {
 229             UINTVAL StringSize = _get_mb32();
 230             STRING * String = string_make(interp, _get_pos(),
 231               StringSize, "unicode", 0);
 232             while (StringSize --) {
 233                 (void)_get_uint8();
 234             }
 235             Constant = pmc_new(interp, pmc_type(interp,
 236               const_string(interp, "Wmls::ConstantUTF8String")));
 237             VTABLE_set_string_native(interp, Constant, String);
 238             break;
 239         }
 240         case 5:
 241         {
 242             Constant = pmc_new(interp, pmc_type(interp,
 243               const_string(interp, "Wmls::ConstantEmptyString")));
 244             break;
 245         }
 246         case 6:
 247         {
 248             UINTVAL StringSize = _get_mb32();
 249             STRING * String = string_from_cstring(interp,
 250               _get_pos(), StringSize);
 251             while (StringSize --) {
 252                 (void)_get_uint8();
 253             }
 254             Constant = pmc_new(interp, pmc_type(interp,
 255               const_string(interp, "Wmls::ConstantString")));
 256             VTABLE_set_string_native(interp, Constant, String);
 257             break;
 258         }
 259         default:
 260             Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ILL_INHERIT,
 261                 "invalid ConstantType (%u).", ConstantType);
 262         }
 263         VTABLE_set_pmc_keyed_int(interp, Constants, idx, Constant);
 264     }
 265
 266     return 0;
 267 }
 268
 269 static int _load_pragma_pool(Interp *interp)
 270 {
 271     UINTVAL NumberOfPragmas;
 272     UINTVAL idx;
 273     PMC * Pragmas;
 274
 275     NumberOfPragmas = _get_mb16();
 276     Pragmas = pmc_new(interp, pmc_type(interp,
 277           const_string(interp, "Wmls::Pragmas")));
 278     VTABLE_set_integer_native(interp, Pragmas, NumberOfPragmas);
 279     VTABLE_set_pmc_keyed_str(interp, script,
 280         const_string(interp, "Pragmas"), Pragmas);
 281
 282     for (idx = 0; idx < NumberOfPragmas; idx++) {
 283         PMC * Pragma;
 284         UINTVAL PragmaType = _get_uint8();
 285         switch (PragmaType) {
 286         case 0:
 287         {
 288             UINTVAL AccessDomainIndex = _get_mb16();
 289             Pragma = pmc_new(interp, pmc_type(interp,
 290               const_string(interp, "Wmls::AccessDomain")));
 291             VTABLE_set_integer_keyed_str(interp, Pragma,
 292               const_string(interp, "AccessDomainIndex"), AccessDomainIndex);
 293             break;
 294         }
 295         case 1:
 296         {
 297             UINTVAL AccessPathIndex = _get_mb16();
 298             Pragma = pmc_new(interp, pmc_type(interp,
 299               const_string(interp, "Wmls::AccessPath")));
 300             VTABLE_set_integer_keyed_str(interp, Pragma,
 301               const_string(interp, "AccessPathIndex"), AccessPathIndex);
 302             break;
 303         }
 304         case 2:
 305         {
 306             UINTVAL PropertyNameIndex = _get_mb16();
 307             UINTVAL ContentIndex = _get_mb16();
 308             Pragma = pmc_new(interp, pmc_type(interp,
 309               const_string(interp, "Wmls::UserAgentProperty")));
 310             VTABLE_set_integer_keyed_str(interp, Pragma,
 311               const_string(interp, "PropertyNameIndex"), PropertyNameIndex);
 312             VTABLE_set_integer_keyed_str(interp, Pragma,
 313               const_string(interp, "ContentIndex"), ContentIndex);
 314             break;
 315         }
 316         case 3:
 317         {
 318             UINTVAL PropertyNameIndex = _get_mb16();
 319             UINTVAL ContentIndex = _get_mb16();
 320             UINTVAL SchemeIndex = _get_mb16();
 321             Pragma = pmc_new(interp, pmc_type(interp,
 322               const_string(interp, "Wmls::UserAgentProperty&Scheme")));
 323             VTABLE_set_integer_keyed_str(interp, Pragma,
 324               const_string(interp, "PropertyNameIndex"), PropertyNameIndex);
 325             VTABLE_set_integer_keyed_str(interp, Pragma,
 326               const_string(interp, "ContentIndex"), ContentIndex);
 327             VTABLE_set_integer_keyed_str(interp, Pragma,
 328               const_string(interp, "SchemeIndex"), SchemeIndex);
 329             break;
 330         }
 331         default:
 332             Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ILL_INHERIT,
 333                 "invalid PragmaType (%u).", PragmaType);
 334         }
 335         VTABLE_set_pmc_keyed_int(interp, Pragmas, idx, Pragma);
 336     }
 337
 338     return 0;
 339 }
 340
 341 static int _load_function_pool(Interp *interp)
 342 {
 343     UINTVAL NumberOfFunctions;
 344     UINTVAL NumberOfFunctionNames;
 345     UINTVAL idx;
 346     PMC * Functions;
 347     PMC * FunctionNameTable;
 348
 349     NumberOfFunctions = _get_uint8();
 350     Functions = pmc_new(interp, pmc_type(interp,
 351           const_string(interp, "Wmls::Functions")));
 352     VTABLE_set_integer_native(interp, Functions, NumberOfFunctions);
 353     VTABLE_set_pmc_keyed_str(interp, script,
 354         const_string(interp, "Functions"), Functions);
 355
 356     NumberOfFunctionNames = _get_uint8();
 357     FunctionNameTable = pmc_new(interp, pmc_type(interp,
 358           const_string(interp, "Wmls::FunctionNameTable")));
 359     VTABLE_set_integer_native(interp, FunctionNameTable,
 360         NumberOfFunctionNames);
 361     VTABLE_set_pmc_keyed_str(interp, script,
 362         const_string(interp, "FunctionNameTable"), FunctionNameTable);
 363
 364     for (idx = 0; idx < NumberOfFunctionNames; idx++) {
 365         PMC * Couple = pmc_new(interp, enum_class_Array);
 366         UINTVAL FunctionIndex = _get_uint8();
 367         UINTVAL FunctionNameSize = _get_uint8();
 368         STRING * FunctionName = string_make(interp, _get_pos(),
 369           FunctionNameSize, "unicode", 0);
 370         while (FunctionNameSize --) {
 371             (void)_get_uint8();
 372         }
 373         VTABLE_set_integer_native(interp, Couple, 2);
 374         VTABLE_set_integer_keyed_int(interp, Couple, 0, FunctionIndex);
 375         VTABLE_set_string_keyed_int(interp, Couple, 1, FunctionName);
 376
 377         VTABLE_set_pmc_keyed_int(interp, FunctionNameTable, idx, Couple);
 378     }
 379
 380     for (idx = 0; idx < NumberOfFunctions; idx++) {
 381         PMC * Function;
 382         UINTVAL NumberOfArguments = _get_uint8();
 383         UINTVAL NumberOfLocalVariables = _get_uint8();
 384         UINTVAL FunctionSize = _get_mb32();
 385         STRING * CodeArray = string_make(interp, _get_pos(),
 386           FunctionSize, "binary", 0);
 387         while (FunctionSize --) {
 388             (void)_get_uint8();
 389         }
 390         Function = pmc_new(interp, pmc_type(interp,
 391           const_string(interp, "Wmls::Function")));
 392         VTABLE_set_integer_keyed_str(interp, Function,
 393           const_string(interp, "NumberOfArguments"), NumberOfArguments);
 394         VTABLE_set_integer_keyed_str(interp, Function,
 395           const_string(interp, "NumberOfLocalVariables"),
 396           NumberOfLocalVariables);
 397         VTABLE_set_string_keyed_str(interp, Function,
 398           const_string(interp, "CodeArray"), CodeArray);
 399
 400         VTABLE_set_pmc_keyed_int(interp, Functions, idx, Function);
 401     }
 402
 403     if (_info_get() != 0)
 404         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ILL_INHERIT,
 405             "incorrect size");
 406
 407     return 0;
 408 }
 409
 410
 411 pmclass WmlsBytecode
 412     singleton
 413     dynpmc
 414     group wmls_group {
 415
 416 /*
 417
 418 =item C<void* get_pointer()>
 419
 420 =item C<void set_pointer(void *ptr)>
 421
 422 These two functions are part of the singleton creation interface. For more
 423 information see F<src/pmc.c>.
 424
 425 =cut
 426
 427 */
 428     void* get_pointer() {
 429         return WmlsBytecode_PMC;
 430     }
 431
 432     void set_pointer(void* ptr) {
 433         WmlsBytecode_PMC = (PMC*) ptr;
 434     }
 435
 436 /*
 437
 438 =item C<PMC* load(STRING* bytecode)>
 439
 440 Loads WMLScript bytecode.
 441
 442 =cut
 443
 444 */
 445     METHOD PMC* load(STRING* bytecode) {
 446         script = pmc_new(INTERP, pmc_type(INTERP,
 447           const_string(INTERP, "Wmls::Script")));
 448         _init(INTERP, bytecode);
 449         if (_load_header(INTERP))
 450             goto err;
 451         if (_load_constant_pool(INTERP))
 452             goto err;
 453         if (_load_pragma_pool(INTERP))
 454             goto err;
 455         if (_load_function_pool(INTERP))
 456             goto err;
 457         RETURN(PMC *script);
 458 err:
 459         RETURN(PMC *NULL);
 460     }
 461
 462 }
 463
 464 /*
 465
 466 =back
 467
 468 =head1 AUTHORS
 469
 470 Francois Perrad
 471
 472 =cut
 473
 474 */
 475
 476 /*
 477  * Local variables:
 478  *   c-file-style: "parrot"
 479  * End:
 480  * vim: expandtab shiftwidth=4:
 481  */