/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- read_uvector
- Scm_Init_libgauche_uvector
1 /*
2 * uvinit.c - initialize routine for uvector extension
3 *
4 * Copyright (c) 2000-2003 Shiro Kawai, All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * 3. Neither the name of the authors nor the names of its contributors
18 * may be used to endorse or promote products derived from this
19 * software without specific prior written permission.
20 *
21 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 *
33 * $Id: uvinit.c,v 1.10 2005/08/25 06:21:58 shirok Exp $
34 */
35
36 #include <gauche.h>
37 #include <gauche/extend.h>
38 #include "gauche/uvector.h"
39 #include "uvectorP.h"
40
41 /*
42 * Reader extension
43 */
44 static ScmObj read_uvector(ScmPort *port, const char *tag,
45 ScmReadContext *ctx)
46 {
47 ScmChar c;
48 ScmObj list, uv = SCM_UNDEFINED;
49
50 SCM_GETC(c, port);
51 if (c != '(') Scm_Error("bad uniform vector syntax for %s", tag);
52 list = Scm_ReadList(SCM_OBJ(port), ')');
53 if (strcmp(tag, "s8") == 0) uv = Scm_ListToS8Vector(list, 0);
54 else if (strcmp(tag, "u8") == 0) uv = Scm_ListToU8Vector(list, 0);
55 else if (strcmp(tag, "s16") == 0) uv = Scm_ListToS16Vector(list, 0);
56 else if (strcmp(tag, "u16") == 0) uv = Scm_ListToU16Vector(list, 0);
57 else if (strcmp(tag, "s32") == 0) uv = Scm_ListToS32Vector(list, 0);
58 else if (strcmp(tag, "u32") == 0) uv = Scm_ListToU32Vector(list, 0);
59 else if (strcmp(tag, "s64") == 0) uv = Scm_ListToS64Vector(list, 0);
60 else if (strcmp(tag, "u64") == 0) uv = Scm_ListToU64Vector(list, 0);
61 else if (strcmp(tag, "f32") == 0) uv = Scm_ListToF32Vector(list, 0);
62 else if (strcmp(tag, "f64") == 0) uv = Scm_ListToF64Vector(list, 0);
63 else Scm_Error("invalid unform vector tag: %s", tag);
64 /* If we are reading source file, let literal uvectors be immutable. */
65 if (ctx->flags & SCM_READ_LITERAL_IMMUTABLE) {
66 SCM_UVECTOR_IMMUTABLE_P(uv) = TRUE;
67 }
68 return uv;
69 }
70
71 /*
72 * Initialization
73 */
74 extern void Scm_Init_uvlib(ScmModule *);
75 extern void Scm_Init_uvseq(void);
76 SCM_EXTERN ScmObj (*Scm_ReadUvectorHook)(ScmPort *port, const char *tag,
77 ScmReadContext *ctx);
78
79 void Scm_Init_libgauche_uvector(void)
80 {
81 ScmModule *m;
82 ScmObj t;
83
84 SCM_INIT_EXTENSION(uvector);
85 m = SCM_FIND_MODULE("gauche.uvector", SCM_FIND_MODULE_CREATE);
86 Scm_InitStaticClassWithMeta(&Scm_UVectorClass, "<uvector>", m, NULL, SCM_NIL, NULL, 0);
87 Scm_InitStaticClassWithMeta(&Scm_S8VectorClass, "<s8vector>", m, NULL, SCM_NIL, NULL, 0);
88 Scm_InitStaticClassWithMeta(&Scm_U8VectorClass, "<u8vector>", m, NULL, SCM_NIL, NULL, 0);
89 Scm_InitStaticClassWithMeta(&Scm_S16VectorClass, "<s16vector>", m, NULL, SCM_NIL, NULL, 0);
90 Scm_InitStaticClassWithMeta(&Scm_U16VectorClass, "<u16vector>", m, NULL, SCM_NIL, NULL, 0);
91 Scm_InitStaticClassWithMeta(&Scm_S32VectorClass, "<s32vector>", m, NULL, SCM_NIL, NULL, 0);
92 Scm_InitStaticClassWithMeta(&Scm_U32VectorClass, "<u32vector>", m, NULL, SCM_NIL, NULL, 0);
93 Scm_InitStaticClassWithMeta(&Scm_S64VectorClass, "<s64vector>", m, NULL, SCM_NIL, NULL, 0);
94 Scm_InitStaticClassWithMeta(&Scm_U64VectorClass, "<u64vector>", m, NULL, SCM_NIL, NULL, 0);
95 Scm_InitStaticClassWithMeta(&Scm_F32VectorClass, "<f32vector>", m, NULL, SCM_NIL, NULL, 0);
96 Scm_InitStaticClassWithMeta(&Scm_F64VectorClass, "<f64vector>", m, NULL, SCM_NIL, NULL, 0);
97
98 Scm_Init_uvlib(m);
99 Scm_Init_uvseq();
100 Scm_ReadUvectorHook = read_uvector;
101 }