character.d 16.6 KB
Newer Older
1
2
3
4
5
6
7
/* -*- mode: c -*- */
/*
    character.d -- Character routines.
*/
/*
    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
    Copyright (c) 1990, Giuseppe Attardi.
8
    Copyright (c) 2012-2019,2021 Jean-Claude Beaudoin.
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

    MKCL is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 3 of the License, or (at your option) any later version.

    See file '../../Copyright' for full details.
*/

#include <mkcl/mkcl.h>
#include <stdio.h>

mkcl_object
mk_cl_standard_char_p(MKCL, mkcl_object c)
{
  mkcl_call_stack_check(env);
  /* INV: mkcl_char_code() checks the type */
  mkcl_word i = mkcl_char_code(env, c);
27
  mkcl_return_value((mkcl_standard_char_p(i)? mk_cl_Ct : mk_cl_Cnil));
28
29
30
31
32
33
34
}

mkcl_object
mk_cl_graphic_char_p(MKCL, mkcl_object c)
{
  mkcl_call_stack_check(env);
  /* INV: mkcl_char_code() checks the type */
35
  mkcl_return_value((mkcl_graphic_char_p(mkcl_char_code(env, c))? mk_cl_Ct : mk_cl_Cnil));
36
37
38
39
40
41
42
}

mkcl_object
mk_cl_alpha_char_p(MKCL, mkcl_object c)
{
  mkcl_call_stack_check(env);
  /* INV: mkcl_char_code() checks the type */
43
  mkcl_return_value((mkcl_alpha_char_p(mkcl_char_code(env, c))? mk_cl_Ct : mk_cl_Cnil));
44
45
46
47
48
49
50
}

mkcl_object
mk_cl_upper_case_p(MKCL, mkcl_object c)
{
  mkcl_call_stack_check(env);
  /* INV: mkcl_char_code() checks the type */
51
  mkcl_return_value((mkcl_upper_case_p(mkcl_char_code(env, c))? mk_cl_Ct : mk_cl_Cnil));
52
53
54
55
56
57
58
}

mkcl_object
mk_cl_lower_case_p(MKCL, mkcl_object c)
{
  mkcl_call_stack_check(env);
  /* INV: mkcl_char_code() checks the type */
59
  mkcl_return_value((mkcl_lower_case_p(mkcl_char_code(env, c))? mk_cl_Ct : mk_cl_Cnil));
60
61
62
63
64
65
66
}

mkcl_object
mk_cl_both_case_p(MKCL, mkcl_object c)
{
  mkcl_call_stack_check(env);
  /* INV: mkcl_char_code() checks the type */
67
  mkcl_return_value((mkcl_both_case_p(mkcl_char_code(env, c))? mk_cl_Ct : mk_cl_Cnil));
68
69
}

70
71
enum mkcl_string_case
mkcl_string_case(const mkcl_object str)
72
{
73
  enum mkcl_string_case str_case = mkcl_mixedcase_string;
74
  mkcl_index i;
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95

  if (MKCL_BASE_STRING_P(str))
    {
      const mkcl_base_char *text = str->base_string.self;
      const mkcl_index dim = str->base_string.dim;
      for (i = 0; i < dim; i++) {
        const mkcl_base_char ch = text[i];
        if (mkcl_upper_case_p(ch)) {
          if (str_case == mkcl_lowercase_string) 
            return mkcl_mixedcase_string;
          else
            str_case = mkcl_uppercase_string;
        } else if (mkcl_lower_case_p(ch)) {
          if (str_case == mkcl_uppercase_string)
            return mkcl_mixedcase_string;
          else
            str_case = mkcl_lowercase_string;
        }
      }
      return str_case;
    }
96
  else if (MKCL_CHARACTER_STRING_P(str))
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
    {
      const mkcl_character *text = str->string.self;
      const mkcl_index dim = str->string.dim;
      for (i = 0; i < dim; i++) {
        const mkcl_character ch = text[i];
        if (mkcl_upper_case_p(ch)) {
          if (str_case == mkcl_lowercase_string) 
            return mkcl_mixedcase_string;
          else
            str_case = mkcl_uppercase_string;
        } else if (mkcl_lower_case_p(ch)) {
          if (str_case == mkcl_uppercase_string)
            return mkcl_mixedcase_string;
          else
            str_case = mkcl_lowercase_string;
        }
      }
      return str_case;
115
    }
116
  else return str_case;
117
118
}

