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