xref: /openbsd/gnu/usr.bin/perl/ext/Amiga-Exec/typemap (revision b8851fcc) 
1APTR                   T_PTR
2intArray *             T_ARRAY
3UWORD                  T_UV
4ULONG                  T_UV
5WORD                   T_IV
6LONG                   T_IV
7BOOL                   T_IV
8TagList *              T_TAGLIST
9TAGRET                 T_TAGRET
10STRPTR                 T_PV
11int32                  T_IV
12uint32                 T_UV
13
14#############################################################################
15INPUT
16T_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
63T_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####################################################################################
90OUTPUT
91T_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
119