119
120
121
mkcl_object mk_cl_digit_char_p(MKCL, mkcl_narg narg, mkcl_object c, ...)
{
  mkcl_call_stack_check(env);
122
  {
123
124
125
126
127
128
129
130
131
    mkcl_object radix = MKCL_MAKE_FIXNUM(10);
    MKCL_RECEIVE_1_OPTIONAL_ARGUMENT(env, @'digit-char-p', narg, 1, c, &radix);
    {
      mkcl_word basis = mkcl_fixnum_in_range(env, @'digit-char-p',"radix", radix, 2, 36);
      mkcl_word value = mkcl_digitp(mkcl_char_code(env, c), basis);
      mkcl_return_value(((value < 0)? mk_cl_Cnil: MKCL_MAKE_FIXNUM(value)));
    }
  }
}
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159

/*
	Mkcl_Digitp(i, r) returns the weight of code i
	as a digit of radix r, which must be 1 < r <= 36.
	If i is not a digit, -1 is returned.
*/
int
mkcl_digitp(mkcl_character i, int r)
{
  if (('0' <= i) && (i <= '9') && (i < '0' + r))
    return i - '0';
  if (('A' <= i) && (10 < r) && (i < 'A' + (r - 10)))
    return i - 'A' + 10;
  if (('a' <= i) && (10 < r) && (i < 'a' + (r - 10)))
    return i - 'a' + 10;
  if (i > 255) {
    int number = mkcl_ucd_decimal_digit(i);
    if (number < r)
      return number;
  }
  return -1;
}

mkcl_object
mk_cl_alphanumericp(MKCL, mkcl_object c)
{
  mkcl_call_stack_check(env);
  /* INV: mkcl_char_code() checks type of `c' */
160
  mkcl_character i = mkcl_char_code(env, c);
161
  mkcl_return_value((mkcl_alphanumericp(i) ? mk_cl_Ct : mk_cl_Cnil));
162
163
}

164
165
166
167
168
169
170
171
172
173
174
175
176
177
mkcl_object mk_cl_charE(MKCL, mkcl_narg narg, mkcl_object c, ...)
{
  mkcl_call_stack_check(env);
  {
    mkcl_setup_for_rest(env, @'char=', 1, narg, c, cs);

    /* INV: mkcl_char_eq() checks types of `c' and `cs' */
    while (--narg)
      if (!mkcl_char_eq(env, c, mkcl_va_arg(cs)))
        { mkcl_va_end(cs); mkcl_return_value(mk_cl_Cnil); }
    mkcl_va_end(cs);
    mkcl_return_value(mk_cl_Ct);
  }
}
178
179
180
181
182
183
184

bool
mkcl_char_eq(MKCL, mkcl_object x, mkcl_object y)
{
  return mkcl_char_code(env, x) == mkcl_char_code(env, y);
}

185
186
187
188
189
190
191
192
193
194
195
196
mkcl_object mk_cl_charNE(MKCL, const mkcl_narg narg, ...)
{
  int i, j;
  mkcl_object c;

  mkcl_call_stack_check(env);
  {
    mkcl_setup_for_rest(env, @'char=', 0, narg, narg, cs);

    /* INV: mkcl_char_eq() checks types of its arguments */
    if (narg == 0)
      mkcl_FEwrong_num_arguments(env, @'char/=', 1, -1, 0);
197
    c = mkcl_va_arg(cs);
198
199
200
201
202
203
204
205
206
207
208
    for (i = 2; i<=narg; i++) {
      mkcl_va_list ds;
      mkcl_va_start(env, ds, narg, narg, 0);
      c = mkcl_va_arg(cs);
      for (j = 1; j<i; j++)
        if (mkcl_char_eq(env, mkcl_va_arg(ds), c))
          { mkcl_va_end(cs); mkcl_va_end(ds); mkcl_return_value(mk_cl_Cnil); }
      mkcl_va_end(ds);
    }
    mkcl_va_end(cs);
    mkcl_return_value(mk_cl_Ct);
209
  }
210
}
211
212
213
214
215
216
217

