defines()

Returns the C #define macros for register access etc.

method defines($emitter) { return qq| /* defines - Ops::Trans::C */ #define REL_PC ((size_t)(cur_opcode - (opcode_t *)interp->code->base.data)) #define CUR_OPCODE cur_opcode #define IREG(i) REG_INT(interp, cur_opcode[i]) #define NREG(i) REG_NUM(interp, cur_opcode[i]) #define PREG(i) REG_PMC(interp, cur_opcode[i]) #define SREG(i) REG_STR(interp, cur_opcode[i]) #define ICONST(i) cur_opcode[i] #define NCONST(i) Parrot_pcc_get_num_constants(interp, interp->ctx)[cur_opcode[i]] #define SCONST(i) Parrot_pcc_get_str_constants(interp, interp->ctx)[cur_opcode[i]] #undef PCONST #define PCONST(i) Parrot_pcc_get_pmc_constants(interp, interp->ctx)[cur_opcode[i]]

static int get_op(PARROT_INTERP, const char * name, int full); |; }

method op_info($emitter) { $emitter.bs ~ 'op_info_table' } method op_func($emitter) { $emitter.bs ~ 'op_func_table' } method getop($emitter) { 'get_op' };

method body_prelude() { '' }

method emit_source_part($emitter, $fh) { self._emit_op_func_table($emitter, $fh); self._emit_op_info_table($emitter, $fh); self._emit_op_function_definitions($emitter, $fh); }

method _emit_op_func_table($emitter, $fh) {

$fh.print(qq|

INTVAL {$emitter.bs}numops{self.suffix} = {self<num_entries>};

/* ** Op Function Table: */

static op_func{self.suffix}_t {self.op_func($emitter)}[{self<num_entries>}] = | ~ '{' ~ "\n" );

      for self<op_func_table> {
          $fh.print($_)
      }

      $fh.print(q|
NULL /* NULL function pointer */
};

|); }

method _emit_op_info_table($emitter, $fh) {

my %names           := self<names>;
my %arg_dir_mapping := hash(
    :i('PARROT_ARGDIR_IN'),
    :o('PARROT_ARGDIR_OUT'),
    :io('PARROT_ARGDIR_INOUT')
);

#
# Op Info Table:
#
$fh.print(qq|

/* ** Op Info Table: */

static op_info_t {self.op_info($emitter)}[{self<num_entries>}] = | ~ q|{ |);

  my $index := 0;
  my $op_lib_ref := '&' ~ $emitter.bs() ~ 'op_lib';

  for $emitter.ops_file.ops -> $op {
      my $type := sprintf( "PARROT_%s_OP", uc($op.type ?? 'INLINE' !! 'FUNCTION') );
      my $name := $op.name;
      %names{$name} := 1;
      my $full_name := $op.full_name;
      my $func_name := $op.func_name( self );
      my $body      := $op.body;
      my $jump      := $op.get_jump;
      my $arg_count := $op.size;

      ## 0 inserted if arrays are empty to prevent msvc compiler errors
      my $arg_types := +$op.arg_types
          ?? '{ ' ~ join( ", ",
              |map( -> $t { sprintf( "PARROT_ARG_%s", uc($t) ) }, |$op.arg_types)
          ) ~ ' }'
          !! '{ (arg_type_t) 0 }';
      my $arg_dirs := $op<normalized_args>
          ?? '{ ' ~ join(", ",
              |map( -> $d { %arg_dir_mapping{$d<direction>} }, |$op<normalized_args>)
          ) ~ ' }'
          !! '{ (arg_dir_t) 0 }';
      my $labels := $op<normalized_args>
          ?? '{ ' ~ join(", ",
              |map( -> $d { $d<is_label> ?? 1 !! 0 }, |$op<normalized_args>)
          ) ~ ' }'
          !! '{ 0 }';

      $fh.print('  { ' ~ qq|/* $index */
  "$name",
  "$full_name",
  "$func_name",
  $jump,
  $arg_count,
  $arg_types,
  $arg_dirs,
  $labels,
  $op_lib_ref
| ~ '},
',
          );

          $index++;
      }
      $fh.print(q|
};

|); }

