The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
APTR                   T_PTR
intArray *             T_ARRAY
UWORD                  T_UV
ULONG                  T_UV
WORD                   T_IV
LONG                   T_IV
BOOL                   T_IV
TagList *              T_TAGLIST
TAGRET                 T_TAGRET
STRPTR                 T_PV
int32                  T_IV
uint32                 T_UV

#############################################################################
INPUT
T_TAGLIST
        U32 ix_$var = $argoff;
        U32 _tag_type;
        /* allocate taglist struct, +2 as tags lists end in a TAG_DONE by tradition */
        /* if by some chance someone  adds something after the TAG_DONE it will just*/
        /* result in harmless empty space */
        $var = $ntype((items -= $argoff) +2);
        while(items > 0)
        {
            int __index = (ix_$var - $argoff)/3;
            $var\[__index\].ti_Tag = (ULONG)SvUV(ST(ix_$var));
            ix_$var++;
            items--;
            /* the last is a tag_done and usualy has no followers so check for > 1 */
            if(items > 1 && ($var\[__index\].ti_Tag != TAG_DONE))
            {
                _tag_type = (ULONG)SvUV(ST(ix_$var));
                ix_$var++;
                switch(_tag_type)
                {
                    case TT_APTR:
                            $var\[__index\].ti_Data = (ULONG)INT2PTR(APTR,SvIV(ST(ix_$var)));
                        break;
                    case TT_WORD:
                            $var\[__index\].ti_Data = (WORD)SvIV(ST(ix_$var));
                        break;
                    case TT_LONG:
                            $var\[__index\].ti_Data = (LONG)SvIV(ST(ix_$var));
                        break;
                    case TT_UWORD:
                            $var\[__index\].ti_Data = (UWORD)SvUV(ST(ix_$var));
                        break;
                    case TT_ULONG:
                            $var\[__index\].ti_Data = (ULONG)SvUV(ST(ix_$var));
                        break;
                    case TT_STRPTR:
                    case TT_UBYTE:
                            $var\[__index\].ti_Data = (ULONG)(STRPTR)SvPV_nolen(ST(ix_$var));
                        break;
                    default:
                        Perl_croak(aTHX_ \"Unknown TAGTYPE \%d\",_tag_type);
                }
                ix_$var++;
                items -=2;
            }
        }

T_TAGRET
        /* Allocate variable type according to preceding var tagtype */
        switch(tagtype)
        {
            case TT_APTR:
                $var.tr_aptr = INT2PTR(APTR,SvIV($arg));
                break;
            case TT_WORD:
                $var.tr_word = (WORD)SvIV($arg);
                break;
            case TT_LONG:
                $var.tr_long = (LONG)SvIV($arg);
            case TT_UWORD:
                $var.tr_uword = (UWORD)SvUV($arg);
                break;
            case TT_ULONG:
                $var.tr_ulong = (ULONG)SvUV($arg);
                break;
            case TT_STRPTR:
            case TT_UBYTE:
                $var.tr_strptr = (STRPTR)SvPV_nolen($arg);
                break;
            default:
                Perl_croak(aTHX_ \"Unknown TAGTYPE \%d\",tagtype);
        }

####################################################################################
OUTPUT
T_TAGRET
        /* Allocate variable type according to preceding var tagtype */
        switch(tagtype)
        {
            case TT_APTR:
                sv_setiv($arg, PTR2IV($var.tr_aptr));
                break;
            case TT_WORD:
                sv_setiv($arg, (IV)$var.tr_word);
                break;
            case TT_LONG:
                sv_setiv($arg, (IV)$var.tr_long);
                break;
            case TT_UWORD:
                sv_setuv($arg, (UV)$var.tr_uword);
                break;
            case TT_ULONG:
                sv_setuv($arg, (UV)$var.tr_ulong);
                break;
            case TT_STRPTR:
            case TT_UBYTE:
                sv_setpv((SV*)$arg, $var.tr_strptr);
                break;
            default:
                Perl_croak(aTHX_ \"Unknown TAGTYPE \%d\",tagtype);
        }