static mkcl_object
Lchar_cmp(MKCL, mkcl_narg narg, int s, int t, mkcl_va_list args)
{
  mkcl_object c, d;

  if (narg == 0)
218
    mkcl_FEwrong_num_arguments_anonym(env, 1, -1, narg);
219
220
221
222
  c = mkcl_va_arg(args);
  for (; --narg; c = d) {
    d = mkcl_va_arg(args);
    if (s*mkcl_char_cmp(env, d, c) < t)
223
      { mkcl_return_value(mk_cl_Cnil); }
224
  }
225
  mkcl_return_value(mk_cl_Ct);
226
227
228
229
230
231
232
233
234
235
236
}

int
mkcl_char_cmp(MKCL, mkcl_object x, mkcl_object y)
{
	/* mkcl_char_code(x) returns an integer which is well in the range
	 * of positive fixnums. Therefore, this subtraction never
	 * oveflows. */
  return mkcl_char_code(env, x) - mkcl_char_code(env, y);
}

237
238
239
240
241
mkcl_object mk_cl_charL(MKCL, const mkcl_narg narg, ...)
{
  mkcl_call_stack_check(env);
  {
    mkcl_setup_for_rest(env, @'char<', 0, narg, narg, args);
242

243
244
245
246
247
    mkcl_object val = Lchar_cmp(env, narg, 1, 1, args);
    mkcl_va_end(args);
    return val;
  }
}
248

249
250
251
252
253
mkcl_object mk_cl_charG(MKCL, const mkcl_narg narg, ...)
{
  mkcl_call_stack_check(env);
  {
    mkcl_setup_for_rest(env, @'char>', 0, narg, narg, args);
254

255
256
257
258
259
    mkcl_object val = Lchar_cmp(env, narg, -1, 1, args);
    mkcl_va_end(args);
    return val;
  }
}
260

261
262
263
264
265
266
267
268
269
mkcl_object mk_cl_charLE(MKCL, const mkcl_narg narg, ...)
{
  mkcl_call_stack_check(env);
  {
    mkcl_setup_for_rest(env, @'char<=', 0, narg, narg, args);

    mkcl_object val = Lchar_cmp(env, narg, 1, 0, args);
    mkcl_va_end(args);
    return val;
270
  }
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
}

mkcl_object mk_cl_charGE(MKCL, const mkcl_narg narg, ...)
{
  mkcl_call_stack_check(env);
  {
    mkcl_setup_for_rest(env, @'char>=', 0, narg, narg, args);

    mkcl_object val = Lchar_cmp(env, narg, -1, 0, args);
    mkcl_va_end(args);
    return val;
  }
}

mkcl_object mk_cl_char_equal(MKCL, mkcl_narg narg, mkcl_object c, ...)
{
  mkcl_narg i;
  mkcl_call_stack_check(env);
  {
    mkcl_setup_for_rest(env, @'char-equal', 1, narg, c, cs);

    /* INV: mkcl_char_equal() checks the type of its arguments */
    for (narg--, i = 0;  i < narg;  i++) {
      if (!mkcl_char_equal(env, c, mkcl_va_arg(cs)))
        { mkcl_va_end(cs); mkcl_return_value(mk_cl_Cnil); }
    }
    mkcl_va_end(cs);
    mkcl_return_value(mk_cl_Ct);
  }
}
301
302
303
304
305
306
307
308
309

#define char_equal_code(e, x) mkcl_char_upcase(mkcl_char_code(e, x))

bool
mkcl_char_equal(MKCL, mkcl_object x, mkcl_object y)
{
  return char_equal_code(env, x) == char_equal_code(env, y);
}

