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); }