XS.xs

   1 /*
   2 #
   3 # This file is part of Language::Befunge::Vector::XS.
   4 # Copyright (c) 2008 Jerome Quelin, all rights reserved.
   5 #
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the same terms as Perl itself.
   8 #
   9 #
  10 */
  11
  12
  13 #include "EXTERN.h"
  14 #include "perl.h"
  15 #include "XSUB.h"
  16
  17 #include "ppport.h"
  18
  19
  20 /* used for constructor new() */
  21 typedef int intArray;
  22 void* intArrayPtr(int num) {
  23     SV* mortal;
  24     mortal = sv_2mortal( NEWSV(0, num * sizeof(intArray)) );
  25     return SvPVX(mortal);
  26 }
  27
  28
  29
  30 MODULE = Language::Befunge::Vector::XS          PACKAGE = Language::Befunge::Vector::XS
  31
  32
  33 #-- CONSTRUCTORS
  34
  35 #
  36 # my $vec = LB::Vector->new( $x [, $y, ...] );
  37 #
  38 # Create a new vector. The arguments are the actual vector data; one
  39 # integer per dimension.
  40 #
  41 SV *
  42 new( class, array, ... )
  43         char*       class;
  44         intArray*   array
  45
  46     INIT:
  47             I32  i;
  48             SV*  self;
  49             SV*  val;
  50             AV*  my_array;
  51             HV*  stash;
  52
  53     CODE:
  54         /* create the object and populate it */
  55         my_array = newAV();
  56         for ( i=0; i<ix_array; i++ ) {
  57             val = newSViv( array[i] );
  58             av_push(my_array, val);
  59         }
  60
  61         /* Return a blessed reference to the AV */
  62         self  = newRV_noinc( (SV*)my_array );
  63         stash = gv_stashpv( class, TRUE );
  64         sv_bless( (SV*)RETVAL, stash );
  65         RETVAL = self;
  66
  67     OUTPUT:
  68         RETVAL
  69
  70
  71 #
  72 # my $vec = Language::Befunge::Vector::XS->new_zeroes( $dims );
  73 #
  74 # Create a new vector of dimension $dims, set to the origin (all
  75 # zeroes). LBVXS->new_zeroes(2) is exactly equivalent to LBVXS->new(0, 0).
  76 #
  77 SV *
  78 new_zeroes( class, dimension )
  79         char* class;
  80         I32   dimension;
  81
  82     INIT:
  83         I32  i;
  84         SV*  self;
  85         SV*  zero;
  86         AV*  my_array;
  87         HV*  stash;
  88
  89     CODE:
  90         /* create the object and populate it */
  91         my_array = newAV();
  92         for ( i=0; i<dimension; i++ ) {
  93             zero = newSViv(0);
  94             av_push(my_array, zero);
  95         }
  96
  97         /* return a blessed reference to the AV */
  98         self  = newRV_noinc( (SV*)my_array );
  99         stash = gv_stashpv( class, TRUE );
 100         sv_bless( (SV*)self, stash );
 101         RETVAL = self;
 102
 103     OUTPUT:
 104         RETVAL
 105
 106
 107 #
 108 # my $vec = $v->copy;
 109 #
 110 # Return a new LBVXS object, which has the same dimensions and
 111 # coordinates as $v.
 112 #
 113 SV*
 114 copy( vec )
 115         SV* vec;
 116
 117     INIT:
 118         I32  val, i;
 119         SV*  self;
 120         AV*  my_array;
 121         AV*  vec_array;
 122         HV*  stash;
 123
 124     CODE:
 125         vec_array = (AV*)SvRV(vec);
 126
 127         /* create the object and populate it */
 128         my_array = newAV();
 129         for ( i=0; i<=av_len(vec_array); i++ ) {
 130             val = newSViv( SvIV(*av_fetch(vec_array, i, 0)) );
 131             av_push(my_array, val);
 132         }
 133
 134         /* return a blessed reference to the AV */
 135         self  = newRV_noinc( (SV*)my_array );
 136         stash = SvSTASH( (SV*)vec_array );
 137         sv_bless( (SV*)self, stash );
 138         RETVAL = self;
 139
 140     OUTPUT:
 141         RETVAL
 142
 143
 144 #-- PUBLIC METHODS
 145
 146 #- accessors
 147
 148 #
 149 # my $dims = $vec->get_dims;
 150 #
 151 # Return the number of dimensions, an integer.
 152 #
 153 I32
 154 get_dims( self )
 155         AV* self;
 156
 157     CODE:
 158         RETVAL = av_len(self) + 1;
 159
 160     OUTPUT:
 161         RETVAL
 162
 163 #
 164 # my $val = $vec->get_component( $index );
 165 #
 166 # Return the value for dimension $index.
 167 #
 168 I32
 169 get_component( self, index )
 170         AV* self;
 171         I32 index;
 172
 173     CODE:
 174         if ( index < 0 || index > av_len(self) )
 175             croak( "No such dimension!" );
 176         RETVAL = SvIV( *av_fetch(self, index, 0) );
 177
 178     OUTPUT:
 179         RETVAL
 180
 181
 182 #- mutators
 183
 184 # -- PRIVATE METHODS
 185
 186 #- inplace math ops
 187
 188 #
 189 # $v1->_substract_inplace($v2);
 190 # $v1 -= $v2;
 191 #
 192 # Substract $v2 to $v1, and stores the result back into $v1.
 193 #
 194 AV* _substract_inplace( v1, v2 )
 195         AV* v1;
 196         AV* v2;
 197
 198     INIT:
 199         I32 dimv1, dimv2;
 200         I32 i;
 201         I32 val1, val2;
 202
 203     CODE:
 204         dimv1 = av_len(v1);
 205         dimv2 = av_len(v2);
 206
 207         /* sanity checks */
 208         if ( dimv1 != dimv2 )
 209             croak("uneven dimensions in vector substraction!");
 210
 211         for ( i=0 ; i<=dimv1; i++ ) {
 212             val1 = SvIV( *av_fetch(v1, i, 0) );
 213             val2 = SvIV( *av_fetch(v2, i, 0) );
 214             av_store( v1, i, newSViv(val1-val2) );
 215             }
 216         RETVAL = v1;
 217
 218     OUTPUT:
 219         RETVAL
 220
 221
 222 #- comparison
 223
 224 #
 225 # my $bool = $v1->_compare($v2);
 226 # my $bool = $v1 <=> $v2;
 227 #
 228 # Check whether the vectors both point at the same spot. Return 0 if they
 229 # do, 1 if they don't.
 230 #
 231 I32
 232 _compare( v1, v2, variant )
 233         AV* v1;
 234         AV* v2;
 235         SV* variant;
 236
 237     INIT:
 238         I32 dimv1, dimv2;
 239         I32 i;
 240         I32 val1, val2;
 241
 242     CODE:
 243         dimv1 = av_len(v1);
 244         dimv2 = av_len(v2);
 245
 246         /* sanity checks */
 247         if ( dimv1 != dimv2 )
 248             croak("uneven dimensions in bounds check!");
 249
 250         RETVAL = 0;
 251         for ( i=0 ; i<=dimv1; i++ ) {
 252             val1 = SvIV( *av_fetch(v1, i, 0) );
 253             val2 = SvIV( *av_fetch(v2, i, 0) );
 254             if ( val1 != val2 ) {
 255                 RETVAL = 1;
 256                 break;
 257             }
 258         }
 259
 260     OUTPUT:
 261         RETVAL
 262
 263