310
311
mkcl_object mk_cl_char_not_equal(MKCL, mkcl_narg narg, ...)
{
312
313
  int i, j;
  mkcl_object c;
314
315
316
317
318
319
320
  mkcl_call_stack_check(env);
  {
    mkcl_setup_for_rest(env, @'char-not-equal', 0, narg, narg, cs);

    /* INV: mkcl_char_equal() checks the type of its arguments */
    if (narg == 0)
      mkcl_FEwrong_num_arguments(env, @'char-not-equal', 1, -1, narg);
321
    c = mkcl_va_arg(cs);
322
323
324
325
326
327
328
329
330
331
332
    for (i = 2;  i<=narg;  i++) {
      mkcl_va_list ds;
      mkcl_va_start(env, ds, narg, narg, 0);
      c = mkcl_va_arg(cs);
      for (j=1;  j<i;  j++)
        if (mkcl_char_equal(env, c, mkcl_va_arg(ds)))
          { mkcl_va_end(cs); mkcl_va_end(ds); mkcl_return_value(mk_cl_Cnil); }
      mkcl_va_end(ds);
    }
    mkcl_va_end(cs);
    mkcl_return_value(mk_cl_Ct);
333
  }
334
}
335
336
337
338
339
340
341
342

static mkcl_object
Lchar_compare(MKCL, mkcl_narg narg, int s, int t, mkcl_va_list args)
{
  mkcl_object c, d;
  
  /* INV: mkcl_char_compare() checks the types of its arguments */
  if (narg == 0)
343
    mkcl_FEwrong_num_arguments_anonym(env, 1, -1, narg);
344
345
346
347
  c = mkcl_va_arg(args);
  for (; --narg; c = d) {
    d = mkcl_va_arg(args);
    if (s*mkcl_char_compare(env, d, c) < t)
348
      { mkcl_return_value(mk_cl_Cnil); }
349
  }
350
  mkcl_return_value(mk_cl_Ct);
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
}

int
mkcl_char_compare(MKCL, mkcl_object x, mkcl_object y)
{
  mkcl_word i = char_equal_code(env, x);
  mkcl_word j = char_equal_code(env, y);

  if (i < j)
    return(-1);
  else if (i == j)
    return(0);
  else
    return(1);
}

367
368
369
370
371
mkcl_object mk_cl_char_lessp(MKCL, mkcl_narg narg, ...)
{
  mkcl_call_stack_check(env);
  {
    mkcl_setup_for_rest(env, @'char-lessp', 0, narg, narg, args);
372

373
374
375
376
377
    mkcl_object val = Lchar_compare(env, narg, 1, 1, args);
    mkcl_va_end(args);
    return val;
  }
}
378

379
380
381
382
383
mkcl_object mk_cl_char_greaterp(MKCL, mkcl_narg narg, ...)
{
  mkcl_call_stack_check(env);
  {
    mkcl_setup_for_rest(env, @'char-greaterp', 0, narg, narg, args);
384

385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
    mkcl_object val = Lchar_compare(env, narg,-1, 1, args);
    mkcl_va_end(args);
    return val;
  }
}

mkcl_object mk_cl_char_not_greaterp(MKCL, mkcl_narg narg, ...)
{
  mkcl_call_stack_check(env);
  {
    mkcl_setup_for_rest(env, @'char-not-greaterp', 0, narg, narg, args);

    mkcl_object val = Lchar_compare(env, narg, 1, 0, args);
    mkcl_va_end(args);
    return val;
  }
}

mkcl_object mk_cl_char_not_lessp(MKCL, mkcl_narg narg, ...)
{
  mkcl_call_stack_check(env);
  {
    mkcl_setup_for_rest(env, @'char-not-lessp', 0, narg, narg, args);

    mkcl_object val = Lchar_compare(env, narg,-1, 0, args);
    mkcl_va_end(args);
    return val;
  }
}
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448


mkcl_object
mk_cl_character(MKCL, mkcl_object x)
{
  mkcl_call_stack_check(env);
 AGAIN:
  switch (mkcl_type_of(x)) {
  case mkcl_t_character:
    break;
  case mkcl_t_symbol:
    x = x->symbol.name;
    goto AGAIN;
  case mkcl_t_string:
    if (x->string.fillp == 1) {
      x = MKCL_CODE_CHAR(x->string.self[0]);
      break;
    }
    goto _MKCL_ERROR;
  case mkcl_t_base_string:
    if (x->base_string.fillp == 1) {
      x = MKCL_CODE_CHAR(x->base_string.self[0]);
      break;
    }
  _MKCL_ERROR:
  default:
    x = mkcl_type_error(env, 
			@'character',
			"character designator",
			x,
			mkcl_fast_read_from_cstring(env,("(OR CHARACTER SYMBOL"
							 " (ARRAY CHARACTER (1))"
							 " (ARRAY BASE-CHAR (1)))")));
    goto AGAIN;
  }
449
  mkcl_return_value(x);
450
451
452
453
454
455
456
}

