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     INIT:
  46             IV     i;
  47             SV*    self;
  48             SV*    val;
  49             AV*    my_array;
  50             HV*    stash;
  51     CODE:
  52         /* create the object and populate it */
  53         my_array = newAV();
  54         for ( i=0; i<ix_array; i++ ) {
  55             val = newSViv( array[i] );
  56             av_push(my_array, val);
  57         }
  58
  59         /* Return a blessed reference to the AV */
  60         self  = newRV_noinc( (SV*)my_array );
  61         stash = gv_stashpv( class, TRUE );
  62         sv_bless( (SV*)RETVAL, stash );
  63         RETVAL = self;
  64     OUTPUT:
  65         RETVAL
  66
  67
  68 #
  69 # my $vec = Language::Befunge::Vector::XS->new_zeroes( $dims );
  70 #
  71 # Create a new vector of dimension $dims, set to the origin (all
  72 # zeroes). LBVXS->new_zeroes(2) is exactly equivalent to LBVXS->new(0, 0).
  73 #
  74 SV *
  75 new_zeroes( class, dim )
  76         char*  class;
  77         IV     dim;
  78     INIT:
  79         IV     i;
  80         SV*    self;
  81         SV*    zero;
  82         AV*    my_array;
  83         HV*    stash;
  84     CODE:
  85         /* create the object and populate it */
  86         my_array = newAV();
  87         for ( i=0; i<dim; i++ ) {
  88             zero = newSViv(0);
  89             av_push(my_array, zero);
  90         }
  91
  92         /* return a blessed reference to the AV */
  93         self  = newRV_noinc( (SV*)my_array );
  94         stash = gv_stashpv( class, TRUE );
  95         sv_bless( (SV*)self, stash );
  96         RETVAL = self;
  97     OUTPUT:
  98         RETVAL
  99
 100
 101 #
 102 # my $vec = $v->copy;
 103 #
 104 # Return a new LBVXS object, which has the same dimensions and
 105 # coordinates as $v.
 106 #
 107 SV*
 108 copy( vec, ... )
 109         SV*  vec;
 110     INIT:
 111         IV   val, i;
 112         SV*  self;
 113         AV*  my_array;
 114         AV*  vec_array;
 115         HV*  stash;
 116     CODE:
 117         vec_array = (AV*)SvRV(vec);
 118
 119         /* create the object and populate it */
 120         my_array = newAV();
 121         for ( i=0; i<=av_len(vec_array); i++ ) {
 122             val = newSViv( SvIV(*av_fetch(vec_array, i, 0)) );
 123             av_push(my_array, val);
 124         }
 125
 126         /* return a blessed reference to the AV */
 127         self  = newRV_noinc( (SV*)my_array );
 128         stash = SvSTASH( (SV*)vec_array );
 129         sv_bless( (SV*)self, stash );
 130         RETVAL = self;
 131     OUTPUT:
 132         RETVAL
 133
 134
 135 #-- PUBLIC METHODS
 136
 137 #- accessors
 138
 139 #
 140 # my $dims = $vec->get_dims;
 141 #
 142 # Return the number of dimensions, an integer.
 143 #
 144 IV
 145 get_dims( self )
 146         SV*  self;
 147     PREINIT:
 148         AV*  my_array;
 149     CODE:
 150         /* fetch the underlying array of the object */
 151         my_array = (AV*)SvRV(self);
 152
 153         RETVAL = av_len(my_array) + 1;
 154     OUTPUT:
 155         RETVAL
 156
 157
 158 #
 159 # my $val = $vec->get_component($dim);
 160 #
 161 # Return the value for dimension $dim.
 162 #
 163 IV
 164 get_component( self, dim )
 165         SV*  self;
 166         IV   dim;
 167     PREINIT:
 168         AV*  my_array;
 169     CODE:
 170         /* fetch the underlying array of the object */
 171         my_array = (AV*)SvRV(self);
 172
 173         /* sanity checks */
 174         if ( dim < 0 || dim > av_len(my_array) )
 175             croak( "No such dimension!" );
 176
 177         RETVAL = SvIV( *av_fetch(my_array, dim, 0) );
 178     OUTPUT:
 179         RETVAL
 180
 181
 182 #
 183 # my @vals = $vec->get_all_components;
 184 #
 185 # Get the values for all dimensions, in order from 0..N.
 186 #
 187 void
 188 get_all_components( self )
 189         SV*  self;
 190     PREINIT:
 191         IV   dim, i, val;
 192         AV*  my_array;
 193     PPCODE:
 194         /* fetch the underlying array of the object */
 195         my_array = (AV*)SvRV(self);
 196         dim = av_len(my_array);
 197
 198         EXTEND(SP,dim+1);
 199         for ( i=0; i<=dim; i++ ) {
 200             val = SvIV( *av_fetch(my_array, i, 0) );
 201             PUSHs( sv_2mortal( newSViv(val) ) );
 202         }
 203
 204
 205 #- mutators
 206
 207 #
 208 # $vec->clear;
 209 #
 210 # Set the vector back to the origin, all 0's.
 211 #
 212 void
 213 clear( self )
 214         SV*  self;
 215     INIT:
 216         IV   dim, i, zero;
 217         AV*  my_array;
 218     PPCODE:
 219         /* fetch the underlying array of the object */
 220         my_array = (AV*)SvRV(self);
 221         dim = av_len(my_array);
 222         for ( i=0; i<=dim; i++ ) {
 223             zero = newSViv(0);
 224             av_store(my_array, i, zero);
 225         }
 226
 227
 228 #
 229 # my $val = $vec->set_component( $dim, $value );
 230 #
 231 # Set the value for dimension $dim to $value.
 232 #
 233 void
 234 set_component( self, dim, value )
 235         SV*  self;
 236         IV   dim;
 237         IV   value;
 238     INIT:
 239         AV*  my_array;
 240     CODE:
 241         /* fetch the underlying array of the object */
 242         my_array = (AV*)SvRV(self);
 243
 244         /* sanity checks */
 245         if ( dim < 0 || dim > av_len(my_array) )
 246             croak( "No such dimension!" );
 247
 248         /* storing new value */
 249         av_store(my_array, dim, newSViv(value));
 250
 251
 252 # -- PRIVATE METHODS
 253
 254 #- inplace math ops
 255
 256 #
 257 # $v1->_add_inplace($v2);
 258 # $v1 += $v2;
 259 #
 260 # Adds $v2 to $v1, and stores the result back into $v1.
 261 #
 262 SV*
 263 _add_inplace( v1, v2, variant )
 264         SV*  v1;
 265         SV*  v2;
 266         SV*  variant;
 267     INIT:
 268         IV   dimv1, dimv2, i, val1, val2;
 269         AV*  v1_array;
 270         AV*  v2_array;
 271     CODE:
 272         /* fetch the underlying array of the object */
 273         v1_array = (AV*)SvRV(v1);
 274         v2_array = (AV*)SvRV(v2);
 275         dimv1 = av_len(v1_array);
 276         dimv2 = av_len(v2_array);
 277
 278         /* sanity checks */
 279         if ( dimv1 != dimv2 )
 280             croak("uneven dimensions in vector addition!");
 281
 282         for ( i=0 ; i<=dimv1; i++ ) {
 283             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 284             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 285             av_store( v1_array, i, newSViv(val1+val2) );
 286             }
 287     OUTPUT:
 288         v1
 289
 290
 291 #
 292 # $v1->_substract_inplace($v2);
 293 # $v1 -= $v2;
 294 #
 295 # Substract $v2 to $v1, and stores the result back into $v1.
 296 #
 297 SV*
 298 _substract_inplace( v1, v2, variant )
 299         SV*  v1;
 300         SV*  v2;
 301         SV*  variant;
 302     INIT:
 303         IV   dimv1, dimv2, i, val1, val2;
 304         AV*  v1_array;
 305         AV*  v2_array;
 306     CODE:
 307         /* fetch the underlying array of the object */
 308         v1_array = (AV*)SvRV(v1);
 309         v2_array = (AV*)SvRV(v2);
 310         dimv1 = av_len(v1_array);
 311         dimv2 = av_len(v2_array);
 312
 313         /* sanity checks */
 314         if ( dimv1 != dimv2 )
 315             croak("uneven dimensions in vector addition!");
 316
 317         for ( i=0 ; i<=dimv1; i++ ) {
 318             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 319             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 320             av_store( v1_array, i, newSViv(val1-val2) );
 321             }
 322     OUTPUT:
 323         v1
 324
 325
 326 #- comparison
 327
 328 #
 329 # my $bool = $v1->_compare($v2);
 330 # my $bool = $v1 <=> $v2;
 331 #
 332 # Check whether the vectors both point at the same spot. Return 0 if they
 333 # do, 1 if they don't.
 334 #
 335 IV
 336 _compare( v1, v2, variant )
 337         SV*  v1;
 338         SV*  v2;
 339         SV*  variant;
 340
 341     INIT:
 342         IV   dimv1, dimv2, i, val1, val2;
 343         AV*  v1_array;
 344         AV*  v2_array;
 345     CODE:
 346         /* fetch the underlying array of the object */
 347         v1_array = (AV*)SvRV(v1);
 348         v2_array = (AV*)SvRV(v2);
 349         dimv1 = av_len(v1_array);
 350         dimv2 = av_len(v2_array);
 351
 352         /* sanity checks */
 353         if ( dimv1 != dimv2 )
 354             croak("uneven dimensions in bounds check!");
 355
 356         RETVAL = 0;
 357         for ( i=0 ; i<=dimv1; i++ ) {
 358             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 359             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 360             if ( val1 != val2 ) {
 361                 RETVAL = 1;
 362                 break;
 363             }
 364         }
 365     OUTPUT:
 366         RETVAL
 367
 368