ia64/xen-unstable

view tools/vnet/libxutil/sxpr.c @ 19848:5839491bbf20

[IA64] replace MAX_VCPUS with d->max_vcpus where necessary.

don't use MAX_VCPUS, and use vcpu::max_vcpus.
The changeset of 2f9e1348aa98 introduced max_vcpus to allow more vcpus
per guest. This patch is ia64 counter part.

Signed-off-by: Isaku Yamahata <yamahata@valinux.co.jp>
author Isaku Yamahata <yamahata@valinux.co.jp>
date Mon Jun 29 11:26:05 2009 +0900 (2009-06-29)
parents 06d84bf87159
children
line source
1 /*
2 * Copyright (C) 2001 - 2004 Mike Wray <mike.wray@hp.com>
3 *
4 * This library is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU Lesser General Public License as
6 * published by the Free Software Foundation; either version 2.1 of the
7 * License, or (at your option) any later version. This library is
8 * distributed in the hope that it will be useful, but WITHOUT ANY
9 * WARRANTY; without even the implied warranty of MERCHANTABILITY or
10 * FITNESS FOR A PARTICULAR PURPOSE.
11 * See the GNU Lesser General Public License for more details.
12 *
13 * You should have received a copy of the GNU Lesser General Public License
14 * along with this library; if not, write to the Free Software Foundation,
15 * Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
16 */
18 #include <stdarg.h>
19 #include "sys_string.h"
20 #include "lexis.h"
21 #include "sys_net.h"
22 #include "hash_table.h"
23 #include "sxpr.h"
25 #ifdef __KERNEL__
26 #include <linux/errno.h>
27 #else
28 #include <errno.h>
29 #endif
31 #ifdef __KERNEL__
32 #include <linux/random.h>
34 int rand(void){
35 int v;
36 get_random_bytes(&v, sizeof(v));
37 return v;
38 }
40 #else
41 #include <stdlib.h>
42 #endif
44 #undef free
46 /** @file
47 * General representation of sxprs.
48 * Includes print, equal, and free functions for the sxpr types.
49 *
50 * Zero memory containing an Sxpr will have the value ONONE - this is intentional.
51 * When a function returning an sxpr cannot allocate memory we return ONOMEM.
52 *
53 */
55 static int atom_print(IOStream *io, Sxpr obj, unsigned flags);
56 static int atom_equal(Sxpr x, Sxpr y);
57 static void atom_free(Sxpr obj);
58 static Sxpr atom_copy(Sxpr obj);
60 static int string_print(IOStream *io, Sxpr obj, unsigned flags);
61 static int string_equal(Sxpr x, Sxpr y);
62 static void string_free(Sxpr obj);
63 static Sxpr string_copy(Sxpr obj);
65 static int cons_print(IOStream *io, Sxpr obj, unsigned flags);
66 static int cons_equal(Sxpr x, Sxpr y);
67 static void cons_free(Sxpr obj);
68 static Sxpr cons_copy(Sxpr obj);
70 static int null_print(IOStream *io, Sxpr obj, unsigned flags);
71 static int none_print(IOStream *io, Sxpr obj, unsigned flags);
72 static int int_print(IOStream *io, Sxpr obj, unsigned flags);
73 static int bool_print(IOStream *io, Sxpr obj, unsigned flags);
74 static int err_print(IOStream *io, Sxpr obj, unsigned flags);
75 static int nomem_print(IOStream *io, Sxpr obj, unsigned flags);
77 /** Type definitions. */
78 static SxprType types[1024] = {
79 [T_NONE] { .type= T_NONE, .name= "none", .print= none_print },
80 [T_NULL] { .type= T_NULL, .name= "null", .print= null_print },
81 [T_UINT] { .type= T_UINT, .name= "int", .print= int_print, },
82 [T_BOOL] { .type= T_BOOL, .name= "bool", .print= bool_print, },
83 [T_ERR] { .type= T_ERR, .name= "err", .print= err_print, },
84 [T_NOMEM] { .type= T_ERR, .name= "nomem", .print= nomem_print, },
85 [T_ATOM] { .type= T_ATOM, .name= "atom", .print= atom_print,
86 .pointer= TRUE,
87 .free= atom_free,
88 .equal= atom_equal,
89 .copy= atom_copy,
90 },
91 [T_STRING] { .type= T_STRING, .name= "string", .print= string_print,
92 .pointer= TRUE,
93 .free= string_free,
94 .equal= string_equal,
95 .copy= string_copy,
96 },
97 [T_CONS] { .type= T_CONS, .name= "cons", .print= cons_print,
98 .pointer= TRUE,
99 .free= cons_free,
100 .equal= cons_equal,
101 .copy= cons_copy,
102 },
103 };
105 /** Number of entries in the types array. */
106 static int type_sup = sizeof(types)/sizeof(types[0]);
108 /** Define a type.
109 * The tydef must have a non-zero type code.
110 * It is an error if the type code is out of range or already defined.
111 *
112 * @param tydef type definition
113 * @return 0 on success, error code otherwise
114 */
115 int def_sxpr_type(SxprType *tydef){
116 int err = 0;
117 int ty = tydef->type;
118 if(ty < 0 || ty >= type_sup){
119 err = -EINVAL;
120 goto exit;
121 }
122 if(types[ty].type){
123 err = -EEXIST;
124 goto exit;
125 }
126 types[ty] = *tydef;
127 exit:
128 return err;
130 }
132 /** Get the type definition for a given type code.
133 *
134 * @param ty type code
135 * @return type definition or null
136 */
137 SxprType *get_sxpr_type(int ty){
138 if(0 <= ty && ty < type_sup){
139 return types+ty;
140 }
141 return NULL;
142 }
144 /** The default print function.
145 *
146 * @param io stream to print to
147 * @param x sxpr to print
148 * @param flags print flags
149 * @return number of bytes written on success
150 */
151 int default_print(IOStream *io, Sxpr x, unsigned flags){
152 return IOStream_print(io, "#<%u %lu>\n", get_type(x), get_ul(x));
153 }
155 /** The default equal function.
156 * Uses eq().
157 *
158 * @param x sxpr to compare
159 * @param y sxpr to compare
160 * @return 1 if equal, 0 otherwise
161 */
162 int default_equal(Sxpr x, Sxpr y){
163 return eq(x, y);
164 }
166 /** General sxpr print function.
167 * Prints an sxpr on a stream using the print function for the sxpr type.
168 * Printing is controlled by flags from the PrintFlags enum.
169 * If PRINT_TYPE is in the flags the sxpr type is printed before the sxpr
170 * (for debugging).
171 *
172 * @param io stream to print to
173 * @param x sxpr to print
174 * @param flags print flags
175 * @return number of bytes written
176 */
177 int objprint(IOStream *io, Sxpr x, unsigned flags){
178 SxprType *def = get_sxpr_type(get_type(x));
179 ObjPrintFn *print_fn = (def && def->print ? def->print : default_print);
180 int k = 0;
181 if(!io) return k;
182 if(flags & PRINT_TYPE){
183 k += IOStream_print(io, "%s:", def->name);
184 }
185 if(def->pointer && (flags & PRINT_ADDR)){
186 k += IOStream_print(io, "<%p>", get_ptr(x));
187 }
188 k += print_fn(io, x, flags);
189 return k;
190 }
192 Sxpr objcopy(Sxpr x){
193 SxprType *def = get_sxpr_type(get_type(x));
194 ObjCopyFn *copy_fn = (def ? def->copy : NULL);
195 Sxpr v;
196 if(copy_fn){
197 v = copy_fn(x);
198 } else if(def->pointer){
199 v = ONOMEM;
200 } else {
201 v = x;
202 }
203 return v;
204 }
206 /** General sxpr free function.
207 * Frees an sxpr using the free function for its type.
208 * Free functions must recursively free any subsxprs.
209 * If no function is defined then the default is to
210 * free sxprs whose type has pointer true.
211 * Sxprs must not be used after freeing.
212 *
213 * @param x sxpr to free
214 */
215 void objfree(Sxpr x){
216 SxprType *def = get_sxpr_type(get_type(x));
218 if(def){
219 if(def->free){
220 def->free(x);
221 } else if (def->pointer){
222 hfree(x);
223 }
224 }
225 }
227 /** General sxpr equality function.
228 * Compares x and y using the equal function for x.
229 * Uses default_equal() if x has no equal function.
230 *
231 * @param x sxpr to compare
232 * @param y sxpr to compare
233 * @return 1 if equal, 0 otherwise
234 */
235 int objequal(Sxpr x, Sxpr y){
236 SxprType *def = get_sxpr_type(get_type(x));
237 ObjEqualFn *equal_fn = (def && def->equal ? def->equal : default_equal);
238 return equal_fn(x, y);
239 }
241 /** Search for a key in an alist.
242 * An alist is a list of conses, where the cars
243 * of the conses are the keys. Compares keys using equality.
244 *
245 * @param k key
246 * @param l alist to search
247 * @return first element of l with car k, or ONULL
248 */
249 Sxpr assoc(Sxpr k, Sxpr l){
250 for( ; CONSP(l) ; l = CDR(l)){
251 Sxpr x = CAR(l);
252 if(CONSP(x) && objequal(k, CAR(x))){
253 return x;
254 }
255 }
256 return ONULL;
257 }
259 /** Search for a key in an alist.
260 * An alist is a list of conses, where the cars
261 * of the conses are the keys. Compares keys using eq.
262 *
263 * @param k key
264 * @param l alist to search
265 * @return first element of l with car k, or ONULL
266 */
267 Sxpr assocq(Sxpr k, Sxpr l){
268 for( ; CONSP(l); l = CDR(l)){
269 Sxpr x = CAR(l);
270 if(CONSP(x) && eq(k, CAR(x))){
271 return x;
272 }
273 }
274 return ONULL;
275 }
277 /** Add a new key and value to an alist.
278 *
279 * @param k key
280 * @param l value
281 * @param l alist
282 * @return l with the new cell added to the front
283 */
284 Sxpr acons(Sxpr k, Sxpr v, Sxpr l){
285 Sxpr x, y;
286 x = cons_new(k, v);
287 if(NOMEMP(x)) return x;
288 y = cons_new(x, l);
289 if(NOMEMP(y)) cons_free_cells(x);
290 return y;
291 }
293 /** Test if a list contains an element.
294 * Uses sxpr equality.
295 *
296 * @param l list
297 * @param x element to look for
298 * @return a tail of l with x as car, or ONULL
299 */
300 Sxpr cons_member(Sxpr l, Sxpr x){
301 for( ; CONSP(l) && !eq(x, CAR(l)); l = CDR(l)){}
302 return l;
303 }
305 /** Test if a list contains an element satisfying a test.
306 * The test function is called with v and an element of the list.
307 *
308 * @param l list
309 * @param test_fn test function to use
310 * @param v value for first argument to the test
311 * @return a tail of l with car satisfying the test, or 0
312 */
313 Sxpr cons_member_if(Sxpr l, ObjEqualFn *test_fn, Sxpr v){
314 for( ; CONSP(l) && !test_fn(v, CAR(l)); l = CDR(l)){ }
315 return l;
316 }
318 /** Test if the elements of list 't' are a subset of the elements
319 * of list 's'. Element order is not significant.
320 *
321 * @param s element list to check subset of
322 * @param t element list to check if is a subset
323 * @return 1 if is a subset, 0 otherwise
324 */
325 int cons_subset(Sxpr s, Sxpr t){
326 for( ; CONSP(t); t = CDR(t)){
327 if(!CONSP(cons_member(s, CAR(t)))){
328 return 0;
329 }
330 }
331 return 1;
332 }
334 /** Test if two lists have equal sets of elements.
335 * Element order is not significant.
336 *
337 * @param s list to check
338 * @param t list to check
339 * @return 1 if equal, 0 otherwise
340 */
341 int cons_set_equal(Sxpr s, Sxpr t){
342 return cons_subset(s, t) && cons_subset(t, s);
343 }
345 #ifdef USE_GC
346 /*============================================================================*/
347 /* The functions inside this ifdef are only safe if GC is used.
348 * Otherwise they may leak memory.
349 */
351 /** Remove an element from a list (GC only).
352 * Uses sxpr equality and removes all instances, even
353 * if there are more than one.
354 *
355 * @param l list to remove elements from
356 * @param x element to remove
357 * @return modified input list
358 */
359 Sxpr cons_remove(Sxpr l, Sxpr x){
360 return cons_remove_if(l, eq, x);
361 }
363 /** Remove elements satisfying a test (GC only).
364 * The test function is called with v and an element of the set.
365 *
366 * @param l list to remove elements from
367 * @param test_fn function to use to decide if an element should be removed
368 * @return modified input list
369 */
370 Sxpr cons_remove_if(Sxpr l, ObjEqualFn *test_fn, Sxpr v){
371 Sxpr prev = ONULL, elt, next;
373 for(elt = l; CONSP(elt); elt = next){
374 next = CDR(elt);
375 if(test_fn(v, CAR(elt))){
376 if(NULLP(prev)){
377 l = next;
378 } else {
379 CDR(prev) = next;
380 }
381 }
382 }
383 return l;
384 }
386 /** Set the value for a key in an alist (GC only).
387 * If the key is present, changes the value, otherwise
388 * adds a new cell.
389 *
390 * @param k key
391 * @param v value
392 * @param l alist
393 * @return modified or extended list
394 */
395 Sxpr setf(Sxpr k, Sxpr v, Sxpr l){
396 Sxpr e = assoc(k, l);
397 if(NULLP(e)){
398 l = acons(k, v, l);
399 } else {
400 CAR(CDR(e)) = v;
401 }
402 return l;
403 }
404 /*============================================================================*/
405 #endif /* USE_GC */
407 /** Create a new atom with the given name.
408 *
409 * @param name the name
410 * @return new atom
411 */
412 Sxpr atom_new(char *name){
413 Sxpr n, obj = ONOMEM;
414 long v;
416 // Don't always want to do this.
417 if(0 && convert_atol(name, &v) == 0){
418 obj = OINT(v);
419 } else {
420 n = string_new(name);
421 if(NOMEMP(n)) goto exit;
422 obj = HALLOC(ObjAtom, T_ATOM);
423 if(NOMEMP(obj)){
424 string_free(n);
425 goto exit;
426 }
427 OBJ_ATOM(obj)->name = n;
428 }
429 exit:
430 return obj;
431 }
433 /** Free an atom.
434 *
435 * @param obj to free
436 */
437 void atom_free(Sxpr obj){
438 // Interned atoms are shared, so do not free.
439 if(OBJ_ATOM(obj)->interned) return;
440 objfree(OBJ_ATOM(obj)->name);
441 hfree(obj);
442 }
444 /** Copy an atom.
445 *
446 * @param obj to copy
447 */
448 Sxpr atom_copy(Sxpr obj){
449 Sxpr v;
450 if(OBJ_ATOM(obj)->interned){
451 v = obj;
452 } else {
453 v = atom_new(atom_name(obj));
454 }
455 return v;
456 }
458 /** Print an atom. Prints the atom name.
459 *
460 * @param io stream to print to
461 * @param obj to print
462 * @param flags print flags
463 * @return number of bytes printed
464 */
465 int atom_print(IOStream *io, Sxpr obj, unsigned flags){
466 return objprint(io, OBJ_ATOM(obj)->name, flags);
467 }
469 /** Atom equality.
470 *
471 * @param x to compare
472 * @param y to compare
473 * @return 1 if equal, 0 otherwise
474 */
475 int atom_equal(Sxpr x, Sxpr y){
476 int ok;
477 ok = eq(x, y);
478 if(ok) goto exit;
479 ok = ATOMP(y) && string_equal(OBJ_ATOM(x)->name, OBJ_ATOM(y)->name);
480 if(ok) goto exit;
481 ok = STRINGP(y) && string_equal(OBJ_ATOM(x)->name, y);
482 exit:
483 return ok;
484 }
486 /** Get the name of an atom.
487 *
488 * @param obj atom
489 * @return name
490 */
491 char * atom_name(Sxpr obj){
492 return string_string(OBJ_ATOM(obj)->name);
493 }
495 int atom_length(Sxpr obj){
496 return string_length(OBJ_ATOM(obj)->name);
497 }
499 /** Get the C string from a string sxpr.
500 *
501 * @param obj string sxpr
502 * @return string
503 */
504 char * string_string(Sxpr obj){
505 return OBJ_STRING(obj)->data;
506 }
508 /** Get the length of a string.
509 *
510 * @param obj string
511 * @return length
512 */
513 int string_length(Sxpr obj){
514 return OBJ_STRING(obj)->len;
515 }
517 /** Create a new string. The input string is copied,
518 * and must be null-terminated.
519 *
520 * @param s characters to put in the string
521 * @return new sxpr
522 */
523 Sxpr string_new(char *s){
524 int n = (s ? strlen(s) : 0);
525 return string_new_n(s, n);
526 }
528 /** Create a new string. The input string is copied,
529 * and need not be null-terminated.
530 *
531 * @param s characters to put in the string (may be null)
532 * @param n string length
533 * @return new sxpr
534 */
535 Sxpr string_new_n(char *s, int n){
536 Sxpr obj;
537 obj = halloc(sizeof(ObjString) + n + 1, T_STRING);
538 if(!NOMEMP(obj)){
539 char *str = OBJ_STRING(obj)->data;
540 OBJ_STRING(obj)->len = n;
541 if(s){
542 memcpy(str, s, n);
543 str[n] = '\0';
544 } else {
545 memset(str, 0, n + 1);
546 }
547 }
548 return obj;
549 }
551 /** Free a string.
552 *
553 * @param obj to free
554 */
555 void string_free(Sxpr obj){
556 hfree(obj);
557 }
559 /** Copy a string.
560 *
561 * @param obj to copy
562 */
563 Sxpr string_copy(Sxpr obj){
564 return string_new_n(string_string(obj), string_length(obj));
565 }
567 /** Determine if a string needs escapes when printed
568 * using the given flags.
569 *
570 * @param str string to check
571 * @param n string length
572 * @param flags print flags
573 * @return 1 if needs escapes, 0 otherwise
574 */
575 int needs_escapes(char *str, int n, unsigned flags){
576 char *c;
577 int i;
578 int val = 0;
580 if(str){
581 for(i=0, c=str; i<n; i++, c++){
582 if(in_alpha_class(*c)) continue;
583 if(in_decimal_digit_class(*c)) continue;
584 if(in_class(*c, "/._+:@~-")) continue;
585 val = 1;
586 break;
587 }
588 }
589 return val;
590 }
592 char randchar(void){
593 int r;
594 char c;
595 for( ; ; ){
596 r = rand();
597 c = (r >> 16) & 0xff;
598 if('a' <= c && c <= 'z') break;
599 }
600 return c;
601 }
603 int string_contains(char *s, int s_n, char *k, int k_n){
604 int i, n = s_n - k_n;
605 for(i=0; i < n; i++){
606 if(!memcmp(s+i, k, k_n)) return 1;
607 }
608 return 0;
609 }
611 int string_delim(char *s, int s_n, char *d, int d_n){
612 int i;
613 if(d_n < 4) return -1;
614 memset(d, 0, d_n+1);
615 for(i=0; i<3; i++){
616 d[i] = randchar();
617 }
618 for( ; i < d_n; i++){
619 if(!string_contains(s, s_n, d, i)){
620 return i;
621 }
622 d[i] = randchar();
623 }
624 return -1;
625 }
627 /** Print the bytes in a string as-is.
628 *
629 * @param io stream
630 * @param str string
631 * @param n length
632 * @return bytes written or error code
633 */
634 int _string_print_raw(IOStream *io, char *str, int n){
635 int k = 0;
636 k = IOStream_write(io, str, n);
637 return k;
638 }
640 /** Print a string in counted data format.
641 *
642 * @param io stream
643 * @param str string
644 * @param n length
645 * @return bytes written or error code
646 */
647 int _string_print_counted(IOStream *io, char *str, int n){
648 int k = 0;
649 k += IOStream_print(io, "%c%c%d%c",
650 c_data_open, c_data_count, n, c_data_count);
651 k += IOStream_write(io, str, n);
652 return k;
653 }
655 /** Print a string in quoted data format.
656 *
657 * @param io stream
658 * @param str string
659 * @param n length
660 * @return bytes written or error code
661 */
662 int _string_print_quoted(IOStream *io, char *str, int n){
663 int k = 0;
664 char d[10];
665 int d_n;
666 d_n = string_delim(str, n, d, sizeof(d) - 1);
667 k += IOStream_print(io, "%c%c%s%c",
668 c_data_open, c_data_quote, d, c_data_quote);
669 k += IOStream_write(io, str, n);
670 k += IOStream_print(io, "%c%s%c", c_data_quote, d, c_data_quote);
671 return k;
672 }
674 /** Print a string as a quoted string.
675 *
676 * @param io stream
677 * @param str string
678 * @param n length
679 * @return bytes written or error code
680 */
681 int _string_print_string(IOStream *io, char *str, int n){
682 int k = 0;
684 k += IOStream_print(io, "\"");
685 if(str){
686 char *s, *t;
687 for(s = str, t = str + n; s < t; s++){
688 if(*s < ' ' || *s >= 127 ){
689 switch(*s){
690 case '\a': k += IOStream_print(io, "\\a"); break;
691 case '\b': k += IOStream_print(io, "\\b"); break;
692 case '\f': k += IOStream_print(io, "\\f"); break;
693 case '\n': k += IOStream_print(io, "\\n"); break;
694 case '\r': k += IOStream_print(io, "\\r"); break;
695 case '\t': k += IOStream_print(io, "\\t"); break;
696 case '\v': k += IOStream_print(io, "\\v"); break;
697 default:
698 // Octal escape;
699 k += IOStream_print(io, "\\%o", *s);
700 break;
701 }
702 } else if(*s == c_double_quote ||
703 *s == c_single_quote ||
704 *s == c_escape){
705 k += IOStream_print(io, "\\%c", *s);
706 } else {
707 k+= IOStream_print(io, "%c", *s);
708 }
709 }
710 }
711 k += IOStream_print(io, "\"");
712 return k;
713 }
715 /** Print a string to a stream, with escapes if necessary.
716 *
717 * @param io stream to print to
718 * @param str string
719 * @param n string length
720 * @param flags print flags
721 * @return number of bytes written
722 */
723 int _string_print(IOStream *io, char *str, int n, unsigned flags){
724 int k = 0;
725 if((flags & PRINT_COUNTED)){
726 k = _string_print_counted(io, str, n);
727 } else if((flags & PRINT_RAW) || !needs_escapes(str, n, flags)){
728 k = _string_print_raw(io, str, n);
729 } else if(n > 50){
730 k = _string_print_quoted(io, str, n);
731 } else {
732 k = _string_print_string(io, str, n);
733 }
734 return k;
735 }
737 /** Print a string to a stream, with escapes if necessary.
738 *
739 * @param io stream to print to
740 * @param obj string
741 * @param flags print flags
742 * @return number of bytes written
743 */
744 int string_print(IOStream *io, Sxpr obj, unsigned flags){
745 return _string_print(io,
746 OBJ_STRING(obj)->data,
747 OBJ_STRING(obj)->len,
748 flags);
749 }
751 int string_eq(char *s, int s_n, char *t, int t_n){
752 return (s_n == t_n) && (memcmp(s, t, s_n) == 0);
753 }
755 /** Compare an sxpr with a string for equality.
756 *
757 * @param x string to compare with
758 * @param y sxpr to compare
759 * @return 1 if equal, 0 otherwise
760 */
761 int string_equal(Sxpr x, Sxpr y){
762 int ok = 0;
763 ok = eq(x,y);
764 if(ok) goto exit;
765 ok = has_type(y, T_STRING) &&
766 string_eq(OBJ_STRING(x)->data, OBJ_STRING(x)->len,
767 OBJ_STRING(y)->data, OBJ_STRING(y)->len);
768 if(ok) goto exit;
769 ok = has_type(y, T_ATOM) &&
770 string_eq(OBJ_STRING(x)->data, OBJ_STRING(x)->len,
771 atom_name(y), atom_length(y));
772 exit:
773 return ok;
774 }
776 /** Create a new cons cell.
777 * The cell is ONOMEM if either argument is.
778 *
779 * @param car sxpr for the car
780 * @param cdr sxpr for the cdr
781 * @return new cons
782 */
783 Sxpr cons_new(Sxpr car, Sxpr cdr){
784 Sxpr obj;
785 if(NOMEMP(car) || NOMEMP(cdr)){
786 obj = ONOMEM;
787 } else {
788 obj = HALLOC(ObjCons, T_CONS);
789 if(!NOMEMP(obj)){
790 ObjCons *z = OBJ_CONS(obj);
791 z->car = car;
792 z->cdr = cdr;
793 }
794 }
795 return obj;
796 }
798 /** Push a new element onto a list.
799 *
800 * @param list list to add to
801 * @param elt element to add
802 * @return 0 if successful, error code otherwise
803 */
804 int cons_push(Sxpr *list, Sxpr elt){
805 Sxpr l;
806 l = cons_new(elt, *list);
807 if(NOMEMP(l)) return -ENOMEM;
808 *list = l;
809 return 0;
810 }
812 /** Free a cons. Recursively frees the car and cdr.
813 *
814 * @param obj to free
815 */
816 void cons_free(Sxpr obj){
817 Sxpr next;
818 for(; CONSP(obj); obj = next){
819 next = CDR(obj);
820 objfree(CAR(obj));
821 hfree(obj);
822 }
823 if(!NULLP(obj)){
824 objfree(obj);
825 }
826 }
828 /** Copy a cons. Recursively copies the car and cdr.
829 *
830 * @param obj to copy
831 */
832 Sxpr cons_copy(Sxpr obj){
833 Sxpr v = ONULL;
834 Sxpr l = ONULL, x = ONONE;
835 for(l = obj; CONSP(l); l = CDR(l)){
836 x = objcopy(CAR(l));
837 if(NOMEMP(x)) goto exit;
838 x = cons_new(x, v);
839 if(NOMEMP(x)) goto exit;
840 v = x;
841 }
842 v = nrev(v);
843 exit:
844 if(NOMEMP(x)){
845 objfree(v);
846 v = ONOMEM;
847 }
848 return v;
849 }
851 /** Free a cons and its cdr cells, but not the car sxprs.
852 * Does nothing if called on something that is not a cons.
853 *
854 * @param obj to free
855 */
856 void cons_free_cells(Sxpr obj){
857 Sxpr next;
858 for(; CONSP(obj); obj = next){
859 next = CDR(obj);
860 hfree(obj);
861 }
862 }
864 /** Print a cons.
865 * Prints the cons in list format if the cdrs are conses.
866 * uses pair (dot) format if the last cdr is not a cons (or null).
867 *
868 * @param io stream to print to
869 * @param obj to print
870 * @param flags print flags
871 * @return number of bytes written
872 */
873 int cons_print(IOStream *io, Sxpr obj, unsigned flags){
874 int first = 1;
875 int k = 0;
876 k += IOStream_print(io, "(");
877 for( ; CONSP(obj) ; obj = CDR(obj)){
878 if(first){
879 first = 0;
880 } else {
881 k += IOStream_print(io, " ");
882 }
883 k += objprint(io, CAR(obj), flags);
884 }
885 if(!NULLP(obj)){
886 k += IOStream_print(io, " . ");
887 k += objprint(io, obj, flags);
888 }
889 k += IOStream_print(io, ")");
890 return (IOStream_error(io) ? -1 : k);
891 }
893 /** Compare a cons with another sxpr for equality.
894 * If y is a cons, compares the cars and cdrs recursively.
895 *
896 * @param x cons to compare
897 * @param y sxpr to compare
898 * @return 1 if equal, 0 otherwise
899 */
900 int cons_equal(Sxpr x, Sxpr y){
901 return CONSP(y) &&
902 objequal(CAR(x), CAR(y)) &&
903 objequal(CDR(x), CDR(y));
904 }
906 /** Return the length of a cons list.
907 *
908 * @param obj list
909 * @return length
910 */
911 int cons_length(Sxpr obj){
912 int count = 0;
913 for( ; CONSP(obj); obj = CDR(obj)){
914 count++;
915 }
916 return count;
917 }
919 /** Destructively reverse a cons list in-place.
920 * If the argument is not a cons it is returned unchanged.
921 *
922 * @param l to reverse
923 * @return reversed list
924 */
925 Sxpr nrev(Sxpr l){
926 if(CONSP(l)){
927 // Iterate down the cells in the list making the cdr of
928 // each cell point to the previous cell. The last cell
929 // is the head of the reversed list.
930 Sxpr prev = ONULL;
931 Sxpr cell = l;
932 Sxpr next;
934 while(1){
935 next = CDR(cell);
936 CDR(cell) = prev;
937 if(!CONSP(next)) break;
938 prev = cell;
939 cell = next;
940 }
941 l = cell;
942 }
943 return l;
944 }
946 /** Print the null sxpr.
947 *
948 * @param io stream to print to
949 * @param obj to print
950 * @param flags print flags
951 * @return number of bytes written
952 */
953 static int null_print(IOStream *io, Sxpr obj, unsigned flags){
954 return IOStream_print(io, "()");
955 }
957 /** Print the `unspecified' sxpr none.
958 *
959 * @param io stream to print to
960 * @param obj to print
961 * @param flags print flags
962 * @return number of bytes written
963 */
964 static int none_print(IOStream *io, Sxpr obj, unsigned flags){
965 return IOStream_print(io, "<none>");
966 }
968 /** Print an integer.
969 *
970 * @param io stream to print to
971 * @param obj to print
972 * @param flags print flags
973 * @return number of bytes written
974 */
975 static int int_print(IOStream *io, Sxpr obj, unsigned flags){
976 return IOStream_print(io, "%d", OBJ_INT(obj));
977 }
979 /** Print a boolean.
980 *
981 * @param io stream to print to
982 * @param obj to print
983 * @param flags print flags
984 * @return number of bytes written
985 */
986 static int bool_print(IOStream *io, Sxpr obj, unsigned flags){
987 return IOStream_print(io, (OBJ_UINT(obj) ? k_true : k_false));
988 }
990 /** Print an error.
991 *
992 * @param io stream to print to
993 * @param obj to print
994 * @param flags print flags
995 * @return number of bytes written
996 */
997 static int err_print(IOStream *io, Sxpr obj, unsigned flags){
998 int err = OBJ_INT(obj);
999 if(err < 0) err = -err;
1000 return IOStream_print(io, "[error:%d:%s]", err, strerror(err));
1003 /** Print the 'nomem' sxpr.
1005 * @param io stream to print to
1006 * @param obj to print
1007 * @param flags print flags
1008 * @return number of bytes written
1009 */
1010 static int nomem_print(IOStream *io, Sxpr obj, unsigned flags){
1011 return IOStream_print(io, "[ENOMEM]");
1014 int sxprp(Sxpr obj, Sxpr name){
1015 return CONSP(obj) && objequal(CAR(obj), name);
1018 /** Get the name of an element.
1020 * @param obj element
1021 * @return name
1022 */
1023 Sxpr sxpr_name(Sxpr obj){
1024 Sxpr val = ONONE;
1025 if(CONSP(obj)){
1026 val = CAR(obj);
1027 } else if(STRINGP(obj) || ATOMP(obj)){
1028 val = obj;
1030 return val;
1033 int sxpr_is(Sxpr obj, char *s){
1034 if(ATOMP(obj)) return string_eq(atom_name(obj), atom_length(obj), s, strlen(s));
1035 if(STRINGP(obj)) return string_eq(string_string(obj), string_length(obj), s, strlen(s));
1036 return 0;
1039 int sxpr_elementp(Sxpr obj, Sxpr name){
1040 int ok = 0;
1041 ok = CONSP(obj) && objequal(CAR(obj), name);
1042 return ok;
1045 /** Get the attributes of an sxpr.
1047 * @param obj sxpr
1048 * @return attributes
1049 */
1050 Sxpr sxpr_attributes(Sxpr obj){
1051 Sxpr val = ONULL;
1052 if(CONSP(obj)){
1053 obj = CDR(obj);
1054 if(CONSP(obj)){
1055 obj = CAR(obj);
1056 if(sxprp(obj, intern("@"))){
1057 val = CDR(obj);
1061 return val;
1064 Sxpr sxpr_attribute(Sxpr obj, Sxpr key, Sxpr def){
1065 Sxpr val = ONONE;
1066 val = assoc(sxpr_attributes(obj), key);
1067 if(CONSP(val) && CONSP(CDR(val))){
1068 val = CADR(def);
1069 } else {
1070 val = def;
1072 return val;
1075 /** Get the children of an sxpr.
1077 * @param obj sxpr
1078 * @return children
1079 */
1080 Sxpr sxpr_children(Sxpr obj){
1081 Sxpr val = ONULL;
1082 if(CONSP(obj)){
1083 val = CDR(obj);
1084 if(CONSP(val) && sxprp(CAR(val), intern("@"))){
1085 val = CDR(val);
1088 return val;
1091 Sxpr sxpr_child(Sxpr obj, Sxpr name, Sxpr def){
1092 Sxpr val = ONONE;
1093 Sxpr l;
1094 for(l = sxpr_children(obj); CONSP(l); l = CDR(l)){
1095 if(sxprp(CAR(l), name)){
1096 val = CAR(l);
1097 break;
1100 if(NONEP(val)) val = def;
1101 return val;
1104 Sxpr sxpr_child0(Sxpr obj, Sxpr def){
1105 Sxpr val = ONONE;
1106 Sxpr l = sxpr_children(obj);
1107 if(CONSP(l)){
1108 val = CAR(l);
1109 } else {
1110 val = def;
1112 return val;
1115 Sxpr sxpr_childN(Sxpr obj, int n, Sxpr def){
1116 Sxpr val = def;
1117 Sxpr l;
1118 int i;
1119 for (i = 0, l = sxpr_children(obj); CONSP(l); i++, l = CDR(l)){
1120 if(i == n){
1121 val = CAR(l);
1122 break;
1125 return val;
1128 Sxpr sxpr_child_value(Sxpr obj, Sxpr name, Sxpr def){
1129 Sxpr val = ONONE;
1130 val = sxpr_child(obj, name, ONONE);
1131 if(NONEP(val)){
1132 val = def;
1133 } else {
1134 val = sxpr_child0(val, def);
1136 return val;
1139 /** Table of interned symbols. Indexed by symbol name. */
1140 static HashTable *symbols = NULL;
1142 /** Hash function for entries in the symbol table.
1144 * @param key to hash
1145 * @return hashcode
1146 */
1147 static Hashcode sym_hash_fn(void *key){
1148 return hash_string((char*)key);
1151 /** Key equality function for the symbol table.
1153 * @param x to compare
1154 * @param y to compare
1155 * @return 1 if equal, 0 otherwise
1156 */
1157 static int sym_equal_fn(void *x, void *y){
1158 return !strcmp((char*)x, (char*)y);
1161 /** Entry free function for the symbol table.
1163 * @param table the entry is in
1164 * @param entry being freed
1165 */
1166 static void sym_free_fn(HashTable *table, HTEntry *entry){
1167 if(entry){
1168 objfree(((ObjAtom*)entry->value)->name);
1169 HTEntry_free(entry);
1173 /** Initialize the symbol table.
1175 * @return 0 on sucess, error code otherwise
1176 */
1177 static int init_symbols(void){
1178 symbols = HashTable_new(100);
1179 if(symbols){
1180 symbols->key_hash_fn = sym_hash_fn;
1181 symbols->key_equal_fn = sym_equal_fn;
1182 symbols->entry_free_fn = sym_free_fn;
1183 return 0;
1185 return -1;
1188 /** Cleanup the symbol table. Frees the table and all its symbols.
1189 */
1190 void cleanup_symbols(void){
1191 HashTable_free(symbols);
1192 symbols = NULL;
1195 /** Get the interned symbol with the given name.
1196 * No new symbol is created.
1198 * @return symbol or null
1199 */
1200 Sxpr get_symbol(char *sym){
1201 HTEntry *entry;
1202 if(!symbols){
1203 if(init_symbols()) return ONOMEM;
1204 return ONULL;
1206 entry = HashTable_get_entry(symbols, sym);
1207 if(entry){
1208 return OBJP(T_ATOM, entry->value);
1209 } else {
1210 return ONULL;
1214 /** Get the interned symbol with the given name.
1215 * Creates a new symbol if necessary.
1217 * @return symbol
1218 */
1219 Sxpr intern(char *sym){
1220 Sxpr symbol = get_symbol(sym);
1221 if(NULLP(symbol)){
1222 if(!symbols) return ONOMEM;
1223 symbol = atom_new(sym);
1224 if(!NOMEMP(symbol)){
1225 OBJ_ATOM(symbol)->interned = TRUE;
1226 HashTable_add(symbols, atom_name(symbol), get_ptr(symbol));
1229 return symbol;