mkcl_object
mk_cl_char_code(MKCL, mkcl_object c)
{
  mkcl_call_stack_check(env);
  /* INV: mkcl_char_code() checks the type of `c' */
457
  mkcl_return_value(MKCL_MAKE_FIXNUM(mkcl_char_code(env, c)));
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
}

mkcl_object
mk_cl_code_char(MKCL, mkcl_object c)
{
  mkcl_word fc;

  mkcl_call_stack_check(env);
  switch (mkcl_type_of(c)) {
  case mkcl_t_fixnum:
    fc = mkcl_fixnum_to_word(c);
    /* What about invalid codepoints like D800-DFFF or FFFE or FFFF? JCB */
    if ((0 <= fc && fc < 0x0D800) || (0x0DFFF < fc && fc != 0x0FFFE && fc != 0x0FFFF && fc < MKCL_CHAR_CODE_LIMIT))
      c = MKCL_CODE_CHAR(fc);
    else
      c = mk_cl_Cnil;
    break;
  case mkcl_t_bignum:
    c = mk_cl_Cnil;
    break;
  default:
    mkcl_FEtype_error_integer(env, c);
  }
481
  mkcl_return_value(c);
482
483
484
485
486
487
488
489
}

mkcl_object
mk_cl_char_upcase(MKCL, mkcl_object c)
{
  mkcl_call_stack_check(env);
  /* INV: mkcl_char_code() checks the type of `c' */
  mkcl_word code = mkcl_char_code(env, c);
490
  mkcl_return_value(MKCL_CODE_CHAR(mkcl_char_upcase(code)));
491
492
493
494
495
496
497
498
}

mkcl_object
mk_cl_char_downcase(MKCL, mkcl_object c)
{
  mkcl_call_stack_check(env);
  /* INV: mkcl_char_code() checks the type of `c' */
  mkcl_word code = mkcl_char_code(env, c);
499
  mkcl_return_value(MKCL_CODE_CHAR(mkcl_char_downcase(code)));
500
501
}

502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
mkcl_object mk_cl_digit_char(MKCL, mkcl_narg narg, mkcl_object weight, ...)
{
  mkcl_call_stack_check(env);
  {
    mkcl_object radix = MKCL_MAKE_FIXNUM(10);
    MKCL_RECEIVE_1_OPTIONAL_ARGUMENT(env, @'digit-char', narg, 1, weight, &radix);

    {
      mkcl_word basis = mkcl_fixnum_in_range(env, @'digit-char',"radix",radix,2,36);
      mkcl_object output = mk_cl_Cnil;
    AGAIN:
      switch (mkcl_type_of(weight)) {
      case mkcl_t_fixnum: {
        mkcl_word value = mkcl_fixnum_to_word(weight);
        if (value >= 0) {
          int dw = mkcl_digit_char(value, basis);
          if (dw >= 0) {
            output = MKCL_CODE_CHAR(dw);
          }
        }
        break;
523
      }
524
525
526
527
528
529
530
      case mkcl_t_bignum:
        break;
      default:
        weight = mkcl_type_error(env, @'digit-char',"weight",weight,@'integer');
        goto AGAIN;
      }
      mkcl_return_value(output);
531
    }
532
533
  }
}
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564

short
mkcl_digit_char(mkcl_word w, mkcl_word r)
{
  if (r < 2 || r > 36 || w < 0 || w >= r)
    return(-1);
  if (w < 10)
    return(w + '0');
  else
    return(w - 10 + 'A');
}

