File: Internals.xs

package info (click to toggle)
libinternals-perl 1.1-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, jessie, jessie-kfreebsd, sid, stretch
  • size: 96 kB
  • ctags: 1
  • sloc: perl: 12; makefile: 2
file content (118 lines) | stat: -rw-r--r-- 2,510 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118


/*****************************************************************************/
/*                                                                           */
/*    Copyright (c) 2001 by Steffen Beyer.                                   */
/*    All rights reserved.                                                   */
/*                                                                           */
/*    This package is free software; you can redistribute it                 */
/*    and/or modify it under the same terms as Perl itself.                  */
/*                                                                           */
/*****************************************************************************/


#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"


#define INTERNALS_REFERENCE(ref,obj) ( ref && SvROK(ref) && (obj = SvRV(ref)) )

#define INTERNALS_NUMBER(ref,val)    ( ref && !(SvROK(ref)) && ((val = (U32)SvIV(ref)) | 1) )

#define INTERNALS_ERROR(name,error)  croak("Internals::" name "(): " error)

#define INTERNALS_NO_REFERENCE(name) INTERNALS_ERROR(name,"argument is not a reference")

#define INTERNALS_NO_NUMBER(name)    INTERNALS_ERROR(name,"argument is not a number")


MODULE = Internals		PACKAGE = Internals


PROTOTYPES: DISABLE


void
IsWriteProtected(ref)
SV *	ref
PPCODE:
{
    SV *obj;

    if ( INTERNALS_REFERENCE(ref,obj) )
    {
        PUSHs(sv_2mortal(newSViv((IV)( SvREADONLY(obj) ? 1 : 0 ))));
    }
    else INTERNALS_NO_REFERENCE("IsWriteProtected");
}


void
SetReadOnly(ref)
SV *	ref
PPCODE:
{
    SV *obj;

    if ( INTERNALS_REFERENCE(ref,obj) )
    {
        SvREADONLY_on(obj);
        PUSHs(sv_mortalcopy(ref));
    }
    else INTERNALS_NO_REFERENCE("SetReadOnly");
}


void
SetReadWrite(ref)
SV *	ref
PPCODE:
{
    SV *obj;

    if ( INTERNALS_REFERENCE(ref,obj) )
    {
        SvREADONLY_off(obj);
        PUSHs(sv_mortalcopy(ref));
    }
    else INTERNALS_NO_REFERENCE("SetReadWrite");
}


void
GetRefCount(ref)
SV *	ref
PPCODE:
{
    SV *obj;

    if ( INTERNALS_REFERENCE(ref,obj) )
    {
        PUSHs(sv_2mortal(newSViv((IV)( obj->sv_refcnt ))));
    }
    else INTERNALS_NO_REFERENCE("GetRefCount");
}


void
SetRefCount(ref,val)
SV *	ref
SV *	val
PPCODE:
{
    SV *obj;
    U32 cnt;

    if ( INTERNALS_REFERENCE(ref,obj) )
    {
        if ( INTERNALS_NUMBER(val,cnt) )
        {
            obj->sv_refcnt = cnt;
        }
        else INTERNALS_NO_NUMBER("SetRefCount");
    }
    else INTERNALS_NO_REFERENCE("SetRefCount");
}