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             printf("%d\n",val);
 204             PUSHs( sv_2mortal( newSViv(val) ) );
 205         }
 206
 207
 208 #- mutators
 209
 210 # -- PRIVATE METHODS
 211
 212 #- inplace math ops
 213
 214 #
 215 # $v1->_add_inplace($v2);
 216 # $v1 += $v2;
 217 #
 218 # Adds $v2 to $v1, and stores the result back into $v1.
 219 #
 220 SV*
 221 _add_inplace( v1, v2, variant )
 222         SV* v1;
 223         SV* v2;
 224         SV* variant;
 225
 226     INIT:
 227         I32 dimv1, dimv2;
 228         I32 i;
 229         I32 val1, val2;
 230         AV* v1_array;
 231         AV* v2_array;
 232
 233     CODE:
 234         /* fetch the underlying array of the object */
 235         v1_array = (AV*)SvRV(v1);
 236         v2_array = (AV*)SvRV(v2);
 237         dimv1 = av_len(v1_array);
 238         dimv2 = av_len(v2_array);
 239
 240         /* sanity checks */
 241         if ( dimv1 != dimv2 )
 242             croak("uneven dimensions in vector addition!");
 243
 244         for ( i=0 ; i<=dimv1; i++ ) {
 245             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 246             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 247             av_store( v1_array, i, newSViv(val1+val2) );
 248             }
 249
 250     OUTPUT:
 251         v1
 252
 253
 254 #
 255 # $v1->_substract_inplace($v2);
 256 # $v1 -= $v2;
 257 #
 258 # Substract $v2 to $v1, and stores the result back into $v1.
 259 #
 260 SV*
 261 _substract_inplace( v1, v2, variant )
 262         SV* v1;
 263         SV* v2;
 264         SV* variant;
 265
 266     INIT:
 267         I32 dimv1, dimv2;
 268         I32 i;
 269         I32 val1, val2;
 270         AV* v1_array;
 271         AV* v2_array;
 272
 273     CODE:
 274         /* fetch the underlying array of the object */
 275         v1_array = (AV*)SvRV(v1);
 276         v2_array = (AV*)SvRV(v2);
 277         dimv1 = av_len(v1_array);
 278         dimv2 = av_len(v2_array);
 279
 280         /* sanity checks */
 281         if ( dimv1 != dimv2 )
 282             croak("uneven dimensions in vector addition!");
 283
 284         for ( i=0 ; i<=dimv1; i++ ) {
 285             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 286             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 287             av_store( v1_array, i, newSViv(val1-val2) );
 288             }
 289
 290     OUTPUT:
 291         v1
 292
 293
 294 #- comparison
 295
 296 #
 297 # my $bool = $v1->_compare($v2);
 298 # my $bool = $v1 <=> $v2;
 299 #
 300 # Check whether the vectors both point at the same spot. Return 0 if they
 301 # do, 1 if they don't.
 302 #
 303 I32
 304 _compare( v1, v2, variant )
 305         AV* v1;
 306         AV* v2;
 307         SV* variant;
 308
 309     INIT:
 310         I32 dimv1, dimv2;
 311         I32 i;
 312         I32 val1, val2;
 313
 314     CODE:
 315         dimv1 = av_len(v1);
 316         dimv2 = av_len(v2);
 317
 318         /* sanity checks */
 319         if ( dimv1 != dimv2 )
 320             croak("uneven dimensions in bounds check!");
 321
 322         RETVAL = 0;
 323         for ( i=0 ; i<=dimv1; i++ ) {
 324             val1 = SvIV( *av_fetch(v1, i, 0) );
 325             val2 = SvIV( *av_fetch(v2, i, 0) );
 326             if ( val1 != val2 ) {
 327                 RETVAL = 1;
 328                 break;
 329             }
 330         }
 331
 332     OUTPUT:
 333         RETVAL
 334
 335