Commit | Line | Data |
---|---|---|
4ceeac64 AB |
1 | APTR T_PTR |
2 | intArray * T_ARRAY | |
3 | UWORD T_UV | |
4 | ULONG T_UV | |
5 | WORD T_IV | |
6 | LONG T_IV | |
7 | BOOL T_IV | |
8 | TagList * T_TAGLIST | |
9 | TAGRET T_TAGRET | |
10 | STRPTR T_PV | |
11 | int32 T_IV | |
12 | uint32 T_UV | |
13 | ||
14 | ############################################################################# | |
15 | INPUT | |
16 | T_TAGLIST | |
17 | U32 ix_$var = $argoff; | |
18 | U32 _tag_type; | |
19 | /* allocate taglist struct, +2 as tags lists end in a TAG_DONE by tradition */ | |
20 | /* if by some chance someone adds something after the TAG_DONE it will just*/ | |
21 | /* result in harmless empty space */ | |
22 | $var = $ntype((items -= $argoff) +2); | |
23 | while(items > 0) | |
24 | { | |
25 | int __index = (ix_$var - $argoff)/3; | |
26 | $var\[__index\].ti_Tag = (ULONG)SvUV(ST(ix_$var)); | |
27 | ix_$var++; | |
28 | items--; | |
29 | /* the last is a tag_done and usualy has no followers so check for > 1 */ | |
30 | if(items > 1 && ($var\[__index\].ti_Tag != TAG_DONE)) | |
31 | { | |
32 | _tag_type = (ULONG)SvUV(ST(ix_$var)); | |
33 | ix_$var++; | |
34 | switch(_tag_type) | |
35 | { | |
36 | case TT_APTR: | |
37 | $var\[__index\].ti_Data = (ULONG)INT2PTR(APTR,SvIV(ST(ix_$var))); | |
38 | break; | |
39 | case TT_WORD: | |
40 | $var\[__index\].ti_Data = (WORD)SvIV(ST(ix_$var)); | |
41 | break; | |
42 | case TT_LONG: | |
43 | $var\[__index\].ti_Data = (LONG)SvIV(ST(ix_$var)); | |
44 | break; | |
45 | case TT_UWORD: | |
46 | $var\[__index\].ti_Data = (UWORD)SvUV(ST(ix_$var)); | |
47 | break; | |
48 | case TT_ULONG: | |
49 | $var\[__index\].ti_Data = (ULONG)SvUV(ST(ix_$var)); | |
50 | break; | |
51 | case TT_STRPTR: | |
52 | case TT_UBYTE: | |
53 | $var\[__index\].ti_Data = (ULONG)(STRPTR)SvPV_nolen(ST(ix_$var)); | |
54 | break; | |
55 | default: | |
56 | Perl_croak(aTHX_ \"Unknown TAGTYPE \%d\",_tag_type); | |
57 | } | |
58 | ix_$var++; | |
59 | items -=2; | |
60 | } | |
61 | } | |
62 | ||
63 | T_TAGRET | |
64 | /* Allocate variable type according to preceding var tagtype */ | |
65 | switch(tagtype) | |
66 | { | |
67 | case TT_APTR: | |
68 | $var.tr_aptr = INT2PTR(APTR,SvIV($arg)); | |
69 | break; | |
70 | case TT_WORD: | |
71 | $var.tr_word = (WORD)SvIV($arg); | |
72 | break; | |
73 | case TT_LONG: | |
74 | $var.tr_long = (LONG)SvIV($arg); | |
75 | case TT_UWORD: | |
76 | $var.tr_uword = (UWORD)SvUV($arg); | |
77 | break; | |
78 | case TT_ULONG: | |
79 | $var.tr_ulong = (ULONG)SvUV($arg); | |
80 | break; | |
81 | case TT_STRPTR: | |
82 | case TT_UBYTE: | |
83 | $var.tr_strptr = (STRPTR)SvPV_nolen($arg); | |
84 | break; | |
85 | default: | |
86 | Perl_croak(aTHX_ \"Unknown TAGTYPE \%d\",tagtype); | |
87 | } | |
88 | ||
89 | #################################################################################### | |
90 | OUTPUT | |
91 | T_TAGRET | |
92 | /* Allocate variable type according to preceding var tagtype */ | |
93 | switch(tagtype) | |
94 | { | |
95 | case TT_APTR: | |
96 | sv_setiv($arg, PTR2IV($var.tr_aptr)); | |
97 | break; | |
98 | case TT_WORD: | |
99 | sv_setiv($arg, (IV)$var.tr_word); | |
100 | break; | |
101 | case TT_LONG: | |
102 | sv_setiv($arg, (IV)$var.tr_long); | |
103 | break; | |
104 | case TT_UWORD: | |
105 | sv_setuv($arg, (UV)$var.tr_uword); | |
106 | break; | |
107 | case TT_ULONG: | |
108 | sv_setuv($arg, (UV)$var.tr_ulong); | |
109 | break; | |
110 | case TT_STRPTR: | |
111 | case TT_UBYTE: | |
112 | sv_setpv((SV*)$arg, $var.tr_strptr); | |
113 | break; | |
114 | default: | |
115 | Perl_croak(aTHX_ \"Unknown TAGTYPE \%d\",tagtype); | |
116 | } | |
117 | ||
118 |