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         /* sanity checks */
  53         if ( ix_array < 0 )
  54                 croak("Usage: %s->new($x,...)", class);
  55
  56         /* create the object and populate it */
  57         my_array = newAV();
  58         for ( i=0; i<ix_array; i++ ) {
  59             val = newSViv( array[i] );
  60             av_push(my_array, val);
  61         }
  62
  63         /* Return a blessed reference to the AV */
  64         self  = newRV_noinc( (SV*)my_array );
  65         stash = gv_stashpv( class, TRUE );
  66         sv_bless( (SV*)self, stash );
  67         RETVAL = self;
  68     OUTPUT:
  69         RETVAL
  70
  71
  72 #
  73 # my $vec = Language::Befunge::Vector::XS->new_zeroes( $dims );
  74 #
  75 # Create a new vector of dimension $dims, set to the origin (all
  76 # zeroes). LBVXS->new_zeroes(2) is exactly equivalent to LBVXS->new(0, 0).
  77 #
  78 SV *
  79 new_zeroes( class, dim )
  80         char*  class;
  81         IV     dim;
  82     INIT:
  83         IV     i;
  84         SV*    self;
  85         SV*    zero;
  86         AV*    my_array;
  87         HV*    stash;
  88     CODE:
  89         /* sanity checks */
  90         if ( dim < 1 )
  91                 croak("Usage: %s->new_zeroes($dims)", class);
  92
  93         /* create the object and populate it */
  94         my_array = newAV();
  95         for ( i=0; i<dim; i++ ) {
  96             zero = newSViv(0);
  97             av_push(my_array, zero);
  98         }
  99
 100         /* return a blessed reference to the AV */
 101         self  = newRV_noinc( (SV*)my_array );
 102         stash = gv_stashpv( class, TRUE );
 103         sv_bless( (SV*)self, stash );
 104         RETVAL = self;
 105     OUTPUT:
 106         RETVAL
 107
 108
 109 #
 110 # my $vec = $v->copy;
 111 #
 112 # Return a new LBVXS object, which has the same dimensions and
 113 # coordinates as $v.
 114 #
 115 SV*
 116 copy( vec, ... )
 117         SV*  vec;
 118     INIT:
 119         IV   i;
 120         SV*  val;
 121         SV*  self;
 122         AV*  my_array;
 123         AV*  vec_array;
 124         HV*  stash;
 125     CODE:
 126         /* fetch the underlying array of the object */
 127         vec_array = (AV*)SvRV(vec);
 128
 129         /* create the object and populate it */
 130         my_array = newAV();
 131         for ( i=0; i<=av_len(vec_array); i++ ) {
 132             val = newSViv( SvIV(*av_fetch(vec_array, i, 0)) );
 133             av_push(my_array, val);
 134         }
 135
 136         /* return a blessed reference to the AV */
 137         self  = newRV_noinc( (SV*)my_array );
 138         stash = SvSTASH( (SV*)vec_array );
 139         sv_bless( (SV*)self, stash );
 140         RETVAL = self;
 141     OUTPUT:
 142         RETVAL
 143
 144
 145 #-- PUBLIC METHODS
 146
 147 #- accessors
 148
 149 #
 150 # my $dims = $vec->get_dims;
 151 #
 152 # Return the number of dimensions, an integer.
 153 #
 154 IV
 155 get_dims( self )
 156         SV*  self;
 157     PREINIT:
 158         AV*  my_array;
 159     CODE:
 160         /* fetch the underlying array of the object */
 161         my_array = (AV*)SvRV(self);
 162
 163         RETVAL = av_len(my_array) + 1;
 164     OUTPUT:
 165         RETVAL
 166
 167
 168 #
 169 # my $val = $vec->get_component($dim);
 170 #
 171 # Return the value for dimension $dim.
 172 #
 173 IV
 174 get_component( self, dim )
 175         SV*  self;
 176         IV   dim;
 177     PREINIT:
 178         AV*  my_array;
 179     CODE:
 180         /* fetch the underlying array of the object */
 181         my_array = (AV*)SvRV(self);
 182
 183         /* sanity checks */
 184         if ( dim < 0 || dim > av_len(my_array) )
 185             croak( "No such dimension!" );
 186
 187         RETVAL = SvIV( *av_fetch(my_array, dim, 0) );
 188     OUTPUT:
 189         RETVAL
 190
 191
 192 #
 193 # my @vals = $vec->get_all_components;
 194 #
 195 # Get the values for all dimensions, in order from 0..N.
 196 #
 197 void
 198 get_all_components( self )
 199         SV*  self;
 200     PREINIT:
 201         IV   dim, i, val;
 202         AV*  my_array;
 203     PPCODE:
 204         /* fetch the underlying array of the object */
 205         my_array = (AV*)SvRV(self);
 206         dim = av_len(my_array);
 207
 208         /* extend the return stack and populate it */
 209         EXTEND(SP,dim+1);
 210         for ( i=0; i<=dim; i++ ) {
 211             val = SvIV( *av_fetch(my_array, i, 0) );
 212             PUSHs( sv_2mortal( newSViv(val) ) );
 213         }
 214
 215
 216 #- mutators
 217
 218 #
 219 # $vec->clear;
 220 #
 221 # Set the vector back to the origin, all 0's.
 222 #
 223 void
 224 clear( self )
 225         SV*  self;
 226     INIT:
 227         IV   dim, i;
 228         SV*  zero;
 229         AV*  my_array;
 230     PPCODE:
 231         /* fetch the underlying array of the object */
 232         my_array = (AV*)SvRV(self);
 233         dim = av_len(my_array);
 234
 235         /* clear each slot */
 236         for ( i=0; i<=dim; i++ ) {
 237             zero = newSViv(0);
 238             av_store(my_array, i, zero);
 239         }
 240
 241
 242 #
 243 # my $val = $vec->set_component( $dim, $value );
 244 #
 245 # Set the value for dimension $dim to $value.
 246 #
 247 void
 248 set_component( self, dim, value )
 249         SV*  self;
 250         IV   dim;
 251         IV   value;
 252     INIT:
 253         AV*  my_array;
 254     CODE:
 255         /* fetch the underlying array of the object */
 256         my_array = (AV*)SvRV(self);
 257
 258         /* sanity checks */
 259         if ( dim < 0 || dim > av_len(my_array) )
 260             croak( "No such dimension!" );
 261
 262         /* storing new value */
 263         av_store(my_array, dim, newSViv(value));
 264
 265
 266 #- other methods
 267
 268 #
 269 # my $is_within = $vec->bounds_check($begin, $end);
 270 #
 271 # Check whether $vec is within the box defined by $begin and $end.
 272 # Return 1 if vector is contained within the box, and 0 otherwise.
 273 #
 274 IV
 275 bounds_check( self, v1, v2 )
 276         SV*  self;
 277         SV*  v1;
 278         SV*  v2;
 279     INIT:
 280         IV   i, mydim, dimv1, dimv2, myval, val1, val2;
 281         AV*  my_array;
 282         AV*  v1_array;
 283         AV*  v2_array;
 284     PPCODE:
 285         /* fetch the underlying array of the object */
 286         my_array = (AV*)SvRV(self);
 287         v1_array = (AV*)SvRV(v1);
 288         v2_array = (AV*)SvRV(v2);
 289         mydim = av_len(my_array);
 290         dimv1 = av_len(v1_array);
 291         dimv2 = av_len(v2_array);
 292
 293         /* sanity checks */
 294         if ( mydim != dimv1 || mydim != dimv2 )
 295             croak("uneven dimensions in bounds check!");
 296
 297         /* compare the arrays */
 298         for ( i=0 ; i<=dimv1; i++ ) {
 299             myval = SvIV( *av_fetch(my_array, i, 0) );
 300             val1  = SvIV( *av_fetch(v1_array, i, 0) );
 301             val2  = SvIV( *av_fetch(v2_array, i, 0) );
 302             if ( myval < val1 || myval > val2 ) {
 303                 XPUSHs( sv_2mortal( newSViv(0) ) );
 304                 RETURN;
 305             }
 306         }
 307         XPUSHs( sv_2mortal( newSViv(1) ) );
 308
 309
 310
 311 # -- PRIVATE METHODS
 312
 313 #- math ops
 314
 315 #
 316 # my $vec = $v1->_add($v2);
 317 # my $vec = $v1 + $v2;
 318 #
 319 # Return a new LBVXS object, which is the result of $v1 plus $v2.
 320 #
 321 SV*
 322 _add( v1, v2, variant )
 323         SV*  v1;
 324         SV*  v2;
 325         SV*  variant;
 326     INIT:
 327         IV   dimv1, dimv2, i, val1, val2;
 328         SV*  self;
 329         AV*  my_array;
 330         AV*  v1_array;
 331         AV*  v2_array;
 332         HV*  stash;
 333     CODE:
 334         /* fetch the underlying array of the object */
 335         v1_array = (AV*)SvRV(v1);
 336         v2_array = (AV*)SvRV(v2);
 337         dimv1 = av_len(v1_array);
 338         dimv2 = av_len(v2_array);
 339
 340         /* sanity checks */
 341         if ( dimv1 != dimv2 )
 342             croak("uneven dimensions in vector addition!");
 343
 344         /* create the new array and populate it */
 345         my_array = newAV();
 346         for ( i=0 ; i<=dimv1; i++ ) {
 347             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 348             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 349             av_push( my_array, newSViv(val1+val2) );
 350             }
 351
 352         /* return a blessed reference to the AV */
 353         self  = newRV_noinc( (SV*)my_array );
 354         stash = SvSTASH( (SV*)v1_array );
 355         sv_bless( (SV*)self, stash );
 356         RETVAL = self;
 357     OUTPUT:
 358         RETVAL
 359
 360
 361 #
 362 # my $vec = $v1->_substract($v2);
 363 # my $vec = $v1 - $v2;
 364 #
 365 # Return a new LBVXS object, which is the result of $v1 minus $v2.
 366 #
 367 SV*
 368 _substract( v1, v2, variant )
 369         SV*  v1;
 370         SV*  v2;
 371         SV*  variant;
 372     INIT:
 373         IV   dimv1, dimv2, i, val1, val2;
 374         SV*  self;
 375         AV*  my_array;
 376         AV*  v1_array;
 377         AV*  v2_array;
 378         HV*  stash;
 379     CODE:
 380         /* fetch the underlying array of the object */
 381         v1_array = (AV*)SvRV(v1);
 382         v2_array = (AV*)SvRV(v2);
 383         dimv1 = av_len(v1_array);
 384         dimv2 = av_len(v2_array);
 385
 386         /* sanity checks */
 387         if ( dimv1 != dimv2 )
 388             croak("uneven dimensions in vector addition!");
 389
 390         /* create the new array and populate it */
 391         my_array = newAV();
 392         for ( i=0 ; i<=dimv1; i++ ) {
 393             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 394             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 395             av_push( my_array, newSViv(val1-val2) );
 396             }
 397
 398         /* return a blessed reference to the AV */
 399         self  = newRV_noinc( (SV*)my_array );
 400         stash = SvSTASH( (SV*)v1_array );
 401         sv_bless( (SV*)self, stash );
 402         RETVAL = self;
 403     OUTPUT:
 404         RETVAL
 405
 406
 407 #
 408 # my $vec = $v1->_invert;
 409 # my $vec = -$v1;
 410 #
 411 # Subtract $v1 from the origin. Effectively, gives the inverse of the
 412 # original vector. The new vector is the same distance from the origin,
 413 # in the opposite direction.
 414 #
 415 SV*
 416 _invert( v1, v2, variant )
 417         SV*  v1;
 418         SV*  v2;
 419         SV*  variant;
 420     INIT:
 421         IV   dim, i, val;
 422         SV*  self;
 423         AV*  my_array;
 424         AV*  v1_array;
 425         HV*  stash;
 426     CODE:
 427         /* fetch the underlying array of the object */
 428         v1_array = (AV*)SvRV(v1);
 429         dim = av_len(v1_array);
 430
 431         /* create the new array and populate it */
 432         my_array = newAV();
 433         for ( i=0 ; i<=dim; i++ ) {
 434             val = SvIV( *av_fetch(v1_array, i, 0) );
 435             av_push( my_array, newSViv(-val) );
 436             }
 437
 438         /* return a blessed reference to the AV */
 439         self  = newRV_noinc( (SV*)my_array );
 440         stash = SvSTASH( (SV*)v1_array );
 441         sv_bless( (SV*)self, stash );
 442         RETVAL = self;
 443     OUTPUT:
 444         RETVAL
 445
 446
 447
 448 #- inplace math ops
 449
 450 #
 451 # $v1->_add_inplace($v2);
 452 # $v1 += $v2;
 453 #
 454 # Adds $v2 to $v1, and stores the result back into $v1.
 455 #
 456 SV*
 457 _add_inplace( v1, v2, variant )
 458         SV*  v1;
 459         SV*  v2;
 460         SV*  variant;
 461     INIT:
 462         IV   dimv1, dimv2, i, val1, val2;
 463         AV*  v1_array;
 464         AV*  v2_array;
 465     CODE:
 466         /* fetch the underlying array of the object */
 467         v1_array = (AV*)SvRV(v1);
 468         v2_array = (AV*)SvRV(v2);
 469         dimv1 = av_len(v1_array);
 470         dimv2 = av_len(v2_array);
 471
 472         /* sanity checks */
 473         if ( dimv1 != dimv2 )
 474             croak("uneven dimensions in vector addition!");
 475
 476         /* update the array slots */
 477         for ( i=0 ; i<=dimv1; i++ ) {
 478             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 479             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 480             av_store( v1_array, i, newSViv(val1+val2) );
 481             }
 482     OUTPUT:
 483         v1
 484
 485
 486 #
 487 # $v1->_substract_inplace($v2);
 488 # $v1 -= $v2;
 489 #
 490 # Substract $v2 to $v1, and stores the result back into $v1.
 491 #
 492 SV*
 493 _substract_inplace( v1, v2, variant )
 494         SV*  v1;
 495         SV*  v2;
 496         SV*  variant;
 497     INIT:
 498         IV   dimv1, dimv2, i, val1, val2;
 499         AV*  v1_array;
 500         AV*  v2_array;
 501     CODE:
 502         /* fetch the underlying array of the object */
 503         v1_array = (AV*)SvRV(v1);
 504         v2_array = (AV*)SvRV(v2);
 505         dimv1 = av_len(v1_array);
 506         dimv2 = av_len(v2_array);
 507
 508         /* sanity checks */
 509         if ( dimv1 != dimv2 )
 510             croak("uneven dimensions in vector addition!");
 511
 512         /* update the array slots */
 513         for ( i=0 ; i<=dimv1; i++ ) {
 514             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 515             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 516             av_store( v1_array, i, newSViv(val1-val2) );
 517             }
 518     OUTPUT:
 519         v1
 520
 521
 522 #- comparison
 523
 524 #
 525 # my $bool = $v1->_compare($v2);
 526 # my $bool = $v1 <=> $v2;
 527 #
 528 # Check whether the vectors both point at the same spot. Return 0 if they
 529 # do, 1 if they don't.
 530 #
 531 IV
 532 _compare( v1, v2, variant )
 533         SV*  v1;
 534         SV*  v2;
 535         SV*  variant;
 536
 537     INIT:
 538         IV   dimv1, dimv2, i, val1, val2;
 539         AV*  v1_array;
 540         AV*  v2_array;
 541     PPCODE:
 542         /* fetch the underlying array of the object */
 543         v1_array = (AV*)SvRV(v1);
 544         v2_array = (AV*)SvRV(v2);
 545         dimv1 = av_len(v1_array);
 546         dimv2 = av_len(v2_array);
 547
 548         /* sanity checks */
 549         if ( dimv1 != dimv2 )
 550             croak("uneven dimensions in bounds check!");
 551
 552         /* compare the arrays */
 553         for ( i=0 ; i<=dimv1; i++ ) {
 554             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 555             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 556             if ( val1 != val2 ) {
 557                 XPUSHs( sv_2mortal( newSViv(1) ) );
 558                 RETURN;
 559             }
 560         }
 561         XPUSHs( sv_2mortal( newSViv(0) ) );
 562
 563