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     CODE:
 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         RETVAL = 1;
 299         for ( i=0 ; i<=dimv1; i++ ) {
 300             myval = SvIV( *av_fetch(my_array, i, 0) );
 301             val1  = SvIV( *av_fetch(v1_array, i, 0) );
 302             val2  = SvIV( *av_fetch(v2_array, i, 0) );
 303             if ( myval < val1 || myval > val2 ) {
 304                 RETVAL = 0;
 305                 break;
 306             }
 307         }
 308     OUTPUT:
 309         RETVAL
 310
 311
 312
 313 # -- PRIVATE METHODS
 314
 315 #- math ops
 316
 317 #
 318 # my $vec = $v1->_add($v2);
 319 # my $vec = $v1 + $v2;
 320 #
 321 # Return a new LBVXS object, which is the result of $v1 plus $v2.
 322 #
 323 SV*
 324 _add( v1, v2, variant )
 325         SV*  v1;
 326         SV*  v2;
 327         SV*  variant;
 328     INIT:
 329         IV   dimv1, dimv2, i, val1, val2;
 330         SV*  self;
 331         AV*  my_array;
 332         AV*  v1_array;
 333         AV*  v2_array;
 334         HV*  stash;
 335     CODE:
 336         /* fetch the underlying array of the object */
 337         v1_array = (AV*)SvRV(v1);
 338         v2_array = (AV*)SvRV(v2);
 339         dimv1 = av_len(v1_array);
 340         dimv2 = av_len(v2_array);
 341
 342         /* sanity checks */
 343         if ( dimv1 != dimv2 )
 344             croak("uneven dimensions in vector addition!");
 345
 346         /* create the new array and populate it */
 347         my_array = newAV();
 348         for ( i=0 ; i<=dimv1; i++ ) {
 349             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 350             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 351             av_push( my_array, newSViv(val1+val2) );
 352             }
 353
 354         /* return a blessed reference to the AV */
 355         self  = newRV_noinc( (SV*)my_array );
 356         stash = SvSTASH( (SV*)v1_array );
 357         sv_bless( (SV*)self, stash );
 358         RETVAL = self;
 359     OUTPUT:
 360         RETVAL
 361
 362
 363 #
 364 # my $vec = $v1->_substract($v2);
 365 # my $vec = $v1 - $v2;
 366 #
 367 # Return a new LBVXS object, which is the result of $v1 minus $v2.
 368 #
 369 SV*
 370 _substract( v1, v2, variant )
 371         SV*  v1;
 372         SV*  v2;
 373         SV*  variant;
 374     INIT:
 375         IV   dimv1, dimv2, i, val1, val2;
 376         SV*  self;
 377         AV*  my_array;
 378         AV*  v1_array;
 379         AV*  v2_array;
 380         HV*  stash;
 381     CODE:
 382         /* fetch the underlying array of the object */
 383         v1_array = (AV*)SvRV(v1);
 384         v2_array = (AV*)SvRV(v2);
 385         dimv1 = av_len(v1_array);
 386         dimv2 = av_len(v2_array);
 387
 388         /* sanity checks */
 389         if ( dimv1 != dimv2 )
 390             croak("uneven dimensions in vector addition!");
 391
 392         /* create the new array and populate it */
 393         my_array = newAV();
 394         for ( i=0 ; i<=dimv1; i++ ) {
 395             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 396             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 397             av_push( my_array, newSViv(val1-val2) );
 398             }
 399
 400         /* return a blessed reference to the AV */
 401         self  = newRV_noinc( (SV*)my_array );
 402         stash = SvSTASH( (SV*)v1_array );
 403         sv_bless( (SV*)self, stash );
 404         RETVAL = self;
 405     OUTPUT:
 406         RETVAL
 407
 408
 409 #
 410 # my $vec = $v1->_invert;
 411 # my $vec = -$v1;
 412 #
 413 # Subtract $v1 from the origin. Effectively, gives the inverse of the
 414 # original vector. The new vector is the same distance from the origin,
 415 # in the opposite direction.
 416 #
 417 SV*
 418 _invert( v1, v2, variant )
 419         SV*  v1;
 420         SV*  v2;
 421         SV*  variant;
 422     INIT:
 423         IV   dim, i, val;
 424         SV*  self;
 425         AV*  my_array;
 426         AV*  v1_array;
 427         HV*  stash;
 428     CODE:
 429         /* fetch the underlying array of the object */
 430         v1_array = (AV*)SvRV(v1);
 431         dim = av_len(v1_array);
 432
 433         /* create the new array and populate it */
 434         my_array = newAV();
 435         for ( i=0 ; i<=dim; i++ ) {
 436             val = SvIV( *av_fetch(v1_array, i, 0) );
 437             av_push( my_array, newSViv(-val) );
 438             }
 439
 440         /* return a blessed reference to the AV */
 441         self  = newRV_noinc( (SV*)my_array );
 442         stash = SvSTASH( (SV*)v1_array );
 443         sv_bless( (SV*)self, stash );
 444         RETVAL = self;
 445     OUTPUT:
 446         RETVAL
 447
 448
 449
 450 #- inplace math ops
 451
 452 #
 453 # $v1->_add_inplace($v2);
 454 # $v1 += $v2;
 455 #
 456 # Adds $v2 to $v1, and stores the result back into $v1.
 457 #
 458 SV*
 459 _add_inplace( v1, v2, variant )
 460         SV*  v1;
 461         SV*  v2;
 462         SV*  variant;
 463     INIT:
 464         IV   dimv1, dimv2, i, val1, val2;
 465         AV*  v1_array;
 466         AV*  v2_array;
 467     CODE:
 468         /* fetch the underlying array of the object */
 469         v1_array = (AV*)SvRV(v1);
 470         v2_array = (AV*)SvRV(v2);
 471         dimv1 = av_len(v1_array);
 472         dimv2 = av_len(v2_array);
 473
 474         /* sanity checks */
 475         if ( dimv1 != dimv2 )
 476             croak("uneven dimensions in vector addition!");
 477
 478         /* update the array slots */
 479         for ( i=0 ; i<=dimv1; i++ ) {
 480             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 481             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 482             av_store( v1_array, i, newSViv(val1+val2) );
 483             }
 484     OUTPUT:
 485         v1
 486
 487
 488 #
 489 # $v1->_substract_inplace($v2);
 490 # $v1 -= $v2;
 491 #
 492 # Substract $v2 to $v1, and stores the result back into $v1.
 493 #
 494 SV*
 495 _substract_inplace( v1, v2, variant )
 496         SV*  v1;
 497         SV*  v2;
 498         SV*  variant;
 499     INIT:
 500         IV   dimv1, dimv2, i, val1, val2;
 501         AV*  v1_array;
 502         AV*  v2_array;
 503     CODE:
 504         /* fetch the underlying array of the object */
 505         v1_array = (AV*)SvRV(v1);
 506         v2_array = (AV*)SvRV(v2);
 507         dimv1 = av_len(v1_array);
 508         dimv2 = av_len(v2_array);
 509
 510         /* sanity checks */
 511         if ( dimv1 != dimv2 )
 512             croak("uneven dimensions in vector addition!");
 513
 514         /* update the array slots */
 515         for ( i=0 ; i<=dimv1; i++ ) {
 516             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 517             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 518             av_store( v1_array, i, newSViv(val1-val2) );
 519             }
 520     OUTPUT:
 521         v1
 522
 523
 524 #- comparison
 525
 526 #
 527 # my $bool = $v1->_compare($v2);
 528 # my $bool = $v1 <=> $v2;
 529 #
 530 # Check whether the vectors both point at the same spot. Return 0 if they
 531 # do, 1 if they don't.
 532 #
 533 IV
 534 _compare( v1, v2, variant )
 535         SV*  v1;
 536         SV*  v2;
 537         SV*  variant;
 538
 539     INIT:
 540         IV   dimv1, dimv2, i, val1, val2;
 541         AV*  v1_array;
 542         AV*  v2_array;
 543     CODE:
 544         /* fetch the underlying array of the object */
 545         v1_array = (AV*)SvRV(v1);
 546         v2_array = (AV*)SvRV(v2);
 547         dimv1 = av_len(v1_array);
 548         dimv2 = av_len(v2_array);
 549
 550         /* sanity checks */
 551         if ( dimv1 != dimv2 )
 552             croak("uneven dimensions in bounds check!");
 553
 554         /* compare the arrays */
 555         RETVAL = 0;
 556         for ( i=0 ; i<=dimv1; i++ ) {
 557             val1 = SvIV( *av_fetch(v1_array, i, 0) );
 558             val2 = SvIV( *av_fetch(v2_array, i, 0) );
 559             if ( val1 != val2 ) {
 560                 RETVAL = 1;
 561                 break;
 562             }
 563         }
 564     OUTPUT:
 565         RETVAL
 566
 567