← Back to branch summary

~ubuntu-branches/ubuntu/hardy/sigscheme/hardy-proposed

« back to all changes in this revision

Viewing changes to operations-srfi60.c

  • Committer: Bazaar Package Importer
  • Author(s): NIIBE Yutaka
  • Date: 2006-05-23 21:46:41 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20060523214641-6ix4gz34wpiehub8
Tags: 0.5.0-2
http://bugs.debian.org/368571
* debian/control (Build-Depends): Added ruby.
  Thanks to Frederik Schueler.  Closes: #368571
* debian/rules (clean): invoke 'distclean' instead of 'clean'.

Show diffs side-by-side

added added

removed removed

Lines of Context:
operations-srfi60.c
1
 
/*===========================================================================
2
 
 *  FileName : operations-srfi60.c
3
 
 *  About    : SRFI-60 integers as bits
4
 
 *
5
 
 *  Copyright (C) 2005      by YamaKen
6
 
 *
7
 
 *  All rights reserved.
8
 
 *
9
 
 *  Redistribution and use in source and binary forms, with or without
10
 
 *  modification, are permitted provided that the following conditions
11
 
 *  are met:
12
 
 *
13
 
 *  1. Redistributions of source code must retain the above copyright
14
 
 *     notice, this list of conditions and the following disclaimer.
15
 
 *  2. Redistributions in binary form must reproduce the above copyright
16
 
 *     notice, this list of conditions and the following disclaimer in the
17
 
 *     documentation and/or other materials provided with the distribution.
18
 
 *  3. Neither the name of authors nor the names of its contributors
19
 
 *     may be used to endorse or promote products derived from this software
20
 
 *     without specific prior written permission.
21
 
 *
22
 
 *  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
23
 
 *  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
24
 
 *  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
25
 
 *  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
26
 
 *  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
27
 
 *  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
28
 
 *  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
29
 
 *  OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
30
 
 *  WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
31
 
 *  OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
32
 
 *  ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
33
 
 *  =========================================================================*/
34
 
/*=======================================
35
 
  System Include
36
 
=======================================*/
37
 
 
38
 
/*=======================================
39
 
  Local Include
40
 
=======================================*/
41
 
#include "sigscheme.h"
42
 
#include "sigschemeinternal.h"
43
 
 
44
 
/*=======================================
45
 
  File Local Struct Declarations
46
 
=======================================*/
47
 
 
48
 
/*=======================================
49
 
  File Local Macro Declarations
50
 
=======================================*/
51
 
#define BITWISE_OPERATION_BODY(op, opstr)                                    \
52
 
    do {                                                                     \
53
 
        int result = 0;                                                      \
54
 
        switch (*state) {                                                    \
55
 
        case SCM_REDUCE_0:                                                   \
56
 
            break;                                                           \
57
 
        case SCM_REDUCE_1:                                                   \
58
 
            ASSERT_INTP(left);                                               \
59
 
            return right;                                                    \
60
 
        case SCM_REDUCE_PARTWAY:                                             \
61
 
        case SCM_REDUCE_LAST:                                                \
62
 
            /* left is already ensured as int by previous loop */            \
63
 
            ASSERT_INTP(right);                                              \
64
 
            result = (SCM_INT_VALUE(left) op SCM_INT_VALUE(right));          \
65
 
            break;                                                           \
66
 
        default:                                                             \
67
 
            SigScm_Error(opstr " : (internal error) unrecognized state specifier: %d", *state); \
68
 
        }                                                                    \
69
 
        return Scm_NewInt(result);                                           \
70
 
    } while (/* CONSTCOND */ 0)
71
 
 
72
 
/*=======================================
73
 
  Variable Declarations
74
 
=======================================*/
75
 
 
76
 
/*=======================================
77
 
  File Local Function Declarations
78
 
=======================================*/
79
 
 
80
 
/*=======================================
81
 
  Function Implementations
82
 
=======================================*/
83
 
void SigScm_Initialize_SRFI60(void)
84
 
