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         AV*  self;
 147     CODE:
 148         RETVAL = av_len(self) + 1;
 149     OUTPUT:
 150         RETVAL
 151
 152
 153 #
 154 # my $val = $vec->get_component($dim);
 155 #
 156 # Return the value for dimension $dim.
 157 #
 158 IV
 159 get_component( self, dim )
 160         AV*  self;
 161         IV   dim;
 162     CODE:
 163         if ( dim < 0 || dim > av_len(self) )
 164             croak( "No such dimension!" );
 165         RETVAL = SvIV( *av_fetch(self, dim, 0) );
 166     OUTPUT:
 167         RETVAL
 168
 169
 170 #
 171 # my @vals = $vec->get_all_components;
 172 #
 173 # Get the values for all dimensions, in order from 0..N.
 174 #
 175 void
 176 get_all_components( self )
 177         SV*  self;
 178     PREINIT:
 179         IV   dim, i, val;
 180         AV*  my_array;
 181     PPCODE:
 182         /* fetch the underlying array of the object */
 183         my_array = (AV*)SvRV(self);
 184         dim = av_len(my_array);
 185
 186         EXTEND(SP,dim+1);
 187         for ( i=0; i<=dim; i++ ) {
 188             val = SvIV( *av_fetch(my_array, i, 0) );
 189             PUSHs( sv_2mortal( newSViv(val) ) );
 190         }
 191
 192
 193 #- mutators
 194
 195 #
 196 # $vec->clear;
 197 #
 198 # Set the vector back to the origin, all 0's.
 199 #
 200 void
 201 clear( self )
 202         SV*  self;
 203     INIT:
 204         IV   dim, i, zero;
 205         AV*  my_array;
 206     PPCODE:
 207         /* fetch the underlying array of the object */
 208         my_array = (AV*)SvRV(self);
 209         dim = av_len(my_array);
 210         for ( i=0; i<dim; i++ ) {
 211             zero = newSViv(0);
 212             av_store(my_array, i, zero);
 213         }
 214
 215
 216 #
 217 # my $val = $vec->set_component( $dim, $value );
 218 #
 219 # Set the value for dimension $dim to $value.
 220 #
 221 void
 222 set_component( self, dim, value )
 223         SV*  self;
 224         IV   dim;
 225         IV   value;
 226     INIT:
 227         AV*  my_array;
 228     CODE:
 229         /* fetch the underlying array of the object */
 230         my_array = (AV*)SvRV(self);
 231
 232         /* sanity checks */
 233         if ( dim < 0 || dim > av_len(my_array) )
 234             croak( "No such dimension!" );
 235
 236         /* storing new value */
 237         av_store(my_array, dim, newSViv(value));
 238
 239
 240 # -- PRIVATE METHODS
 241
 242 #- inplace math ops
 243
 244 #
 245 # $v1->_add_inplace($v2);
 246 # $v1 += $v2;
 247 #
 248 # Adds $v2 to $v1, and stores the result back into $v1.
 249 #
 250 SV*
 251 _add_inplace( v1, v2, variant )
 252         SV*  v1;
 253         SV*  v2;
 254         SV*  variant;
 255     INIT:
 256         IV   dimv1, dimv2, i, val1, val2;
 257         AV*  v1_array;
 258         AV*  v2_array;
 259     CODE:
 260         /* fetch the underlying array of the object */
 261         v1_array = (AV*)SvRV(v1);
 262         v2_array = (AV*)SvRV(v2);
 263         dimv1 = av_len(v1_array);
 264         dimv2 = av_len(v2_array);
 265
 266         /* sanity checks */
 267         if ( dimv1 != dimv2 )
 268             croak("uneven dimensions in vector addition!");
 269
 270         for ( i=0 ; i<=dimv1; i++ ) {
 271             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 272             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 273             av_store( v1_array, i, newSViv(val1+val2) );
 274             }
 275     OUTPUT:
 276         v1
 277
 278
 279 #
 280 # $v1->_substract_inplace($v2);
 281 # $v1 -= $v2;
 282 #
 283 # Substract $v2 to $v1, and stores the result back into $v1.
 284 #
 285 SV*
 286 _substract_inplace( v1, v2, variant )
 287         SV*  v1;
 288         SV*  v2;
 289         SV*  variant;
 290     INIT:
 291         IV   dimv1, dimv2, i, val1, val2;
 292         AV*  v1_array;
 293         AV*  v2_array;
 294     CODE:
 295         /* fetch the underlying array of the object */
 296         v1_array = (AV*)SvRV(v1);
 297         v2_array = (AV*)SvRV(v2);
 298         dimv1 = av_len(v1_array);
 299         dimv2 = av_len(v2_array);
 300
 301         /* sanity checks */
 302         if ( dimv1 != dimv2 )
 303             croak("uneven dimensions in vector addition!");
 304
 305         for ( i=0 ; i<=dimv1; i++ ) {
 306             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 307             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 308             av_store( v1_array, i, newSViv(val1-val2) );
 309             }
 310     OUTPUT:
 311         v1
 312
 313
 314 #- comparison
 315
 316 #
 317 # my $bool = $v1->_compare($v2);
 318 # my $bool = $v1 <=> $v2;
 319 #
 320 # Check whether the vectors both point at the same spot. Return 0 if they
 321 # do, 1 if they don't.
 322 #
 323 IV
 324 _compare( v1, v2, variant )
 325         AV*  v1;
 326         AV*  v2;
 327         SV*  variant;
 328
 329     INIT:
 330         IV   dimv1, dimv2, i, val1, val2;
 331     CODE:
 332         dimv1 = av_len(v1);
 333         dimv2 = av_len(v2);
 334
 335         /* sanity checks */
 336         if ( dimv1 != dimv2 )
 337             croak("uneven dimensions in bounds check!");
 338
 339         RETVAL = 0;
 340         for ( i=0 ; i<=dimv1; i++ ) {
 341             val1 = SvIV( *av_fetch(v1, i, 0) );
 342             val2 = SvIV( *av_fetch(v2, i, 0) );
 343             if ( val1 != val2 ) {
 344                 RETVAL = 1;
 345                 break;
 346             }
 347         }
 348     OUTPUT:
 349         RETVAL
 350
 351