int test_eval()
{
symbol *sa = new_symbol("a");
symbol *sb = new_symbol("b");
symbol *sc = new_symbol("c");
symbol *plus = new_symbol("+");
prim_proc *proc = new_prim_proc(proc_plus_integer);
integer *i10 = new_integer(10);
integer *i20 = new_integer(20);
integer *i30 = new_integer(30);
integer *i60 = new_integer(60);
list *vara = cons(sa, cons(sb, cons(sc, NULL)));
list *val10 = cons(i10, cons(i20, cons(i30, NULL)));
list *plus_i = cons(plus, val10);
environment *env = NULL;
env = extend_env(vara, val10, env);
assert(generic_equal(eval(sa, env), i10));
assert(generic_equal(eval(i10, env), i10));
define_var_val(plus, proc, env);
assert(generic_equal(car(list_of_values(val10, env)), i10));
assert(generic_equal(eval(plus_i, env), i60));
return 1;
}
int test_list()
{
cell *c[3];
symbol *x = new_symbol("x");
symbol *y = new_symbol("y");
symbol *z = new_symbol("z");
integer *i = new_integer(10);
integer *j = new_integer(20);
list *l;
c[0] = cons(x, i);
c[1] = cons(x, i);
c[2] = cons(y, j);
l = cons(c[0], cons(c[1], cons(c[2], NULL)));
print_sexp(c[0]);
printf("\n");
print_sexp(c[1]);
printf("\n");
print_sexp(c[2]);
printf("\n");
print_sexp(l);
printf("\n");
assert(is_list(l));
assert(is_list(NULL));
assert(!is_list(c[0]));
assert(generic_equal(assoc(x, l), c[0]));
assert(generic_equal(assoc(y, l), c[2]));
assert(generic_equal(assoc(z, l), NULL));
return 1;
}
int test_cell()
{
cell *c[3];
symbol *x = new_symbol("x");
symbol *y = new_symbol("y");
integer *i = new_integer(10);
integer *j = new_integer(20);
c[0] = cons(x, i);
c[1] = cons(x, i);
c[2] = cons(y, j);
assert(equal_symbol(car(c[0]), car(c[1])));
assert(!equal_symbol(car(c[0]), car(c[2])));
assert(equal_integer(cdr(c[0]), cdr(c[1])));
assert(!equal_integer(cdr(c[0]), cdr(c[2])));
set_car(c[1], y);
assert(!equal_symbol(car(c[0]), car(c[1])));
assert(equal_symbol(car(c[1]), car(c[2])));
set_cdr(c[1], j);
assert(!equal_integer(cdr(c[0]), cdr(c[1])));
assert(equal_integer(cdr(c[1]), cdr(c[2])));
assert(!equal_cell(c[0], c[1]));
assert(equal_cell(c[1], c[2]));
return 1;
}
struct Symbol* primary_expression(struct PrimaryExpression* node, struct Symbol** orig_symbol)
{
switch (node->type) {
case 0:
*orig_symbol = name2symbol(node->identifier, 0);
return *orig_symbol;
case 1://INT
sprintf(buf, "%d", node->iValue);
*orig_symbol = new_symbol(buf, 0, 2, 1 << 4, 0, 2, 0);
return *orig_symbol;
case 2://char
sprintf(buf, "%d", (int)node->cValue);
*orig_symbol = new_symbol(buf, 0, 2, 1 << 2, 0, 2, 0);
return *orig_symbol;
case 3://f
sprintf(buf, "%f", node->fValue);
return new_symbol(buf, 0, 2, 1 << 6, 0, 2, 0);
case 4://d
sprintf(buf, "%lf", node->dValue);
*orig_symbol = new_symbol(buf, 0, 2, 1 << 7, 0, 2, 0);
return *orig_symbol;
case 5:
*orig_symbol = new_string(node->literal);
return *orig_symbol;
case 6:
*orig_symbol = expression_func(node->expression);
return *orig_symbol;
default:
return 0;
}
}
// Create a new struct for sym table
void new_type_table (astree *struct_node) {
if (struct_node == NULL || struct_node->children.empty()) return;
astree *struct_name = struct_node->children[0];
if (struct_name == NULL) return;
symbol *symbol_type = new_symbol(struct_name);
sym_insertion(&types, symbol_type, (string*)struct_name->clexinfo);
fprintf(oil_file, "struct s_%s {\n",struct_name->clexinfo->c_str()); // ic
symbol_table *field_table = new symbol_table();
// skip the first child in the loop
bool skip = true;
for (auto &i : struct_node->children) {
if (i->symbol == TOK_TYPEID && skip) {
skip = false;
continue;
}
if (i->children.empty()) return;
astree *field_name = i->children[0];
if (field_name == NULL) return;
symbol *field = new_symbol(i);
if (field == NULL) return;
field->attributes.set(ATTR_field);
sym_insertion(field_table, field, (string*)field_name->clexinfo);
fprintf(oil_file, "\t%s f_%s_%s;\n",
i->clexinfo->c_str(),
struct_name->clexinfo->c_str(),
field_name->clexinfo->c_str());
}
fprintf(oil_file, "};\n");
fields.push_back(field_table);
symbol_type->fields = field_table;
struct_node->checked = true;
struct_node->struct_entry = new symbol_entry(
(string*)struct_name->clexinfo, symbol_type);
}
static be_jse_symbol_t *i2c_read(void)
{
int8_t ret = -1;
int8_t result = -1;
uint8_t *data = NULL;
uint32_t len = 0;
uint32_t i = 0;
item_handle_t i2c_handle;
be_jse_symbol_t *arr = NULL;
be_jse_symbol_t *item = NULL;
be_jse_symbol_t *arg0 = NULL;
be_jse_symbol_t *arg1 = NULL;
i2c_dev_t *i2c_device = NULL;
be_jse_handle_function(0, &arg0, &arg1, NULL, NULL);
if (!arg0 || !symbol_is_int(arg0)) {
goto out;
}
i2c_handle.handle = get_symbol_value_int(arg0);
i2c_device = board_get_node_by_handle(MODULE_I2C, &i2c_handle);
if (NULL == i2c_device) {
be_error("i2c", "board_get_node_by_handle fail!\n");
goto out;
}
if (!arg1 || !symbol_is_int(arg1)) {
goto out;
}
len = get_symbol_value_int(arg1);
data = calloc(1, sizeof(uint8_t) * (len + 1));
if (NULL == data) {
goto out;
}
ret = hal_i2c_master_recv(i2c_device, i2c_device->config.dev_addr, data, len, I2C_TIMEOUT);
if (-1 == ret) {
be_error("i2c", "hal_i2c_master_recv fail!\n");
goto out;
}
arr = new_symbol(BE_SYM_ARRAY);
for (i = 0; i < len; ++i) {
be_jse_symbol_t *idx = new_int_symbol(data[i]);
symbol_array_push(arr, idx);
symbol_unlock(idx);
}
result = 0;
out:
symbol_unlock(arg0);
symbol_unlock(arg1);
if (NULL != data) {
free(data);
data = NULL;
}
return (0 == result) ? arr : new_symbol(BE_SYM_NULL);
}
struct Symbol* conditional_expression(struct ConditionalExpression* node)
{
struct Symbol* symbol = logical_or_expression(node->logicalOrExpression);
if (node->type == 0)
return symbol;
ADDSTRING(" br i1 ");
code_gen_symbol('%', symbol);
struct Symbol* label1 = new_symbol("", 0, 0, 0, 0, 0, 0);
ADDSTRING(", label ");
code_gen_symbol('%', label1);
ADDSTRING(", label ");
char *ch = g_ptr;
ADDSTRING(" ");
ADDSTRING("\n; <label>:");
code_gen_symbol(0, label1);
ADDSTRING("\n");
struct Symbol* symbol1 = load_symbol(expression_func(node->expression));
ADDSTRING(" br label ");
char *ch1 = g_ptr;
ADDSTRING(" ");
ADDSTRING("\n; <label>:");
struct Symbol* label2 = new_symbol("", 0, 0, 0, 0, 0, 0);
code_gen_symbol(0, label2);
ADDSTRING("\n");
struct Symbol* symbol2 = load_symbol(expression_func(node->expression));
ADDSTRING(" br label ");
struct Symbol* label3 = new_symbol("", 0, 0, 0, 0, 0, 0);
code_gen_symbol('%', label3);
ADDSTRING("\n; <label>:");
code_gen_symbol(0, label3);
ADDSTRING("\n");
symbol = new_symbol("", symbol2->storage, symbol2->qualifier, symbol2->specifier, symbol2->stars, 0, symbol2->length);
code_gen_symbol('%', symbol);
ADDSTRING(" = phi ");
code_gen_type_specifier(symbol->specifier,0,symbol->length,symbol->stars);
ADDSTRING(" [ ");
code_gen_symbol('%', symbol1);
ADDSTRING(", ");
code_gen_symbol('%', label1);
ADDSTRING(" ], [ ");
code_gen_symbol('%', symbol2);
ADDSTRING(", ");
code_gen_symbol('%', label2);
ADDSTRING(" ]\n");
push_buffer(ch);
code_gen_symbol('%', label2);
*g_ptr = ' ';
pop_buffer();
push_buffer(ch1);
code_gen_symbol('%', label3);
*g_ptr = ' ';
pop_buffer();
return symbol;
}
void upc_sign_in_builtins(const decl_context_t* decl_context)
{
// THREADS
scope_entry_t* upc_THREADS;
upc_THREADS = new_symbol(decl_context, decl_context->global_scope, UNIQUESTR_LITERAL("THREADS"));
upc_THREADS->kind = SK_VARIABLE;
upc_THREADS->type_information = get_const_qualified_type(get_signed_int_type());
upc_THREADS->defined = 1;
upc_THREADS->do_not_print = 1;
upc_THREADS->locus = make_locus("(global scope)", 0, 0);
symbol_entity_specs_set_is_builtin(upc_THREADS, 1);
if (CURRENT_CONFIGURATION->upc_threads != NULL)
{
upc_THREADS->value = internal_expression_parse(CURRENT_CONFIGURATION->upc_threads, decl_context);
}
// MYTHREAD
scope_entry_t* upc_MYTHREAD;
upc_MYTHREAD = new_symbol(decl_context, decl_context->global_scope, UNIQUESTR_LITERAL("MYTHREAD"));
upc_MYTHREAD->kind = SK_VARIABLE;
upc_MYTHREAD->type_information = get_const_qualified_type(get_signed_int_type());
upc_MYTHREAD->defined = 1;
upc_MYTHREAD->do_not_print = 1;
upc_MYTHREAD->locus = make_locus("(global scope)", 0, 0);
symbol_entity_specs_set_is_builtin(upc_MYTHREAD, 1);
// UPC_MAX_BLOCK_SIZE
scope_entry_t* upc_UPC_MAX_BLOCK_SIZE;
upc_UPC_MAX_BLOCK_SIZE = new_symbol(decl_context, decl_context->global_scope, UNIQUESTR_LITERAL("UPC_MAX_BLOCK_SIZE"));
upc_UPC_MAX_BLOCK_SIZE->kind = SK_VARIABLE;
upc_UPC_MAX_BLOCK_SIZE->type_information = get_const_qualified_type(get_signed_int_type());
upc_UPC_MAX_BLOCK_SIZE->defined = 1;
upc_UPC_MAX_BLOCK_SIZE->do_not_print = 1;
upc_UPC_MAX_BLOCK_SIZE->locus = make_locus("(global scope)", 0, 0);
symbol_entity_specs_set_is_builtin(upc_UPC_MAX_BLOCK_SIZE, 1);
// upc_lock_t
scope_entry_t* upc_lock_t;
upc_lock_t = new_symbol(decl_context, decl_context->global_scope, UNIQUESTR_LITERAL("upc_lock_t"));
upc_lock_t->kind = SK_TYPEDEF;
upc_lock_t->defined = 1;
upc_lock_t->type_information = get_void_type();
upc_lock_t->do_not_print = 1;
upc_lock_t->locus = make_locus("(global scope)", 0, 0);
symbol_entity_specs_set_is_builtin(upc_lock_t, 1);
}
static void add_bfd(bfd *Bfd) {
if (bfd_check_format(Bfd, bfd_object)) {
bfd_info_t *BfdInfo = new(bfd_info_t);
BfdInfo->FileName = Bfd->filename;
memset(BfdInfo->LocalTable, 0, sizeof(BfdInfo->LocalTable));
BfdInfo->Symbols = (asymbol **)malloc(bfd_get_symtab_upper_bound(Bfd));
int NoOfSymbols = bfd_canonicalize_symtab(Bfd, BfdInfo->Symbols);
bfd_map_over_sections(Bfd, (bfd_map)add_bfd_section, BfdInfo);
for (int I = NoOfSymbols - 1; I >= 0; --I) {
asymbol *Sym = BfdInfo->Symbols[I];
if (Sym->flags & BSF_GLOBAL) {
const char *Name = strdup(Sym->name);
symbol_t *Symbol = new_symbol(Name, (section_t *)Sym->section->userdata, Sym->value);
stringtable_put(BfdInfo->LocalTable, Name, Symbol);
stringtable_put(GlobalTable, Name, Symbol);
} else if (Sym->section == bfd_com_section_ptr) {
symbol_t *Symbol = (symbol_t *)stringtable_get(GlobalTable, Sym->name);
bss_section_t *Section;
if (!Symbol) {
const char *Name = strdup(Sym->name);
Section = new_bss_section(0);
Symbol = new_symbol(Name, (section_t *)Section, 0);
stringtable_put(GlobalTable, Name, Symbol);
stringtable_put(BfdInfo->LocalTable, Name, Symbol);
} else {
Section = (bss_section_t *)Symbol->Section;
};
if (Sym->value > Section->Size) Section->Size = Sym->value;
} else if (Sym->flags & BSF_LOCAL) {
const char *Name = strdup(Sym->name);
symbol_t *Symbol = new_symbol(Name, (section_t *)Sym->section->userdata, Sym->value);
stringtable_put(BfdInfo->LocalTable, Name, Symbol);
} else if (Sym->flags & BSF_WEAK) {
const char *Name = strdup(Sym->name);
symbol_t *Symbol = new_symbol(Name, (section_t *)Sym->section->userdata, Sym->value);
stringtable_put(WeakTable, Name, Symbol);
} else if (Sym->section == bfd_und_section_ptr) {
} else if (Sym->flags & BSF_DEBUGGING) {
// This may be supported later
} else {
printf("%s: unknown symbol type: %8x.\n", Bfd->filename, Sym->flags);
exit(1);
};
};
} else if (bfd_check_format(Bfd, bfd_archive)) {
bfd *Bfd2 = 0;
while ((Bfd2 = bfd_openr_next_archived_file(Bfd, Bfd2))) add_bfd(Bfd2);
};
};
Token cleanup_func (Token s)
{
char tmp [512];
sprintf (tmp, "__attribute__ ((cleanup(%s)))",
expand (s));
return new_symbol (strdup (tmp));
}
/***************************************************************
alias ("func")
***************************************************************/
Token alias_func (recID r, Token f)
{
char tmp [512];
//xmark_function_USED (FSP (r), f);
sprintf (tmp, "__attribute__ ((alias (\"%s\")))", expand (f));
return new_symbol (strdup (tmp));
}
void process_extern()
{
SYM *sym;
NextToken();
if (token != tk_id)
printf("Expecting an identifier.\r\n");
else {
sym = find_symbol(lastid);
if (pass == 3) {
if (sym) {
}
else {
sym = new_symbol(lastid);
}
if (sym) {
sym->defined = 0;
sym->value = 0;
sym->segment = segment;
sym->scope = 'P';
sym->isExtern = 1;
}
}
else if (pass > 3) {
}
}
}
static void _export_token (Token t)
{
static Token lasttok;
static bool concatenation = false;
if (t == FINISH_CMD) {
if (lasttok) output_itoken (GLOBAL, lasttok);
} else if (t == CONCAT_CMD) {
if (concatenation) return;
if (!lasttok) return;
concatenation = true;
} else if (!ISSYMBOL (t) && !ISRESERVED (t) && !ISVALUE (t)) {
if (lasttok) output_itoken (GLOBAL, lasttok);
output_itoken (GLOBAL, t);
lasttok = 0;
concatenation = false;
} else if (!concatenation) {
if (lasttok) output_itoken (GLOBAL, lasttok);
lasttok = t;
} else {
char *tmp = (char*) alloca (strlen (expand (lasttok)) + strlen (expand (t)) + 1);
strcat (strcpy (tmp, expand (lasttok)), expand (t));
lasttok = new_symbol (strdup (tmp));
}
}
void
add_enum (symbol_t *enm, symbol_t *name, expr_t *val)
{
symbol_t *sym;
type_t *enum_type = enm->type;
symtab_t *enum_tab;
int value;
if (name->table == current_symtab)
error (0, "%s redefined", name->name);
if (name->table)
name = new_symbol (name->name);
name->sy_type = sy_const;
name->type = enum_type;
enum_tab = enum_type->t.symtab;
value = 0;
if (enum_tab->symbols)
value = ((symbol_t *)(enum_tab->symtail))->s.value->v.integer_val + 1;
if (val) {
if (!is_constant (val))
error (val, "non-constant initializer");
else if (!is_integer_val (val))
error (val, "invalid initializer type");
else
value = expr_integer (val);
}
name->s.value = new_integer_val (value);
symtab_addsymbol (enum_tab, name);
sym = new_symbol_type (name->name, name->type);
sym->sy_type = sy_const;
sym->s.value = name->s.value;
symtab_addsymbol (enum_tab->parent, sym);
}
void add_name( symbols* s, char* name, size_t size )
{
register int i;
if( s->max == 0 )
{
s->table = (symbol**)xmalloc( 16 * sizeof( symbol ) );
s->n = 16;
}
if ( ( s->n + 1 ) == s->max )
{
s->table = (symbol**)xrealloc( s->table, s->max + 32 );
s->n += 32;
}
for( i = 0; i < s->n; i++ )
{
if( ! strcmp( name, s->table[i]->name ) )
{
fprintf( stderr, "Symbol %s already defined!", name );
return;
}
}
s->table[ s->n++ ] = new_symbol( name, size );
}
int test_symbol()
{
symbol *s[3];
char *hello = "hello";
char *world = "world";
s[0] = new_symbol(hello);
s[1] = new_symbol(hello);
s[2] = new_symbol(world);
assert(equal_symbol(s[0], s[1]));
assert(!equal_symbol(s[0], s[2]));
assert(is_symbol(s[0]));
assert(strcmp(sym_to_string(s[0]), hello) == 0);
assert(strcmp(sym_to_string(s[0]), world) != 0);
return 1;
}
int test_quote()
{
symbol *sa = new_symbol("a");
symbol *sb = new_symbol("b");
symbol *sc = new_symbol("c");
list *va = cons(sa, cons(sb, cons(sc, NULL)));
environment *env = new_env();
list *ql = syntax_quote(va, env);
assert(generic_equal(car(ql), sa));
assert(generic_equal(car(cdr(ql)), sb));
assert(generic_equal(car(cdr(cdr(ql))), sc));
return 1;
}
static scope_entry_t* new_implicit_symbol(decl_context_t decl_context, AST locus, const char* name)
{
// Special names for operators and other non regularly named stuff will not get here
if (('a' <= tolower(name[0]))
&& (tolower(name[0]) <= 'z'))
{
type_t* implicit_type =
(*(decl_context.implicit_info->data->implicit_letter_set))[tolower(name[0]) - 'a'];
if (implicit_type == NULL)
return NULL;
scope_entry_t* sym = new_symbol(decl_context, decl_context.current_scope, strtolower(name));
sym->kind = SK_VARIABLE;
sym->type_information = implicit_type;
sym->entity_specs.is_implicit_basic_type = 1;
if (locus != NULL)
{
sym->file = ASTFileName(locus);
sym->line = ASTLine(locus);
}
return sym;
}
return NULL;
}
static symbol_t *
find_tag (ty_meta_e meta, symbol_t *tag, type_t *type)
{
const char *tag_name;
symbol_t *sym;
if (tag) {
tag_name = va ("tag %s", tag->name);
} else {
const char *path = GETSTR (pr.source_file);
const char *file = strrchr (path, '/');
if (!file++)
file = path;
tag_name = va ("tag .%s.%d", file, pr.source_line);
}
sym = symtab_lookup (current_symtab, tag_name);
if (sym) {
if (sym->table == current_symtab && sym->type->meta != meta)
error (0, "%s defined as wrong kind of tag", tag->name);
if (sym->type->meta == meta)
return sym;
}
sym = new_symbol (tag_name);
if (!type)
type = new_type ();
if (!type->name)
type->name = sym->name;
sym->type = type;
sym->type->type = ev_invalid;
sym->type->meta = meta;
sym->sy_type = sy_type;
return sym;
}
leaf_t new_symbol_leaf(const char* symbol)
{
leaf_t self = new_leaf();
self->leaf = new_symbol(symbol);
self->render = _render;
self->free_leaf = _free_symbol_leaf;
return self;
}
Self & operator<<(Symbol symbol) {
InternalSymbol internal_symbol = to_internal(symbol);
if (location[internal_symbol] == nullptr) {
new_symbol(internal_symbol);
}
increse_weight(location[internal_symbol]);
return *this;
}
cell_t *secd_type_sym(secd_t *secd, const cell_t *cell) {
const char *type = "unknown";
enum cell_type t = cell_type(cell);
assert(t <= CELL_ERROR, "secd_type_sym: type is invalid");
type = secd_type_names[t];
assert(type, "secd_type_names: unknown type of %d", t);
return new_symbol(secd, type);
}
symbol_t *
new_symbol_type (const char *name, type_t *type)
{
symbol_t *symbol;
symbol = new_symbol (name);
symbol->type = type;
return symbol;
}
int test_environment()
{
symbol *sa = new_symbol("a");
symbol *sb = new_symbol("b");
symbol *sc = new_symbol("c");
symbol *sx = new_symbol("x");
symbol *sy = new_symbol("y");
symbol *sz = new_symbol("z");
symbol *sn = new_symbol("n");
integer *i10 = new_integer(10);
integer *i20 = new_integer(20);
integer *i30 = new_integer(30);
integer *i40 = new_integer(40);
integer *i50 = new_integer(50);
integer *i60 = new_integer(60);
list *vara = cons(sa, cons(sb, cons(sc, NULL)));
list *varx = cons(sx, cons(sy, cons(sz, NULL)));
list *val10 = cons(i10, cons(i20, cons(i30, NULL)));
list *val40 = cons(i40, cons(i50, cons(i60, NULL)));
environment *env = NULL;
env = extend_env(vara, val10, env);
assert(generic_equal(lookup_var_val(sa, env), cons(sa, i10)));
assert(generic_equal(lookup_var_val(sb, env), cons(sb, i20)));
assert(generic_equal(lookup_var_val(sc, env), cons(sc, i30)));
env = define_var_val(sx, i40, env);
assert(generic_equal(lookup_var_val(sa, env), cons(sa, i10)));
assert(generic_equal(lookup_var_val(sb, env), cons(sb, i20)));
assert(generic_equal(lookup_var_val(sc, env), cons(sc, i30)));
assert(generic_equal(lookup_var_val(sx, env), cons(sx, i40)));
assert(generic_equal(lookup_var_val(sy, env), NULL));
env = set_var_val(sx, i50, env);
assert(generic_equal(lookup_var_val(sa, env), cons(sa, i10)));
assert(generic_equal(lookup_var_val(sb, env), cons(sb, i20)));
assert(generic_equal(lookup_var_val(sc, env), cons(sc, i30)));
assert(generic_equal(lookup_var_val(sx, env), cons(sx, i50)));
assert(generic_equal(lookup_var_val(sy, env), NULL));
env = extend_env(varx, val40, env);
assert(generic_equal(lookup_var_val(sa, env), cons(sa, i10)));
assert(generic_equal(lookup_var_val(sb, env), cons(sb, i20)));
assert(generic_equal(lookup_var_val(sc, env), cons(sc, i30)));
assert(generic_equal(lookup_var_val(sx, env), cons(sx, i40)));
assert(generic_equal(lookup_var_val(sy, env), cons(sy, i50)));
assert(generic_equal(lookup_var_val(sz, env), cons(sz, i60)));
assert(generic_equal(lookup_var_val(sn, env), NULL));
return 1;
}
bool test_macro()
{
list *l;
environment *env = new_env();
macro *m;
list *arg;
list *body;
l = read_tokens(expand_readmacro(
tokenize("(defmacro m (x) `(,x ,x))")));
m = eval(eval(l, env), env);
arg = car(m);
body = cdr(m);
assert(equal_symbol(car(arg), new_symbol("x")));
assert(equal_symbol(car(body), new_symbol("quasiquote")));
return true;
}
secd_t * init_secd(secd_t *secd, cell_t *heap, size_t ncells) {
secd->free = SECD_NIL;
secd->stack = secd->dump =
secd->control = secd->env = SECD_NIL;
secd->tick = 0;
secd->postop = SECD_NOPOST;
secd_init_mem(secd, heap, ncells);
secd->truth_value = share_cell(secd, new_symbol(secd, SECD_TRUE));
secd->false_value = share_cell(secd, new_symbol(secd, SECD_FALSE));
secd_init_ports(secd);
secd_init_env(secd);
return secd;
}
Token linkonce_rodata (Token s)
{
if (NoLinkonce) return BLANKT;
char tmp [512];
sprintf (tmp, "__attribute__ ((__section__(\""SECTION_LINKONCE_RODATA"%s\")))",
expand (s));
return new_symbol (strdup (tmp));
}
void
add_symbol_forward(const char *key, int attr)
{
const struct SYM *p = get_symbol(key);
if (p) {
return;
}
symtab = new_symbol(key, NULL, SYMBOL_NORMAL);
symtab->attr |= attr;
}
int test_newlispobj()
{
integer *i10 = new_lispobj("10");
symbol *s = new_symbol("hello");
assert(integer_to_int(i10) == 10);
assert(strcmp(sym_to_string(s), "hello") == 0);
return 1;
}
symbol_t *
copy_symbol (symbol_t *symbol)
{
symbol_t *sym = new_symbol (symbol->name);
sym->type = symbol->type;
sym->params = copy_params (symbol->params);
sym->sy_type = symbol->sy_type;
sym->s = symbol->s;
return sym;
}
