This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add PERL_NO_GET_CONTEXT to XS::Typemap
[perl5.git] / ext / XS-Typemap / Typemap.xs
1 /*
2    XS code to test the typemap entries
3
4    Copyright (C) 2001 Tim Jenness.
5    All Rights Reserved
6
7 */
8
9 #define PERL_NO_GET_CONTEXT
10
11 #include "EXTERN.h"   /* std perl include */
12 #include "perl.h"     /* std perl include */
13 #include "XSUB.h"     /* XSUB include */
14
15 /* Prototypes for external functions */
16 FILE * xsfopen( const char * );
17 int xsfclose( FILE * );
18 int xsfprintf( FILE *, const char *);
19
20 /* Type definitions required for the XS typemaps */
21 typedef SV * SVREF; /* T_SVREF */
22 typedef int SysRet; /* T_SYSRET */
23 typedef int Int;    /* T_INT */
24 typedef int intRef; /* T_PTRREF */
25 typedef int intObj; /* T_PTROBJ */
26 typedef int intRefIv; /* T_REF_IV_PTR */
27 typedef int intArray; /* T_ARRAY */
28 typedef short shortOPQ;   /* T_OPAQUE */
29 typedef int intOpq;   /* T_OPAQUEPTR */
30
31 /* A structure to test T_OPAQUEPTR */
32 struct t_opaqueptr {
33   int a;
34   int b;
35   double c;
36 };
37
38 typedef struct t_opaqueptr astruct;
39
40 /* Some static memory for the tests */
41 static I32 xst_anint;
42 static intRef xst_anintref;
43 static intObj xst_anintobj;
44 static intRefIv xst_anintrefiv;
45 static intOpq xst_anintopq;
46
47 /* Helper functions */
48
49 /* T_ARRAY - allocate some memory */
50 intArray * intArrayPtr( int nelem ) {
51     intArray * array;
52     Newx(array, nelem, intArray);
53     return array;
54 }
55
56
57 MODULE = XS::Typemap   PACKAGE = XS::Typemap
58
59 PROTOTYPES: DISABLE
60
61 =head1 TYPEMAPS
62
63 Each C type is represented by an entry in the typemap file that
64 is responsible for converting perl variables (SV, AV, HV and CV) to
65 and from that type.
66
67 =over 4
68
69 =item T_SV
70
71 This simply passes the C representation of the Perl variable (an SV*)
72 in and out of the XS layer. This can be used if the C code wants
73 to deal directly with the Perl variable.
74
75 =cut
76
77 SV *
78 T_SV( sv )
79   SV * sv
80  CODE:
81   /* create a new sv for return that is a copy of the input
82      do not simply copy the pointer since the SV will be marked
83      mortal by the INPUT typemap when it is pushed back onto the stack */
84   RETVAL = sv_mortalcopy( sv );
85   /* increment the refcount since the default INPUT typemap mortalizes
86      by default and we don't want to decrement the ref count twice
87      by mistake */
88   SvREFCNT_inc(RETVAL);
89  OUTPUT:
90   RETVAL
91
92 =item T_SVREF
93
94 Used to pass in and return a reference to an SV.
95
96 =cut
97
98 SVREF
99 T_SVREF( svref )
100   SVREF svref
101  CODE:
102   RETVAL = svref;
103  OUTPUT:
104   RETVAL
105
106 =item T_AVREF
107
108 From the perl level this is a reference to a perl array.
109 From the C level this is a pointer to an AV.
110
111 =cut
112
113 AV *
114 T_AVREF( av )
115   AV * av
116  CODE:
117   RETVAL = av;
118  OUTPUT:
119   RETVAL
120
121 =item T_HVREF
122
123 From the perl level this is a reference to a perl hash.
124 From the C level this is a pointer to an HV.
125
126 =cut
127
128 HV *
129 T_HVREF( hv )
130   HV * hv
131  CODE:
132   RETVAL = hv;
133  OUTPUT:
134   RETVAL
135
136 =item T_CVREF
137
138 From the perl level this is a reference to a perl subroutine
139 (e.g. $sub = sub { 1 };). From the C level this is a pointer
140 to a CV.
141
142 =cut
143
144 CV *
145 T_CVREF( cv )
146   CV * cv
147  CODE:
148   RETVAL = cv;
149  OUTPUT:
150   RETVAL
151
152
153 =item T_SYSRET
154
155 The T_SYSRET typemap is used to process return values from system calls.
156 It is only meaningful when passing values from C to perl (there is
157 no concept of passing a system return value from Perl to C).
158
159 System calls return -1 on error (setting ERRNO with the reason)
160 and (usually) 0 on success. If the return value is -1 this typemap
161 returns C<undef>. If the return value is not -1, this typemap
162 translates a 0 (perl false) to "0 but true" (which
163 is perl true) or returns the value itself, to indicate that the
164 command succeeded.
165
166 The L<POSIX|POSIX> module makes extensive use of this type.
167
168 =cut
169
170 # Test a successful return
171
172 SysRet
173 T_SYSRET_pass()
174  CODE:
175   RETVAL = 0;
176  OUTPUT:
177   RETVAL
178
179 # Test failure
180
181 SysRet
182 T_SYSRET_fail()
183  CODE:
184   RETVAL = -1;
185  OUTPUT:
186   RETVAL
187
188 =item T_UV
189
190 An unsigned integer.
191
192 =cut
193
194 unsigned int
195 T_UV( uv )
196   unsigned int uv
197  CODE:
198   RETVAL = uv;
199  OUTPUT:
200   RETVAL
201
202 =item T_IV
203
204 A signed integer. This is cast to the required  integer type when
205 passed to C and converted to an IV when passed back to Perl.
206
207 =cut
208
209 long
210 T_IV( iv )
211   long iv
212  CODE:
213   RETVAL = iv;
214  OUTPUT:
215   RETVAL
216
217 =item T_INT
218
219 A signed integer. This typemap converts the Perl value to a native
220 integer type (the C<int> type on the current platform). When returning
221 the value to perl it is processed in the same way as for T_IV.
222
223 Its behaviour is identical to using an C<int> type in XS with T_IV.
224
225 =item T_ENUM
226
227 An enum value. Used to transfer an enum component
228 from C. There is no reason to pass an enum value to C since
229 it is stored as an IV inside perl.
230
231 =cut
232
233 # The test should return the value for SVt_PVHV.
234 # 11 at the present time but we can't not rely on this
235 # for testing purposes.
236
237 svtype
238 T_ENUM()
239  CODE:
240   RETVAL = SVt_PVHV;
241  OUTPUT:
242   RETVAL
243
244 =item T_BOOL
245
246 A boolean type. This can be used to pass true and false values to and
247 from C.
248
249 =cut
250
251 bool
252 T_BOOL( in )
253   bool in
254  CODE:
255   RETVAL = in;
256  OUTPUT:
257   RETVAL
258
259 =item T_U_INT
260
261 This is for unsigned integers. It is equivalent to using T_UV
262 but explicitly casts the variable to type C<unsigned int>.
263 The default type for C<unsigned int> is T_UV.
264
265 =item T_SHORT
266
267 Short integers. This is equivalent to T_IV but explicitly casts
268 the return to type C<short>. The default typemap for C<short>
269 is T_IV.
270
271 =item T_U_SHORT
272
273 Unsigned short integers. This is equivalent to T_UV but explicitly
274 casts the return to type C<unsigned short>. The default typemap for
275 C<unsigned short> is T_UV.
276
277 T_U_SHORT is used for type C<U16> in the standard typemap.
278
279 =cut
280
281 U16
282 T_U_SHORT( in )
283   U16 in
284  CODE:
285   RETVAL = in;
286  OUTPUT:
287   RETVAL
288
289
290 =item T_LONG
291
292 Long integers. This is equivalent to T_IV but explicitly casts
293 the return to type C<long>. The default typemap for C<long>
294 is T_IV.
295
296 =item T_U_LONG
297
298 Unsigned long integers. This is equivalent to T_UV but explicitly
299 casts the return to type C<unsigned long>. The default typemap for
300 C<unsigned long> is T_UV.
301
302 T_U_LONG is used for type C<U32> in the standard typemap.
303
304 =cut
305
306 U32
307 T_U_LONG( in )
308   U32 in
309  CODE:
310   RETVAL = in;
311  OUTPUT:
312   RETVAL
313
314 =item T_CHAR
315
316 Single 8-bit characters.
317
318 =cut
319
320 char
321 T_CHAR( in );
322   char in
323  CODE:
324   RETVAL = in;
325  OUTPUT:
326   RETVAL
327
328
329 =item T_U_CHAR
330
331 An unsigned byte.
332
333 =cut
334
335 unsigned char
336 T_U_CHAR( in );
337   unsigned char in
338  CODE:
339   RETVAL = in;
340  OUTPUT:
341   RETVAL
342
343
344 =item T_FLOAT
345
346 A floating point number. This typemap guarantees to return a variable
347 cast to a C<float>.
348
349 =cut
350
351 float
352 T_FLOAT( in )
353   float in
354  CODE:
355   RETVAL = in;
356  OUTPUT:
357   RETVAL
358
359 =item T_NV
360
361 A Perl floating point number. Similar to T_IV and T_UV in that the
362 return type is cast to the requested numeric type rather than
363 to a specific type.
364
365 =cut
366
367 NV
368 T_NV( in )
369   NV in
370  CODE:
371   RETVAL = in;
372  OUTPUT:
373   RETVAL
374
375 =item T_DOUBLE
376
377 A double precision floating point number. This typemap guarantees to
378 return a variable cast to a C<double>.
379
380 =cut
381
382 double
383 T_DOUBLE( in )
384   double in
385  CODE:
386   RETVAL = in;
387  OUTPUT:
388   RETVAL
389
390 =item T_PV
391
392 A string (char *).
393
394 =cut
395
396 char *
397 T_PV( in )
398   char * in
399  CODE:
400   RETVAL = in;
401  OUTPUT:
402   RETVAL
403
404 =item T_PTR
405
406 A memory address (pointer). Typically associated with a C<void *>
407 type.
408
409 =cut
410
411 # Pass in a value. Store the value in some static memory and
412 # then return the pointer
413
414 void *
415 T_PTR_OUT( in )
416   int in;
417  CODE:
418   xst_anint = in;
419   RETVAL = &xst_anint;
420  OUTPUT:
421   RETVAL
422
423 # pass in the pointer and return the value
424
425 int
426 T_PTR_IN( ptr )
427   void * ptr
428  CODE:
429   RETVAL = *(int *)ptr;
430  OUTPUT:
431   RETVAL
432
433 =item T_PTRREF
434
435 Similar to T_PTR except that the pointer is stored in a scalar and the
436 reference to that scalar is returned to the caller. This can be used
437 to hide the actual pointer value from the programmer since it is usually
438 not required directly from within perl.
439
440 The typemap checks that a scalar reference is passed from perl to XS.
441
442 =cut
443
444 # Similar test to T_PTR
445 # Pass in a value. Store the value in some static memory and
446 # then return the pointer
447
448 intRef *
449 T_PTRREF_OUT( in )
450   intRef in;
451  CODE:
452   xst_anintref = in;
453   RETVAL = &xst_anintref;
454  OUTPUT:
455   RETVAL
456
457 # pass in the pointer and return the value
458
459 intRef
460 T_PTRREF_IN( ptr )
461   intRef * ptr
462  CODE:
463   RETVAL = *ptr;
464  OUTPUT:
465   RETVAL
466
467
468
469 =item T_PTROBJ
470
471 Similar to T_PTRREF except that the reference is blessed into a class.
472 This allows the pointer to be used as an object. Most commonly used to
473 deal with C structs. The typemap checks that the perl object passed
474 into the XS routine is of the correct class (or part of a subclass).
475
476 The pointer is blessed into a class that is derived from the name
477 of type of the pointer but with all '*' in the name replaced with
478 'Ptr'.
479
480 =cut
481
482 # Similar test to T_PTRREF
483 # Pass in a value. Store the value in some static memory and
484 # then return the pointer
485
486 intObj *
487 T_PTROBJ_OUT( in )
488   intObj in;
489  CODE:
490   xst_anintobj = in;
491   RETVAL = &xst_anintobj;
492  OUTPUT:
493   RETVAL
494
495 # pass in the pointer and return the value
496
497 MODULE = XS::Typemap  PACKAGE = intObjPtr
498
499 intObj
500 T_PTROBJ_IN( ptr )
501   intObj * ptr
502  CODE:
503   RETVAL = *ptr;
504  OUTPUT:
505   RETVAL
506
507 MODULE = XS::Typemap PACKAGE = XS::Typemap
508
509 =item T_REF_IV_REF
510
511 NOT YET
512
513 =item T_REF_IV_PTR
514
515 Similar to T_PTROBJ in that the pointer is blessed into a scalar object.
516 The difference is that when the object is passed back into XS it must be
517 of the correct type (inheritance is not supported).
518
519 The pointer is blessed into a class that is derived from the name
520 of type of the pointer but with all '*' in the name replaced with
521 'Ptr'.
522
523 =cut
524
525 # Similar test to T_PTROBJ
526 # Pass in a value. Store the value in some static memory and
527 # then return the pointer
528
529 intRefIv *
530 T_REF_IV_PTR_OUT( in )
531   intRefIv in;
532  CODE:
533   xst_anintrefiv = in;
534   RETVAL = &xst_anintrefiv;
535  OUTPUT:
536   RETVAL
537
538 # pass in the pointer and return the value
539
540 MODULE = XS::Typemap  PACKAGE = intRefIvPtr
541
542 intRefIv
543 T_REF_IV_PTR_IN( ptr )
544   intRefIv * ptr
545  CODE:
546   RETVAL = *ptr;
547  OUTPUT:
548   RETVAL
549
550
551 MODULE = XS::Typemap PACKAGE = XS::Typemap
552
553 =item T_PTRDESC
554
555 NOT YET
556
557 =item T_REFREF
558
559 NOT YET
560
561 =item T_REFOBJ
562
563 NOT YET
564
565 =item T_OPAQUEPTR
566
567 This can be used to store bytes in the string component of the
568 SV. Here the representation of the data is irrelevant to perl and the
569 bytes themselves are just stored in the SV. It is assumed that the C
570 variable is a pointer (the bytes are copied from that memory
571 location).  If the pointer is pointing to something that is
572 represented by 8 bytes then those 8 bytes are stored in the SV (and
573 length() will report a value of 8). This entry is similar to T_OPAQUE.
574
575 In principal the unpack() command can be used to convert the bytes
576 back to a number (if the underlying type is known to be a number).
577
578 This entry can be used to store a C structure (the number
579 of bytes to be copied is calculated using the C C<sizeof> function)
580 and can be used as an alternative to T_PTRREF without having to worry
581 about a memory leak (since Perl will clean up the SV).
582
583 =cut
584
585 intOpq *
586 T_OPAQUEPTR_IN( val )
587   intOpq val
588  CODE:
589   xst_anintopq = val;
590   RETVAL = &xst_anintopq;
591  OUTPUT:
592   RETVAL
593
594 intOpq
595 T_OPAQUEPTR_OUT( ptr )
596   intOpq * ptr
597  CODE:
598   RETVAL = *ptr;
599  OUTPUT:
600   RETVAL
601
602 short
603 T_OPAQUEPTR_OUT_short( ptr )
604   shortOPQ * ptr
605  CODE:
606   RETVAL = *ptr;
607  OUTPUT:
608   RETVAL
609
610 # Test it with a structure
611 astruct *
612 T_OPAQUEPTR_IN_struct( a,b,c )
613   int a
614   int b
615   double c
616  PREINIT:
617   struct t_opaqueptr test;
618  CODE:
619   test.a = a;
620   test.b = b;
621   test.c = c;
622   RETVAL = &test;
623  OUTPUT:
624   RETVAL
625
626 void
627 T_OPAQUEPTR_OUT_struct( test )
628   astruct * test
629  PPCODE:
630   XPUSHs(sv_2mortal(newSViv(test->a)));
631   XPUSHs(sv_2mortal(newSViv(test->b)));
632   XPUSHs(sv_2mortal(newSVnv(test->c)));
633
634
635 =item T_OPAQUE
636
637 This can be used to store data from non-pointer types in the string
638 part of an SV. It is similar to T_OPAQUEPTR except that the
639 typemap retrieves the pointer directly rather than assuming it
640 is being supplied. For example if an integer is imported into
641 Perl using T_OPAQUE rather than T_IV the underlying bytes representing
642 the integer will be stored in the SV but the actual integer value will not
643 be available. i.e. The data is opaque to perl.
644
645 The data may be retrieved using the C<unpack> function if the
646 underlying type of the byte stream is known.
647
648 T_OPAQUE supports input and output of simple types.
649 T_OPAQUEPTR can be used to pass these bytes back into C if a pointer
650 is acceptable.
651
652 =cut
653
654 shortOPQ
655 T_OPAQUE_IN( val )
656   int val
657  CODE:
658   RETVAL = (shortOPQ)val;
659  OUTPUT:
660   RETVAL
661
662 IV
663 T_OPAQUE_OUT( val )
664   shortOPQ val
665  CODE:
666   RETVAL = (IV)val;
667  OUTPUT:
668   RETVAL
669
670 =item Implicit array
671
672 xsubpp supports a special syntax for returning
673 packed C arrays to perl. If the XS return type is given as
674
675   array(type, nelem)
676
677 xsubpp will copy the contents of C<nelem * sizeof(type)> bytes from
678 RETVAL to an SV and push it onto the stack. This is only really useful
679 if the number of items to be returned is known at compile time and you
680 don't mind having a string of bytes in your SV.  Use T_ARRAY to push a
681 variable number of arguments onto the return stack (they won't be
682 packed as a single string though).
683
684 This is similar to using T_OPAQUEPTR but can be used to process more than
685 one element.
686
687 =cut
688
689 array(int,3)
690 T_OPAQUE_array( a,b,c)
691   int a
692   int b
693   int c
694  PREINIT:
695   int array[3];
696  CODE:
697   array[0] = a;
698   array[1] = b;
699   array[2] = c;
700   RETVAL = array;
701  OUTPUT:
702   RETVAL
703
704
705 =item T_PACKED
706
707 NOT YET
708
709 =item T_PACKEDARRAY
710
711 NOT YET
712
713 =item T_DATAUNIT
714
715 NOT YET
716
717 =item T_CALLBACK
718
719 NOT YET
720
721 =item T_ARRAY
722
723 This is used to convert the perl argument list to a C array
724 and for pushing the contents of a C array onto the perl
725 argument stack.
726
727 The usual calling signature is
728
729   @out = array_func( @in );
730
731 Any number of arguments can occur in the list before the array but
732 the input and output arrays must be the last elements in the list.
733
734 When used to pass a perl list to C the XS writer must provide a
735 function (named after the array type but with 'Ptr' substituted for
736 '*') to allocate the memory required to hold the list. A pointer
737 should be returned. It is up to the XS writer to free the memory on
738 exit from the function. The variable C<ix_$var> is set to the number
739 of elements in the new array.
740
741 When returning a C array to Perl the XS writer must provide an integer
742 variable called C<size_$var> containing the number of elements in the
743 array. This is used to determine how many elements should be pushed
744 onto the return argument stack. This is not required on input since
745 Perl knows how many arguments are on the stack when the routine is
746 called. Ordinarily this variable would be called C<size_RETVAL>.
747
748 Additionally, the type of each element is determined from the type of
749 the array. If the array uses type C<intArray *> xsubpp will
750 automatically work out that it contains variables of type C<int> and
751 use that typemap entry to perform the copy of each element. All
752 pointer '*' and 'Array' tags are removed from the name to determine
753 the subtype.
754
755 =cut
756
757 # Test passes in an integer array and returns it along with
758 # the number of elements
759 # Pass in a dummy value to test offsetting
760
761 # Problem is that xsubpp does XSRETURN(1) because we arent
762 # using PPCODE. This means that only the first element
763 # is returned. KLUGE this by using CLEANUP to return before the
764 # end.
765
766 intArray *
767 T_ARRAY( dummy, array, ... )
768   int dummy = 0;
769   intArray * array
770  PREINIT:
771   U32 size_RETVAL;
772  CODE:
773   dummy += 0; /* Fix -Wall */
774   size_RETVAL = ix_array;
775   RETVAL = array;
776  OUTPUT:
777   RETVAL
778  CLEANUP:
779   Safefree(array);
780   XSRETURN(size_RETVAL);
781
782
783 =item T_STDIO
784
785 This is used for passing perl filehandles to and from C using
786 C<FILE *> structures.
787
788 =cut
789
790 FILE *
791 T_STDIO_open( file )
792   const char * file
793  CODE:
794   RETVAL = xsfopen( file );
795  OUTPUT:
796   RETVAL
797
798 SysRet
799 T_STDIO_close( f )
800   PerlIO * f
801  PREINIT:
802   FILE * stream;
803  CODE:
804   /* Get the FILE* */
805   stream = PerlIO_findFILE( f );  
806   /* Release the FILE* from the PerlIO system so that we do
807      not close the file twice */
808   PerlIO_releaseFILE(f,stream);
809   /* Must release the file before closing it */
810   RETVAL = xsfclose( stream );
811  OUTPUT:
812   RETVAL
813
814 int
815 T_STDIO_print( stream, string )
816   FILE * stream
817   const char * string
818  CODE:
819   RETVAL = xsfprintf( stream, string );
820  OUTPUT:
821   RETVAL
822
823
824 =item T_IN
825
826 NOT YET
827
828 =item T_INOUT
829
830 This is used for passing perl filehandles to and from C using
831 C<PerlIO *> structures. The file handle can used for reading and
832 writing.
833
834 See L<perliol> for more information on the Perl IO abstraction
835 layer. Perl must have been built with C<-Duseperlio>.
836
837 =item T_OUT
838
839 NOT YET
840
841 =back
842
843 =cut
844