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             AV*  self;
  48             I32  i;
  49             SV*  val;
  50             HV*  stash;
  51
  52         CODE:
  53             /* create the object and populate it */
  54             self = newAV();
  55             for ( i=0; i<ix_array; i++ ) {
  56                 val = newSViv( array[i] );
  57                 av_push(self, val);
  58             }
  59
  60             /* Return a blessed reference to the AV */
  61             RETVAL = newRV_noinc( (SV *)self );
  62             stash  = gv_stashpv( class, TRUE );
  63             sv_bless( (SV *)RETVAL, stash );
  64
  65         OUTPUT:
  66             RETVAL
  67
  68
  69 #
  70 # my $vec = Language::Befunge::Vector::XS->new_zeroes( $dims );
  71 #
  72 # Create a new vector, set to the origin. The only argument is the dimension of
  73 # the vector to be created.
  74 #
  75 # ->new_zeroes(2) is exactly equivalent to ->new([0,0])
  76 #
  77 SV *
  78 new_zeroes( class, dimension )
  79         char* class;
  80         I32   dimension;
  81
  82         INIT:
  83             AV*  self;
  84             I32  i;
  85             SV*  zero;
  86             HV*  stash;
  87
  88         CODE:
  89             /* create the object and populate it */
  90             self = newAV();
  91             for ( i=0; i<dimension; i++ ) {
  92                 zero = newSViv(0);
  93                 av_push(self, zero);
  94             }
  95
  96             /* return a blessed reference to the AV */
  97             RETVAL = newRV_noinc( (SV *)self );
  98             stash  = gv_stashpv( class, TRUE );
  99             sv_bless( (SV *)RETVAL, stash );
 100
 101         OUTPUT:
 102             RETVAL
 103
 104
 105 #-- PUBLIC METHODS
 106
 107 #- accessors
 108
 109 #
 110 # my $dims = $vec->get_dims;
 111 #
 112 # Return the number of dimensions, an integer.
 113 #
 114 I32
 115 get_dims( self )
 116         AV* self;
 117
 118     CODE:
 119         RETVAL = av_len(self) + 1;
 120
 121     OUTPUT:
 122         RETVAL
 123
 124 #
 125 # my $val = $vec->get_component( $index );
 126 #
 127 # Return the value for dimension $index.
 128 #
 129 I32
 130 get_component( self, index )
 131         AV* self;
 132         I32 index;
 133
 134     CODE:
 135         if ( index < 0 || index > av_len(self) )
 136             croak( "No such dimension!" );
 137         RETVAL = SvIV( *av_fetch(self, index, 0) );
 138
 139     OUTPUT:
 140         RETVAL
 141
 142
 143 #- mutators
 144
 145 # -- PRIVATE METHODS
 146
 147 #- inplace math ops
 148
 149 #
 150 # $v1->_substract_inplace($v2);
 151 # $v1 -= $v2;
 152 #
 153 # Substract $v2 to $v1, and stores the result back into $v1.
 154 #
 155 AV* _substract_inplace( v1, v2 )
 156         AV* v1;
 157         AV* v2;
 158
 159     INIT:
 160         I32 dimv1, dimv2;
 161         I32 i;
 162         I32 val1, val2;
 163
 164     CODE:
 165         dimv1 = av_len(v1);
 166         dimv2 = av_len(v2);
 167
 168         /* sanity checks */
 169         if ( dimv1 != dimv2 )
 170             croak("uneven dimensions in vector substraction!");
 171
 172         for ( i=0 ; i<=dimv1; i++ ) {
 173             val1 = SvIV( *av_fetch(v1, i, 0) );
 174             val2 = SvIV( *av_fetch(v2, i, 0) );
 175             av_store( v1, i, newSViv(val1-val2) );
 176             }
 177         RETVAL = v1;
 178
 179     OUTPUT:
 180         RETVAL
 181
 182
 183 #- comparison
 184
 185 #
 186 # my $bool = $v1->_compare($v2);
 187 # my $bool = $v1 <=> $v2;
 188 #
 189 # Check whether the vectors both point at the same spot. Return 0 if they
 190 # do, 1 if they don't.
 191 #
 192 I32
 193 _compare( v1, v2, variant )
 194         AV* v1;
 195         AV* v2;
 196         SV* variant;
 197
 198     INIT:
 199         I32 dimv1, dimv2;
 200         I32 i;
 201         I32 val1, val2;
 202
 203     CODE:
 204         dimv1 = av_len(v1);
 205         dimv2 = av_len(v2);
 206
 207         /* sanity checks */
 208         if ( dimv1 != dimv2 )
 209             croak("uneven dimensions in bounds check!");
 210
 211         RETVAL = 0;
 212         for ( i=0 ; i<=dimv1; i++ ) {
 213             val1 = SvIV( *av_fetch(v1, i, 0) );
 214             val2 = SvIV( *av_fetch(v2, i, 0) );
 215             if ( val1 != val2 ) {
 216                 RETVAL = 1;
 217                 break;
 218             }
 219         }
 220
 221     OUTPUT:
 222         RETVAL
 223
 224