method _emit_op_function_definitions($emitter, $fh) { $fh.print(q| /* ** Op Function Definitions: */

|);

for self<op_funcs> -> $op {
    $fh.print($op);
}
}

method emit_op_lookup($emitter, $fh) {

if !$emitter.flags<core> {
    return;
}

my $hash_size := 3041;
#    my $tot       := $self->{index} + scalar keys( %{ $self->{names} } );
#    if ( $hash_size < $tot * 1.2 ) {
#        print STDERR "please increase hash_size ($hash_size) in lib/Parrot/Ops2c/Utils.pm "
#            . "to a prime number > ", $tot * 1.2, "\n";
#    }
# Due bug in NQP do it in two passes.
my $res := q|
/*
** Op lookup function:
*/

#define OP_HASH_SIZE 3041

/* we could calculate a prime somewhat bigger than * n of fullnames + n of names * for now this should be ok * * look up an op_code: at first call to op_code() a hash * of short and full opcode names is created * hash functions are from imcc, thanks to Melvin. */

typedef struct hop { op_info_t * info; struct hop *next; } HOP;

static HOP *hop_buckets; static HOP **hop;

static void hop_init(PARROT_INTERP); static size_t hash_str(ARGIN(const char *str)); static void store_op(ARGIN(op_info_t *info), ARGMOD(HOP *p), ARGIN(const char *name));

/* XXX on changing interpreters, this should be called, through a hook */

static void hop_deinit(PARROT_INTERP);

/* * find a short or full opcode * usage: * * interp->op_lib->op_code("set", 0) * interp->op_lib->op_code("set_i_i", 1) * * returns >= 0 (found idx into info_table), -1 if not */

PARROT_PURE_FUNCTION static size_t hash_str(ARGIN(const char *str)) { size_t key = 0; const char *s = str;

while (*s) {
    key *= 65599;
    key += *s++;
}

return key;
}

static void store_op(ARGIN(op_info_t *info), ARGMOD(HOP *p), ARGIN(const char *name)) { const size_t hidx = hash_str(name) % OP_HASH_SIZE;

p->info           = info;
p->next           = hop[hidx];
hop[hidx]         = p;
}

static int get_op(PARROT_INTERP, ARGIN(const char *name), int full) { const HOP *p; const size_t hidx = hash_str(name) % OP_HASH_SIZE;

if (!hop) {
    hop = mem_gc_allocate_n_zeroed_typed(interp, OP_HASH_SIZE,HOP *);
    hop_init(interp);
}

for (p = hop[hidx]; p; p = p->next) {
    if (STREQ(name, full ? p->info->full_name : p->info->name))
        return p->info - [[BS]]op_lib.op_info_table;
}

return -1;
}

static void hop_init(PARROT_INTERP) { op_info_t * const info = [[BS]]op_lib.op_info_table; opcode_t i;

/* allocate the storage all in one chunk
 * yes, this is profligate, but we can tighten it later */
HOP *hops;

hop_buckets = mem_gc_allocate_n_zeroed_typed(interp, [[BS]]op_lib.op_count * 2, HOP );
hops        = hop_buckets;


/* store full names */
for (i = 0; i < [[BS]]op_lib.op_count; i++) {
    store_op(info + i, hops++, info[i].full_name);

    /* plus one short name */
    if (i && info[i - 1].name != info[i].name)
        store_op(info + i, hops++, info[i].name);
}
}

static void hop_deinit(PARROT_INTERP) { if (hop) mem_sys_free(hop); if (hop_buckets) mem_gc_free(interp, hop_buckets);

hop         = NULL;
hop_buckets = NULL;
}|;

$fh.print(subst($res, /'[[' BS ']]'/, $emitter.bs, :global));
}

# vim: expandtab shiftwidth=4 ft=perl6:

3 POD Errors

The following errors were encountered while parsing the POD:

Around line 99:

=begin without a target?

Around line 101:

'=item' outside of any '=over'

=over without closing =back

Around line 105:

'=end' without a target?