{
85
 
    /*=======================================================================
86
 
      SRFI-60 Procedures
87
 
    =======================================================================*/
88
 
    Scm_RegisterReductionOperator("logand"   , ScmOp_SRFI60_logand);
89
 
    Scm_RegisterReductionOperator("logior"   , ScmOp_SRFI60_logior);
90
 
    Scm_RegisterReductionOperator("logxor"   , ScmOp_SRFI60_logxor);
91
 
    Scm_RegisterProcedureFixed1("lognot"     , ScmOp_SRFI60_lognot);
92
 
    Scm_RegisterProcedureFixed3("bitwise-if" , ScmOp_SRFI60_bitwise_if);
93
 
    Scm_RegisterProcedureFixed2("logtest"    , ScmOp_SRFI60_logtest);
94
 
    Scm_DefineAlias("bitwise-and"            , "logand");
95
 
    Scm_DefineAlias("bitwise-ior"            , "logior");
96
 
    Scm_DefineAlias("bitwise-xor"            , "logxor");
97
 
    Scm_DefineAlias("bitwise-not"            , "lognot");
98
 
    Scm_DefineAlias("bitwise-merge"          , "bitwise-if");
99
 
    Scm_DefineAlias("any-bits-set?"          , "logtest");
100
 
}
101
 
 
102
 
/*=============================================================================
103
 
  SRFI-60 : Integers as Bits
104
 
=============================================================================*/
105
 
 
106
 
/* Bitwise Operations */
107
 
ScmObj ScmOp_SRFI60_logand(ScmObj left, ScmObj right,
108
 
                           enum ScmReductionState *state)
109
 
{
110
 
    DECLARE_FUNCTION("logand", ReductionOperator);
111
 
    BITWISE_OPERATION_BODY(&, "logand");
112
 
}
113
 
 
114
 
ScmObj ScmOp_SRFI60_logior(ScmObj left, ScmObj right,
115
 
                           enum ScmReductionState *state)
116
 
{
117
 
    DECLARE_FUNCTION("logior", ReductionOperator);
118
 
    BITWISE_OPERATION_BODY(|, "logior");
119
 
}
120
 
 
121
 
ScmObj ScmOp_SRFI60_logxor(ScmObj left, ScmObj right,
122
 
                           enum ScmReductionState *state)
123
 
{
124
 
    DECLARE_FUNCTION("logxor", ReductionOperator);
125
 
    BITWISE_OPERATION_BODY(^, "logxor");
126
 
}
127
 
 
128
 
ScmObj ScmOp_SRFI60_lognot(ScmObj n)
129
 
{
130
 
    DECLARE_FUNCTION("lognot", ProcedureFixed1);
131
 
 
132
 
    ASSERT_INTP(n);
133
 
 
134
 
    return Scm_NewInt(~SCM_INT_VALUE(n));
135
 
}
136
 
 
137
 
ScmObj ScmOp_SRFI60_bitwise_if(ScmObj mask, ScmObj n0, ScmObj n1)
138
 
{
139
 
    int result, c_mask;
140
 
    DECLARE_FUNCTION("bitwise-if", ProcedureFixed3);
141
 
 
142
 
    ASSERT_INTP(mask);
143
 
    ASSERT_INTP(n0);
144
 
    ASSERT_INTP(n1);
145
 
 
146
 
    c_mask = SCM_INT_VALUE(mask);
147
 
    result = (c_mask & SCM_INT_VALUE(n0)) | (~c_mask & SCM_INT_VALUE(n1));
148
 
 
149
 
    return Scm_NewInt(result);
150
 
}
151
 
 
152
 
ScmObj ScmOp_SRFI60_logtest(ScmObj j, ScmObj k)
153
 
{
154
 
    DECLARE_FUNCTION("logtest", ProcedureFixed2);
155
 
 
156
 
    ASSERT_INTP(j);
157
 
    ASSERT_INTP(k);
158
 
 
159
 
    return (SCM_INT_VALUE(j) & SCM_INT_VALUE(k)) ? SCM_TRUE : SCM_FALSE;
160
 
}