The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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?