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 #
 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
 191     PREINIT:
 192         IV  dim, i, val;
 193         AV* my_array;
 194
 195     PPCODE:
 196         /* fetch the underlying array of the object */
 197         my_array = (AV*)SvRV(self);
 198         dim = av_len(my_array);
 199
 200         EXTEND(SP,dim+1);
 201         for ( i=0; i<=dim; i++ ) {
 202             val = SvIV( *av_fetch(my_array, i, 0) );
 203             PUSHs( sv_2mortal( newSViv(val) ) );
 204         }
 205
 206
 207 #- mutators
 208
 209 #
 210 # $vec->clear;
 211 #
 212 # Set the vector back to the origin, all 0's.
 213 #
 214 void
 215 clear( self )
 216         SV* self
 217     INIT:
 218         IV   dim, i, zero;
 219         AV*  my_array;
 220     PPCODE:
 221         /* fetch the underlying array of the object */
 222         my_array = (AV*)SvRV(self);
 223         dim = av_len(my_array);
 224         for ( i=0; i<dim; i++ ) {
 225             zero = newSViv(0);
 226             av_store(my_array, i, zero);
 227         }
 228
 229
 230 # -- PRIVATE METHODS
 231
 232 #- inplace math ops
 233
 234 #
 235 # $v1->_add_inplace($v2);
 236 # $v1 += $v2;
 237 #
 238 # Adds $v2 to $v1, and stores the result back into $v1.
 239 #
 240 SV*
 241 _add_inplace( v1, v2, variant )
 242         SV* v1;
 243         SV* v2;
 244         SV* variant;
 245
 246     INIT:
 247         I32 dimv1, dimv2;
 248         I32 i;
 249         I32 val1, val2;
 250         AV* v1_array;
 251         AV* v2_array;
 252
 253     CODE:
 254         /* fetch the underlying array of the object */
 255         v1_array = (AV*)SvRV(v1);
 256         v2_array = (AV*)SvRV(v2);
 257         dimv1 = av_len(v1_array);
 258         dimv2 = av_len(v2_array);
 259
 260         /* sanity checks */
 261         if ( dimv1 != dimv2 )
 262             croak("uneven dimensions in vector addition!");
 263
 264         for ( i=0 ; i<=dimv1; i++ ) {
 265             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 266             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 267             av_store( v1_array, i, newSViv(val1+val2) );
 268             }
 269
 270     OUTPUT:
 271         v1
 272
 273
 274 #
 275 # $v1->_substract_inplace($v2);
 276 # $v1 -= $v2;
 277 #
 278 # Substract $v2 to $v1, and stores the result back into $v1.
 279 #
 280 SV*
 281 _substract_inplace( v1, v2, variant )
 282         SV* v1;
 283         SV* v2;
 284         SV* variant;
 285
 286     INIT:
 287         I32 dimv1, dimv2;
 288         I32 i;
 289         I32 val1, val2;
 290         AV* v1_array;
 291         AV* v2_array;
 292
 293     CODE:
 294         /* fetch the underlying array of the object */
 295         v1_array = (AV*)SvRV(v1);
 296         v2_array = (AV*)SvRV(v2);
 297         dimv1 = av_len(v1_array);
 298         dimv2 = av_len(v2_array);
 299
 300         /* sanity checks */
 301         if ( dimv1 != dimv2 )
 302             croak("uneven dimensions in vector addition!");
 303
 304         for ( i=0 ; i<=dimv1; i++ ) {
 305             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 306             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 307             av_store( v1_array, i, newSViv(val1-val2) );
 308             }
 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 I32
 324 _compare( v1, v2, variant )
 325         AV* v1;
 326         AV* v2;
 327         SV* variant;
 328
 329     INIT:
 330         I32 dimv1, dimv2;
 331         I32 i;
 332         I32 val1, val2;
 333
 334     CODE:
 335         dimv1 = av_len(v1);
 336         dimv2 = av_len(v2);
 337
 338         /* sanity checks */
 339         if ( dimv1 != dimv2 )
 340             croak("uneven dimensions in bounds check!");
 341
 342         RETVAL = 0;
 343         for ( i=0 ; i<=dimv1; i++ ) {
 344             val1 = SvIV( *av_fetch(v1, i, 0) );
 345             val2 = SvIV( *av_fetch(v2, i, 0) );
 346             if ( val1 != val2 ) {
 347                 RETVAL = 1;
 348                 break;
 349             }
 350         }
 351
 352     OUTPUT:
 353         RETVAL
 354
 355