mkcl_object
mk_cl_char_int(MKCL, mkcl_object c)
{
  mkcl_call_stack_check(env);
  /* INV: mkcl_char_code() checks the type of `c' */
  mkcl_object val = MKCL_MAKE_FIXNUM(mkcl_char_code(env, c));
  mkcl_return1(val);
}

/* here we give every character an implicit name of the form 'u#' where # is a hexadecimal number,
   corresponding to a unicode code point.
   #\u14ea should work, for example
*/

mkcl_object
mk_cl_char_name(MKCL, mkcl_object c)
{
  mkcl_call_stack_check(env);
  mkcl_character code = mkcl_char_code(env, c);
565
  mkcl_object output = mk_cl_Cnil;
566

567
568
  if (/* (code >= 0) && */ (code <= MKCL_BASE_CHAR_CODE_LIMIT))
    output = mkcl_gethash_safe(env, MKCL_MAKE_FIXNUM(code), mkcl_core.base_char_names, mk_cl_Cnil);
569
570
  else
    {
571
572
573
574
575
576
      mkcl_object ext_names = MKCL_SYM_VAL(env, @'si::*extended-character-names*');

      if (ext_names != mk_cl_Cnil)
        output =  mkcl_gethash_safe(env, MKCL_MAKE_FIXNUM(code), ext_names, mk_cl_Cnil);
      if (mkcl_Null(output))
        {
577
          char name[20] = { 0 };
578
579

          if (/* (code >= 0) && */ (code < 0x010000)) /* Are we confined to 16 bits? */
580
            snprintf(name, sizeof(name), "U%04x", code);
581
          else
582
            snprintf(name, sizeof(name), "U%06x", code);
583
584
585
          output = mkcl_make_base_string_copy(env, name);
        }
    }
586
  mkcl_return_value(output);
587
588
589
590
591
592
593
594
595
596
}

mkcl_object
mk_cl_name_char(MKCL, mkcl_object name)
{
  mkcl_object c;
  mkcl_index l;

  mkcl_call_stack_check(env);
  name = mk_cl_string(env, name);
597
  c = mkcl_gethash_safe(env, name, mkcl_core.base_char_names, mk_cl_Cnil);
598
  if (c != mk_cl_Cnil) {
599
    mkcl_return_value(MKCL_CODE_CHAR(mkcl_fixnum_to_word(c)));
600
601
602
603
604
  } else {
    mkcl_object ext_names = MKCL_SYM_VAL(env, @'si::*extended-character-names*');

    if (ext_names != mk_cl_Cnil) c = mkcl_gethash_safe(env, name, ext_names, mk_cl_Cnil);
    if (c != mk_cl_Cnil) {
605
      mkcl_return_value(MKCL_CODE_CHAR(mkcl_fixnum_to_word(c)));
606
607
608
    } else if (mkcl_stringp(env, name) && (l = mkcl_length(env, name))) {
      c = mk_cl_char(env, name, MKCL_MAKE_FIXNUM(0));
      if (l == 1) {
609
        mkcl_return_value(mk_cl_Cnil);
610
      } else if (c != MKCL_CODE_CHAR('u') && c != MKCL_CODE_CHAR('U')) {
611
        mkcl_return_value(mk_cl_Cnil);
612
613
614
615
616
617
618
619
      } else {
        mkcl_index used_l;
        mkcl_index end = name->base_string.fillp;
        mkcl_index real_end = end;
        c = mkcl_parse_integer(env, name, 1, end, &real_end, 16);
        used_l = real_end;
        if (!MKCL_FIXNUMP(c) /* Bignum? */
            || (used_l < l)) /* Was character name cut short? JCB */
620
          { mkcl_return_value(mk_cl_Cnil); } 
621
622
623
624
625
        else
          {
            mkcl_character code = mkcl_fixnum_to_word(c);
            
            if (/* (code < 0) || */ (code >= MKCL_CHAR_CODE_LIMIT)) /* Outside valid character code range? */
626
              { mkcl_return_value(mk_cl_Cnil); }
627
            else
628
              { mkcl_return_value(MKCL_CODE_CHAR(code)); }
629
630
          }
      }
631
632
    }
  }
633
  mkcl_return_value(mk_cl_Cnil); /* Just in case. Should not be reached. JCB */
634
}