ext/Amiga-ARexx/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