static void init() { object_new_count = 0; object_free_count = 0; object_true = symbol_intern("#t"); symbol_parent_env = symbol_intern("__parent_env__"); symbol_quote = symbol_intern("quote"); builtin_core_init(&global_env); builtin_math_init(&global_env); }
static void pf_the_page (PFunArgs) { char *varname = mhtml_evaluate_string (get_positional_arg (vars, 0)); PAGE *the_page = parser_top_page (); if (empty_string_p (varname)) { PAGE *contents = page_copy_page (the_page); bprintf_insert (page, start, "%s", contents->buffer); *newstart += contents->bindex; page_free_page (contents); } else { Symbol *sym = symbol_remove (varname); Datablock *block; symbol_free (sym); sym = symbol_intern (varname); block = datablock_create (the_page->buffer, the_page->bindex); sym->type = symtype_BINARY; sym->values = (char **)block; } xfree (varname); }
void slang_open(obj_t *env) { static bool_t inited = 0; if (inited) return; else inited = 1; obj_t *binding; langdef_t *iter; gc_set_enabled(0); for (iter = specforms; iter->name; ++iter) { environ_bind(NULL, env, symbol_intern(NULL, iter->name), specform_wrap(NULL, iter->call)); } symbol_quasiquote = symbol_intern(NULL, "quasiquote"); symbol_unquote = symbol_intern(NULL, "unquote"); symbol_unquote_splicing = symbol_intern(NULL, "unquote-splicing"); gc_set_enabled(1); }
void telephony_init() { telephony_vt = (vtable*)send(object_vt, s_delegated); // TODO - inherit from VillageBus ? send(telephony_vt, s_addMethod, s_print, telephony_print); send(telephony_vt, s_addMethod, s_villagebus_evaluate, telephony_evaluate); _Telephony = send(telephony_vt, s_allocate, 0); // register local symbols s_telephony_sip = (symbol*)symbol_intern(0, _Telephony, L"sip"); s_telephony_callme = (symbol*)symbol_intern(0, _Telephony, L"callme"); send(telephony_vt, s_addMethod, s_telephony_sip, telephony_sip_asterisk); send(telephony_vt, s_addMethod, s_telephony_callme, telephony_callme); // global module instance vars Telephony = (telephony*)send(_Telephony->_vt[-1], s_allocate, sizeof(telephony)); // register module with VillageBus s_telephony = (symbol*)symbol_intern(0, 0, L"telephony"); fexp* module = (fexp*)send(Fexp, s_new, s_telephony, Telephony); VillageBus->modules = (fexp*)send(VillageBus->modules, s_fexp_cons, module); }
void builtin_math_init(pobject *env) { cons_assoc_set(env, symbol_intern("*pi*"), gc_add(number_new(M_PI)), 1); cons_assoc_set(env, symbol_intern("+"), gc_add(cfunc_new(plus)), 1); cons_assoc_set(env, symbol_intern("-"), gc_add(cfunc_new(minus)), 1); cons_assoc_set(env, symbol_intern("*"), gc_add(cfunc_new(mult)), 1); cons_assoc_set(env, symbol_intern("/"), gc_add(cfunc_new(div)), 1); cons_assoc_set(env, symbol_intern("mod"), gc_add(cfunc_new(mod)), 1); }
void db_init() { db_vt = (vtable*)send(object_vt, s_delegated); // TODO - inherit from VillageBus ? send(db_vt, s_addMethod, s_print, db_print); send(db_vt, s_addMethod, s_villagebus_evaluate, db_evaluate); _DB = send(db_vt, s_allocate, 0); // register local symbols s_db_connect = symbol_intern(0, _DB, L"connect"); s_db_close = symbol_intern(0, _DB, L"close"); s_db_keys = (symbol*)symbol_intern(0, _DB, L"keys"); // TODO - symbol_intern should return symbol* s_db_get = symbol_intern(0, _DB, L"get"); s_db_lrange = symbol_intern(0, _DB, L"lrange"); s_db_getset = symbol_intern(0, _DB, L"set"); s_db_lpush = symbol_intern(0, _DB, L"lpush"); s_db_incr = symbol_intern(0, _DB, L"incr"); s_db_set = symbol_intern(0, _DB, L"_set"); // TODO - don't alias getset to set s_db_sadd = symbol_intern(0, _DB, L"sadd"); s_db_del = symbol_intern(0, _DB, L"del"); send(db_vt, s_addMethod, s_db_connect, db_connect); send(db_vt, s_addMethod, s_db_close, db_close); send(db_vt, s_addMethod, s_db_keys, db_keys); send(db_vt, s_addMethod, s_db_get, db_get); send(db_vt, s_addMethod, s_db_lrange, db_lrange); send(db_vt, s_addMethod, s_db_getset, db_getset); send(db_vt, s_addMethod, s_db_lpush, db_lpush); send(db_vt, s_addMethod, s_db_incr, db_incr); send(db_vt, s_addMethod, s_db_set, db_set); send(db_vt, s_addMethod, s_db_sadd, db_sadd); send(db_vt, s_addMethod, s_db_del, db_del); // global module instance vars DB = (db*)send(_DB->_vt[-1], s_allocate, sizeof(db)); DB->handle = NULL; DB->delimiter = (string*)send(String, s_new, L":", 1); // delimiter used for composing redis key names // register module with VillageBus - TODO lose vb->modules & register directly in vtable perhaps? s_db = symbol_intern(0, 0, L"db"); fexp* module = (fexp*)send(Fexp, s_new, s_db, DB); VillageBus->modules = (fexp*)send(VillageBus->modules, s_fexp_cons, module); }
/* Read the input data from all of the available sources. This means the environment variables PATH_INFO and QUERY_STRING, the contents of standard input, if there is any, and the arguments passed into the CGI program. Nothing is returned, the symbols and values are simply interned. The program arguments are returned in the item PROGRAM-ARGUMENTS. */ void forms_input_data (int argc, char *argv[]) { register int i; int content_length = 0; char *env_item; char *data_string = (char *)NULL; int data_string_size = 0, data_string_index = 0; Symbol *symbol; Package *package; posted_variables = symbol_get_package ("POSTED"); /* First, get the program arguments if there are any. */ if (argc != 1) { symbol = symbol_intern ("PROGRAM-ARGUMENTS"); symbol->values = (char **)xmalloc (argc * sizeof (char *)); symbol->values_slots = argc; symbol->values_index = 0; for (i = 1; i < argc; i++) symbol->values[symbol->values_index++] = strdup (argv[i]); symbol->values[symbol->values_index] = (char *)NULL; } /* Now get all of the environment variables. */ package = symbol_get_package ("ENV"); for (i = 0; environ != (char **)NULL && environ[i] != (char *)NULL; i++) { char *name, *value; name = strdup (environ[i]); value = strchr (name, '='); if (value) { *value = '\0'; value++; value = strdup (value); } symbol = symbol_intern_in_package (package, name); if (value) { symbol->values = (char **)xmalloc ((symbol->values_slots = 2) * sizeof (char *)); symbol->values[0] = value; symbol->values[1] = (char *)NULL; symbol->values_index = 1; } free (name); } /* If there is any input available from standard input, then read it now. */ if (((env_item = getenv ("CONTENT_LENGTH")) != (char *)NULL) && ((content_length = atoi (env_item)) != 0)) { int offset = 0; data_string = (char *)xmalloc (1 + (data_string_size = content_length)); while (content_length != 0) { int amount_read = read (fileno (stdin), data_string + offset, content_length); if (amount_read == -1) abort (); content_length -= amount_read; offset += amount_read; } data_string[offset] = '\0'; data_string_index = offset; } /* If any input is coming from QUERY_STRING or PATH_INFO, get it now. */ { char *names[3] = { "QUERY_STRING", "PATH_INFO", (char *)NULL }; for (i = 0; names[i]; i++) { if (((env_item = getenv (names[i])) != (char *)NULL) && (*env_item != '\0')) { int max_len; if ((strcmp (names[i], "PATH_INFO") == 0) && *env_item == '/') env_item++; max_len = data_string_index + strlen (env_item) + 3; if (max_len > data_string_size) data_string = (char *)xrealloc (data_string, (data_string_size = max_len)); if (data_string_index != 0) data_string[data_string_index++] = '&'; strcpy (data_string + data_string_index, env_item); data_string_index += strlen (env_item); data_string[data_string_index] = '\0'; } } } /* DATA_STRING may contain any number of name/value pairs, including none. If there are any, intern them now. */ if (data_string) { package = posted_variables; forms_parse_data_string (data_string, package); /* Copy the parsed symbols into the default package. */ { Package *default_pack = symbol_get_package_hash (DEFAULT_PACKAGE_NAME, 577); Symbol **symbols = symbol_package_symbols ("POSTED"); if (symbols != (Symbol **)NULL) { for (i = 0; symbols[i] != (Symbol *)NULL; i++) symbol_copy (symbols[i], default_pack); } } free (data_string); } }
void forms_set_tag_value_in_package (Package *package, char *tag, char *value) { register int i, j; char *name = tag; int value_index = 0; int arrayify = 0; Symbol *symbol; /* Does this variable ref contain an array indicator? */ for (i = 0; tag[i] != '\0'; i++) if (tag[i] == '[') { /* Find out if this is a real array reference. */ #if MUST_BE_DIGITS for (j = i + 1; isdigit (tag[j]); j++); if (tag[j] == ']') { if (j == i + 1) arrayify = 1; else value_index = atoi (tag + i + 1); name = strdup (tag); name[i] = '\0'; } #else /* !MUST_BE_DIGITS */ int all_digits = 1; for (j = i + 1; tag[j] != '\0' && tag[j] != ']'; j++) if (!isdigit (tag[j])) all_digits = 0; if (tag[j] == ']') { if (j == i + 1) arrayify = 1; else { if (all_digits) value_index = atoi (tag + i + 1); else { char *tv, *nv; j--; tv = (char *)xmalloc (1 + (j - i)); strncpy (tv, tag + i + 1, j - i); tv[j - i] = '\0'; nv = forms_get_tag_value (tv); if (nv) value_index = atoi (nv); free (tv); } } name = strdup (tag); name[i] = '\0'; } #endif /* !MUST_BE_DIGITS */ break; } /* Get the symbol for this name. */ if (package == (Package *)NULL) symbol = symbol_intern (name); else symbol = symbol_intern_in_package (package, name); /* If this symbol is readonly, then we cannot manipulate it. */ if (!symbol_get_flag (symbol, sym_READONLY)) { /* If this symbol is not of type STRING, then delete it. */ if (symbol->type != symtype_STRING) { Symbol *r = symbol_remove_in_package (symbol->package, symbol->name); symbol_free (r); if (package == (Package *)NULL) symbol = symbol_intern (name); else symbol = symbol_intern_in_package (package, name); } /* If the value is empty, then add it as the empty string. */ if (value == (char *)NULL) value = ""; if (symbol->notifier) *(symbol->notifier) = 1; /* If the index to store at is larger than the number of items in the list, then make a bunch of blank items to fill in the space. */ if (value_index >= symbol->values_index) { symbol->values = (char **)xrealloc (symbol->values, (symbol->values_slots = 2 + value_index) * sizeof (char *)); while (symbol->values_index <= value_index) symbol->values[symbol->values_index++] = strdup (""); symbol->values[symbol->values_index] = (char *)NULL; } /* Store the value. If we are supposed to arrayify this variable, do it now. */ if (arrayify) { char **values = (char **)NULL; int values_index = 0; int values_slots = 0; int start = 0; while (value[start]) { /* Skip all whitespace between items. */ for (i = start; whitespace (value[i]); i++); start = i; if (value[i] == '\0') break; for (; value[i] != '\0' && value[i] != '\n'; i++); if (values_index + 2 > values_slots) values = (char **)xrealloc (values, (values_slots += 10) * sizeof (char *)); values[values_index] = (char *)xmalloc (1 + (i - start)); strncpy (values[values_index], value + start, i - start); values[values_index][i - start] = '\0'; values_index++; values[values_index] = (char *)NULL; start = i; } free_array (symbol->values); symbol->values = values; symbol->values_index = values_index; symbol->values_slots = values_slots; } else { if (value_index > -1) { free (symbol->values[value_index]); symbol->values[value_index] = strdup (value); } } symbol_set_modified (symbol); } if (name != tag) free (name); }
void builtin_core_init(pobject *env) { cons_assoc_set(env, symbol_intern("nil"), NIL, 1); cons_assoc_set(env, symbol_intern("#t"), object_true, 1); cons_assoc_set(env, symbol_intern("#f"), NIL, 1); cons_assoc_set(env, symbol_intern("quote"), gc_add(cfunc_new(quote)), 1); cons_assoc_set(env, symbol_intern("print"), gc_add(cfunc_new(builtin_print)), 1); cons_assoc_set(env, symbol_intern("println"), gc_add(cfunc_new(builtin_println)), 1); cons_assoc_set(env, symbol_intern("begin"), gc_add(cfunc_new(begin)), 1); cons_assoc_set(env, symbol_intern("cond"), gc_add(cfunc_new(cond)), 1); cons_assoc_set(env, symbol_intern("set!"), gc_add(cfunc_new(set)), 1); cons_assoc_set(env, symbol_intern("define"), gc_add(cfunc_new(define)), 1); cons_assoc_set(env, symbol_intern("defmacro"), gc_add(cfunc_new(defmacro)), 1); cons_assoc_set(env, symbol_intern("macro-expand"), gc_add(cfunc_new(builtin_macro_expand)), 1); cons_assoc_set(env, symbol_intern("lambda"), gc_add(cfunc_new(lambda)), 1); cons_assoc_set(env, symbol_intern("macro"), gc_add(cfunc_new(macro)), 1); cons_assoc_set(env, symbol_intern("apply"), gc_add(cfunc_new(apply)), 1); cons_assoc_set(env, symbol_intern("car"), gc_add(cfunc_new(car)), 1); cons_assoc_set(env, symbol_intern("cdr"), gc_add(cfunc_new(cdr)), 1); cons_assoc_set(env, symbol_intern("cons"), gc_add(cfunc_new(cons)), 1); cons_assoc_set(env, symbol_intern("collect"), gc_add(cfunc_new(collect)), 1); cons_assoc_set(env, symbol_intern("="), gc_add(cfunc_new(equal)), 1); cons_assoc_set(env, symbol_intern(">"), gc_add(cfunc_new(gt)), 1); }
static void parse_program_args (int argc, char *argv[]) { int arg_index = 1; char *filename = (char *)NULL; Symbol *program_args = symbol_intern ("mhtml::program-arguments"); progname = argv[0]; pagefunc_set_variable ("mhc::mhc-executatble", progname); /* Remember the argv array in a symbol reserved for that purpose. */ { register int i; Symbol *s = symbol_intern ("mhc::argv"); for (i = 0; i < argc; i++) symbol_add_value (s, argv[i]); } while (arg_index < argc) { char *arg = argv[arg_index++]; if (strcasecmp (arg, "--version") == 0) { fprintf (stdout, "%s\n", mhtml_version_string); if (arg_index + 1 >= argc) exit (0); } else if ((strcasecmp (arg, "--set") == 0) && (arg_index + 1 < argc)) { char *name = argv[arg_index++]; char *value = argv[arg_index++]; pagefunc_set_variable (name, value); } else if (!filename && (strcmp (arg, "-z") == 0)) call_bootstrap = 0; else if (!filename && (strcmp (arg, "--config") == 0)) { char *config_file = argv[arg_index]; if (config_file == (char *)NULL) usage (); else { config_page = page_read_template (config_file); arg_index++; } } else if (!filename && (*arg != '-')) { filename = arg; symbol_add_value (program_args, filename); pagefunc_set_variable ("mhc::script-name", filename); } else if (filename) symbol_add_value (program_args, arg); else usage (); } if (!filename) { char thisdir[1120]; if (getcwd (thisdir, 1023) < 0) sprintf (thisdir, "."); strcat (thisdir, "/*standard-input*"); filename = strdup (thisdir); if (isatty (fileno (stdin))) usage (); else { PAGE *page = page_create_page (); char buffer[1024]; int done = 0; register int i; while (!done) { for (i = 0; i < 1024; i++) buffer[i] = '\0'; fread (buffer, 1023, 1, stdin); bprintf (page, "%s", buffer); if (feof (stdin)) done = 1; } input_contents = page; } } else input_contents = page_read_template (filename); { char *temp = pagefunc_get_variable ("mhtml::include-prefix"); if (empty_string_p (temp)) { temp = strrchr (filename, '/'); if (temp != (char *)NULL) { *temp = '\0'; pagefunc_set_variable ("mhtml::include-prefix", filename); } else { char dir[1024]; temp = getcwd (dir, sizeof (dir)); if (temp != (char *)NULL) pagefunc_set_variable ("mhtml::include-prefix", dir); else pagefunc_set_variable ("mhtml::include-prefix", "/"); } } } }
static void require_remember_pathname (char *pathname) { Symbol *sym = symbol_intern (REQUIRE_LOADED); symbol_add_value (sym, pathname); }