better document macros taking literal strings
[perl.git] / ext / Amiga-Exec / typemap
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