memptr func_list(memptr func_expr) {
if (num_nodes(func_expr) == 1) {
return nil;
}
memptr current_node, current_param, current_dup_node = safe_allocate_cons(),
base = current_dup_node;
cons_pool[current_dup_node].carKind = NIL;
cons_pool[current_dup_node].cdrKind = NIL;
current_node = cons_pool[func_expr].cdr;
current_param = resolve_expr(cons_pool[current_node].car);
if (current_param == NOT_FOUND) {
#ifdef DEBUG
printf("29\n");
#endif
ERROR(ERROR_LIST, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
return NOT_FOUND;
} else if (type(current_param) == TYPE_OBJECT) {
memptr lu = object_lookup(current_param, cons_pool[func_expr].car);
if (lu != NOT_FOUND) {
#ifdef EXTENDED_SECURITY
memptr local_security = safe_allocate_cons();
cons_pool[local_security].car = current_param;
cons_pool[local_security].carKind = CONS;
cons_pool[local_security].cdrKind = NIL;
#endif
return resolve_func_expr(func_expr, current_param, lu, true);
}
}
cons_pool[current_dup_node].car = current_param;
cons_pool[current_dup_node].carKind = CONS;
while (cons_pool[current_node].cdrKind == CONS) {
current_node = cons_pool[current_node].cdr;
cons_pool[current_dup_node].cdr = allocate_cons();
cons_pool[current_dup_node].cdrKind = CONS;
current_dup_node = cons_pool[current_dup_node].cdr;
cons_pool[current_dup_node].carKind = NIL;
cons_pool[current_dup_node].cdrKind = NIL;
current_param = resolve_expr(cons_pool[current_node].car);
if (current_param == NOT_FOUND) {
#ifdef DEBUG
printf("30\n");
#endif
ERROR(ERROR_LIST, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
return NOT_FOUND;
}
cons_pool[current_dup_node].car = current_param;
cons_pool[current_dup_node].carKind = CONS;
}
cons_pool[current_dup_node].cdrKind = CONS;
cons_pool[current_dup_node].cdr = nil;
return base;
}
static int wasFinalPass(void)
{
int result = 1;
struct map_iterator i[1];
struct map_entry *me;
for(map_get_iterator(s->guesses, i);
(me = (struct map_entry*)map_iterator_next(i)) != NULL;)
{
struct expr *guess_expr;
struct expr *sym_expr;
LOG(LOG_VERBOSE, ("Checking guessed symbol %s: ", me->key));
/* Was this guessed symbol used in this pass? */
if((sym_expr = map_get(s->sym_table, me->key)) == NULL)
{
/* No, skip it */
continue;
}
guess_expr = me->value;
LOG(LOG_VERBOSE, ("expected %d, actual %d\n",
resolve_expr(guess_expr),
resolve_expr(sym_expr)));
if(expr_cmp_cb(me->value, sym_expr) != 0)
{
/* Not the same, not the last pass.
* copy the actual value from the sym table */
me->value = sym_expr;
result = 0;
}
}
return result;
}
struct atom *new_incbin(const char *name,
struct expr *skip, struct expr *len)
{
struct atom *atom;
long length;
i32 len32;
i32 skip32;
struct membuf *in;
/* find out how long the file is */
in = get_named_buffer(s->named_buffer, name);
length = membuf_memlen(in);
skip32 = 0;
if(skip != NULL)
{
skip32 = resolve_expr(skip);
}
if(skip32 < 0)
{
skip32 += length;
}
if(skip32 < 0 || skip32 > length)
{
LOG(LOG_ERROR,
("Can't read from offset %d in file \"%s\".\n", skip32, name));
exit(-1);
}
length -= skip32;
len32 = 0;
if(len != NULL)
{
len32 = resolve_expr(len);
}
if(len32 < 0)
{
len32 += length;
}
if(len32 < 0 || len32 > length)
{
LOG(LOG_ERROR,
("Can't read %d bytes from offset %d from file \"%s\".\n",
len32, skip32, name));
exit(-1);
}
atom = chunkpool_malloc(s->atom_pool);
atom->type = ATOM_TYPE_BUFFER;
atom->u.buffer.name = name;
atom->u.buffer.length = len32;
atom->u.buffer.skip = skip32;
if(len != NULL)
{
pc_add(len32);
}
return atom;
}
static int expr_cmp_cb(const void *a, const void *b)
{
int result = 0;
i32 e1v = resolve_expr((struct expr*)a);
i32 e2v = resolve_expr((struct expr*)b);
if(e1v < e2v)
{
result = -1;
}
else if(e1v > e2v)
{
result = 1;
}
return result;
}
memptr func_true(memptr func_expr) {
if (num_nodes(func_expr) != 2) {
#ifdef DEBUG
printf("15\n");
#endif
ERROR(ERROR_TRUE, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
return NOT_FOUND;
}
#ifdef EXTENDED_SECURITY
memptr local_security = safe_allocate_cons();
cons_pool[local_security].carKind = NIL;
cons_pool[local_security].cdrKind = NIL;
#endif
memptr param = resolve_expr(cons_pool[cons_pool[func_expr].cdr].car);
#ifdef EXTENDED_SECURITY
cons_pool[local_security].car = param;
cons_pool[local_security].carKind = CONS;
#endif
if (type(param) == TYPE_OBJECT) {
memptr lu = object_lookup(param, cons_pool[func_expr].car);
if (lu == NOT_FOUND) {
param = object_lookup(param, core_symbol);
} else {
return resolve_func_expr(func_expr, param, lu, true);
}
}
return ((param == t) ? t : nil);
}
int resolve_symbol(const char *symbol, int *has_valuep, i32 *valuep)
{
int found = 0;
int has_value = 0;
i32 value = 0;
struct expr *e;
const char *p;
p = find_symref(symbol, &e);
if(p == NULL)
{
if(e != NULL)
{
value = resolve_expr(e);
has_value = 1;
}
found = 1;
}
if(found)
{
if(has_valuep != NULL)
{
*has_valuep = has_value;
}
if(has_value && valuep != NULL)
{
*valuep = value;
}
}
return found;
}
void asm_echo(const char *msg, struct atom *atom)
{
struct vec_iterator i[1];
struct expr **exprp;
int count = 0;
i32 e[10];
if(atom != NULL)
{
if(atom->type != ATOM_TYPE_EXPRS || vec_count(atom->u.exprs) > 10)
{
LOG(LOG_ERROR, ("echo arguments must be a string followed by none "
"or at most ten expressions.\n"));
exit(1);
}
vec_get_iterator(atom->u.exprs, i);
while((exprp = vec_iterator_next(i)) != NULL)
{
e[count++] = resolve_expr(*exprp);
}
}
for(; count < 10; ++count)
{
e[count] = 0;
}
fprintf(stdout, msg, e[0], e[1], e[2], e[3],
e[4], e[5], e[6], e[7], e[8], e[9]);
fprintf(stdout, "\n");
}
struct expr *new_expr_incword(const char *name,
struct expr *skip)
{
i32 word;
i32 offset;
long length;
struct membuf *in;
struct expr *expr;
unsigned char *p;
offset = resolve_expr(skip);
in = get_named_buffer(s->named_buffer, name);
length = membuf_memlen(in);
if(offset < 0)
{
offset += length;
}
if(offset < 0 || offset > length - 2)
{
LOG(LOG_ERROR,
("Can't read word from offset %d in file \"%s\".\n",
offset, name));
exit(-1);
}
p = membuf_get(in);
p += offset;
word = *p++;
word |= *p++ << 8;
expr = new_expr_number(word);
return expr;
}
memptr func_cons(memptr func_expr) {
if (num_nodes(func_expr) != 3) {
#ifdef DEBUG
printf("9\n");
#endif
ERROR(ERROR_CONS, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
return NOT_FOUND;
}
memptr res = safe_allocate_cons();
cons_pool[res].carKind = NIL;
cons_pool[res].cdrKind = NIL;
memptr current_node, current_data;
// first parameter
current_node = cons_pool[func_expr].cdr;
current_data = cons_pool[current_node].car;
cons_pool[res].car = resolve_expr(current_data);
cons_pool[res].carKind = CONS;
if (type(cons_pool[res].car) == TYPE_OBJECT) {
memptr lu = object_lookup(cons_pool[res].car, cons_pool[func_expr].car);
if (lu == NOT_FOUND && OBJECT_OPERATE_CORE) {
cons_pool[res].car = object_lookup(cons_pool[res].car, core_symbol);
} else if (lu != NOT_FOUND) {
return resolve_func_expr(func_expr, cons_pool[res].car, lu, true);
}
}
// second parameter
current_node = cons_pool[current_node].cdr;
current_data = cons_pool[current_node].car;
cons_pool[res].cdr = resolve_expr(current_data);
cons_pool[res].cdrKind = CONS;
if (type(cons_pool[res].cdr) == TYPE_OBJECT && OBJECT_OPERATE_CORE) {
cons_pool[res].cdr = object_lookup(cons_pool[res].cdr, core_symbol);
}
return res;
}
memptr func_cdr(memptr func_expr) {
if (num_nodes(func_expr) != 2) {
#ifdef DEBUG
printf("12\n");
#endif
ERROR(ERROR_CDR, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
return NOT_FOUND;
}
memptr local_security = safe_allocate_cons();
cons_pool[local_security].carKind = NIL;
cons_pool[local_security].cdrKind = NIL;
memptr param = resolve_expr(cons_pool[cons_pool[func_expr].cdr].car);
cons_pool[local_security].car = param;
cons_pool[local_security].carKind = CONS;
while (true) {
Type param_type = type(param);
if (param_type == TYPE_CONS) {
return cons_pool[param].cdr;
} else if (param_type == TYPE_STRING) {
memptr result;
if ((cons_pool[param].cdr < 0) || (string_length(param) == 1)) {
result = nil;
} else {
result = allocate_cons();
cons_pool[result].car = cons_pool[param].car;
cons_pool[result].cdr = cons_pool[param].cdr + 1;
cons_pool[result].carKind = STRING;
cons_pool[result].cdrKind = INTEGER;
}
return result;
} else if (param_type == TYPE_OBJECT) {
memptr lu = object_lookup(param, cons_pool[func_expr].car);
if (lu == NOT_FOUND) {
param = object_lookup(param, core_symbol);
continue;
} else {
return resolve_func_expr(func_expr, param, lu, true);
}
}
break;
}
#ifdef DEBUG
printf("13\n");
#endif
ERROR(ERROR_CDR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
return NOT_FOUND;
}
void push_if_state(struct expr *arg)
{
int val;
LOG(LOG_DEBUG, ("resolving if expression\n"));
val = resolve_expr(arg);
LOG(LOG_DEBUG, ("if expr resolved to %d\n", val));
if(val)
{
push_state_init = 1;
}
else
{
push_state_skip = 1;
}
}
memptr func_value(memptr func_expr) {
if (num_nodes(func_expr) < 2) {
#ifdef DEBUG
printf("31\n");
#endif
ERROR(ERROR_VALUE, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
return NOT_FOUND;
}
memptr next_node = cons_pool[func_expr].cdr, current_node, current_value;
bool first_param = true;
do {
#ifdef EXTENDED_SECURITY
memptr local_security = safe_allocate_cons();
cons_pool[local_security].carKind = NIL;
cons_pool[local_security].cdrKind = NIL;
#endif
current_node = next_node;
current_value = resolve_expr(cons_pool[current_node].car);
#ifdef EXTENDED_SECURITY
cons_pool[local_security].car = current_value;
cons_pool[local_security].carKind = CONS;
#endif
if (current_value == NOT_FOUND) {
#ifdef DEBUG
printf("32\n");
#endif
ERROR(ERROR_VALUE, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
return NOT_FOUND;
} else if (first_param && (type(current_value) == TYPE_OBJECT)) {
memptr lu = object_lookup(current_value, cons_pool[func_expr].car);
if (lu != NOT_FOUND) {
return resolve_func_expr(func_expr, current_value, lu, true);
}
}
next_node = cons_pool[current_node].cdr;
first_param = false;
} while (cons_pool[current_node].cdrKind == CONS);
return current_value;
}
memptr func_supps(memptr func_expr) {
if (num_nodes(func_expr) != 3) {
#ifdef DEBUG
printf("36\n");
#endif
ERROR(ERROR_SUPPS, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
return NOT_FOUND;
}
memptr symbol = cons_pool[cons_pool[func_expr].cdr].car;
memptr value = resolve_expr(
cons_pool[cons_pool[cons_pool[func_expr].cdr].cdr].car);
if (value == NOT_FOUND) {
#ifdef DEBUG
printf("37\n");
#endif
ERROR(ERROR_SUPPS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
return NOT_FOUND;
}
return (supps(value, symbol) ? t : nil);
}
void initial_symbol_dump(int level, const char *symbol)
{
i32 value;
struct expr *expr;
expr = map_get(s->initial_symbols, symbol);
if(expr != NULL)
{
value = resolve_expr(expr);
LOG(level, ("symbol \"%s\" resolves to %d ($%04X)\n",
symbol, value, value));
}
else
{
if(map_contains_key(s->initial_symbols, symbol))
{
LOG(level, ("symbol \"%s\" defined but has no value\n", symbol));
}
else
{
LOG(level, ("symbol \"%s\" not found\n", symbol));
}
}
}
memptr func_assign(memptr func_expr) {
if (num_nodes(func_expr) != 4) {
#ifdef DEBUG
printf("33\n");
#endif
ERROR(ERROR_ASSIGN, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
return NOT_FOUND;
}
memptr local_security = safe_allocate_cons();
cons_pool[local_security].carKind = NIL;
cons_pool[local_security].cdrKind = NIL;
memptr current_node = cons_pool[func_expr].cdr;
memptr symbol = cons_pool[current_node].car;
current_node = cons_pool[current_node].cdr;
memptr value = cons_pool[current_node].car;
current_node = cons_pool[current_node].cdr;
memptr obj = cons_pool[current_node].car;
// first resolve the object, then the value
obj = resolve_expr(obj);
if (obj == NOT_FOUND) {
#ifdef DEBUG
printf("34\n");
#endif
ERROR(ERROR_ASSIGN, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
cons_pool[local_security].car = obj;
cons_pool[local_security].carKind = CONS;
value = resolve_expr(value);
if (value == NOT_FOUND) {
#ifdef DEBUG
printf("35\n");
#endif
ERROR(ERROR_ASSIGN, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
cons_pool[local_security].cdr = value;
cons_pool[local_security].cdrKind = CONS;
memptr result = NOT_FOUND;
if (type(obj) == TYPE_OBJECT) {
announce_allocation(2);
memptr new_symbol = allocate_cons();
cons_pool[new_symbol].car = cons_pool[symbol].car;
cons_pool[new_symbol].carKind = STRING;
cons_pool[new_symbol].cdr = value;
cons_pool[new_symbol].cdrKind = CONS;
object_remove_symbol(obj, new_symbol);
object_insert_symbol(obj, new_symbol); // includes 1 allocation
result = obj;
} else {
announce_allocation(5);
memptr new_obj = allocate_cons();
cons_pool[new_obj].carKind = NIL;
cons_pool[new_obj].cdr = allocate_cons();
cons_pool[new_obj].cdrKind = CONS;
memptr new_node = cons_pool[new_obj].cdr;
cons_pool[new_node].car = allocate_cons();
cons_pool[new_node].carKind = CONS;
cons_pool[new_node].cdr = allocate_cons();
cons_pool[new_node].cdrKind = CONS;
memptr new_symbol = cons_pool[new_node].car;
cons_pool[new_symbol].car = cons_pool[symbol].car;
cons_pool[new_symbol].carKind = STRING;
cons_pool[new_symbol].cdr = value;
cons_pool[new_symbol].cdrKind = CONS;
memptr new_core_node = cons_pool[new_node].cdr;
cons_pool[new_core_node].cdrKind = NIL;
cons_pool[new_core_node].car = allocate_cons();
cons_pool[new_core_node].carKind = CONS;
memptr new_core_symbol = cons_pool[new_core_node].car;
cons_pool[new_core_symbol].car = cons_pool[core_symbol].car;
cons_pool[new_core_symbol].carKind = STRING;
cons_pool[new_core_symbol].cdr = obj;
cons_pool[new_core_symbol].cdrKind = CONS;
result = new_obj;
}
return result;
}
memptr func_setq(memptr func_expr) {
if (num_nodes(func_expr) != 3) {
// invalid call
#ifdef DEBUG
printf("22\n");
#endif
ERROR(ERROR_SETQ, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
return NOT_FOUND;
}
memptr local_security = safe_allocate_cons();
cons_pool[local_security].carKind = NIL;
cons_pool[local_security].cdrKind = NIL;
memptr current_node = cons_pool[func_expr].cdr;
memptr current_param = cons_pool[current_node].car;
Type first_type = type(current_param);
if (first_type != TYPE_SYMBOL) {
// first argument not a name
#ifdef DEBUG
printf("23\n");
#endif
ERROR(ERROR_SETQ, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
memptr symbol_name = current_param;
current_node = cons_pool[current_node].cdr;
current_param = cons_pool[current_node].car;
memptr value = resolve_expr(current_param);
if (value == NOT_FOUND) {
// invalid value
#ifdef DEBUG
printf("24\n");
#endif
ERROR(ERROR_SETQ, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
return NOT_FOUND;
}
cons_pool[local_security].car = value;
cons_pool[local_security].carKind = CONS;
// defining the new symbol
memptr symbol = allocate_cons();
cons_pool[local_security].cdr = symbol;
cons_pool[local_security].cdrKind = CONS;
cons_pool[symbol].car = cons_pool[symbol_name].car;
cons_pool[symbol].carKind = STRING;
cons_pool[symbol].cdr = value;
cons_pool[symbol].cdrKind = CONS;
memptr env = lookup(symbol, ENVIRONMENT);
if (env == NOT_FOUND) {
// inserting to current environment
insert_symbol(environment, symbol); // includes 1 allocation
} else {
// replacing previous interpretation
remove_symbol(env, symbol);
insert_symbol(env, symbol); // includes 1 allocation
}
return value;
}
memptr func_cond(memptr func_expr) {
if (num_nodes(func_expr) == 1) {
// no parameters
#ifdef DEBUG
printf("16\n");
#endif
ERROR(ERROR_COND, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
return NOT_FOUND;
}
memptr current_node, current_data, condition, result;
current_node = func_expr;
Type current_data_type;
while (cons_pool[current_node].cdrKind == CONS) {
current_node = cons_pool[current_node].cdr;
current_data = cons_pool[current_node].car;
current_data_type = type(current_data);
if (current_data_type == TYPE_CONS) {
// cons support
condition = cons_pool[current_data].car;
result = cons_pool[current_data].cdr;
} else if (current_data_type == TYPE_USER_FUNCTION) {
// "function" support (interpreted as a function by the translator)
current_data = cons_pool[current_data].car;
if (num_nodes(current_data) != 2) {
#ifdef DEBUG
printf("17\n");
#endif
ERROR(ERROR_COND, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
condition = cons_pool[current_data].car;
result = cons_pool[cons_pool[current_data].cdr].car;
} else {
// invalid
#ifdef DEBUG
printf("18\n");
#endif
ERROR(ERROR_COND, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
memptr condition_result = resolve_expr(condition);
if (condition_result == NOT_FOUND) {
#ifdef DEBUG
printf("19\n");
#endif
ERROR(ERROR_COND, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
return NOT_FOUND;
} else if (condition_result != nil && condition_result != t) {
#ifdef DEBUG
printf("20\n");
#endif
ERROR(ERROR_COND, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
return NOT_FOUND;
}
if (condition_result == t) {
#ifdef EXTENDED_SECURITY
memptr local_security = safe_allocate_cons();
cons_pool[local_security].car = result;
cons_pool[local_security].carKind = CONS;
cons_pool[local_security].cdrKind = NIL;
#endif
return resolve_expr(result);
}
}
#ifdef DEBUG
printf("21\n");
#endif
ERROR(ERROR_COND, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
void output_atoms(struct membuf *out, struct vec *atoms)
{
struct vec_iterator i[1];
struct vec_iterator i2[1];
struct atom **atomp;
struct atom *atom;
struct expr **exprp;
struct expr *expr;
struct membuf *in;
const char *p;
i32 value;
i32 value2;
dump_sym_table(LOG_DEBUG, s->sym_table);
vec_get_iterator(atoms, i);
while((atomp = vec_iterator_next(i)) != NULL)
{
atom = *atomp;
LOG(LOG_DEBUG, ("yadda\n"));
switch(atom->type)
{
case ATOM_TYPE_OP_ARG_NONE:
LOG(LOG_DEBUG, ("output: $%02X\n", atom->u.op.code));
membuf_append_char(out, atom->u.op.code);
break;
case ATOM_TYPE_OP_ARG_U8:
/* op with argument */
value = resolve_expr(atom->u.op.arg);
if(!is_valid_u8(value))
{
LOG(LOG_ERROR, ("value %d out of range for op $%02X @%p\n",
value, atom->u.op.code, (void*)atom));
exit(1);
}
LOG(LOG_DEBUG, ("output: $%02X $%02X\n",
atom->u.op.code, value & 255));
membuf_append_char(out, atom->u.op.code);
membuf_append_char(out, value);
break;
case ATOM_TYPE_OP_ARG_I8:
/* op with argument */
value = resolve_expr(atom->u.op.arg);
if(!is_valid_i8(value))
{
LOG(LOG_ERROR, ("value %d out of range for op $%02X @%p\n",
value, atom->u.op.code, (void*)atom));
exit(1);
}
LOG(LOG_DEBUG, ("output: $%02X $%02X\n",
atom->u.op.code, value & 255));
membuf_append_char(out, atom->u.op.code);
membuf_append_char(out, value);
break;
case ATOM_TYPE_OP_ARG_UI8:
/* op with argument */
value = resolve_expr(atom->u.op.arg);
if(!is_valid_ui8(value))
{
LOG(LOG_ERROR, ("value %d out of range for op $%02X @%p\n",
value, atom->u.op.code, (void*)atom));
exit(1);
}
LOG(LOG_DEBUG, ("output: $%02X $%02X\n",
atom->u.op.code, value & 255));
membuf_append_char(out, atom->u.op.code);
membuf_append_char(out, value);
break;
case ATOM_TYPE_OP_ARG_U16:
/* op with argument */
value = resolve_expr(atom->u.op.arg);
if(!is_valid_u16(value))
{
LOG(LOG_ERROR, ("value %d out of range for op $%02X @%p\n",
value, atom->u.op.code, (void*)atom));
exit(1);
}
value2 = value / 256;
value = value % 256;
LOG(LOG_DEBUG, ("output: $%02X $%02X $%02X\n",
atom->u.op.code,
value, value2));
membuf_append_char(out, atom->u.op.code);
membuf_append_char(out, value);
membuf_append_char(out, value2);
break;
case ATOM_TYPE_RES:
/* reserve memory statement */
value = resolve_expr(atom->u.res.length);
if(!is_valid_u16(value))
{
LOG(LOG_ERROR, ("length %d for .res(length, value) "
"is out of range\n", value));
exit(1);
}
value2 = resolve_expr(atom->u.res.value);
if(!is_valid_ui8(value2))
{
LOG(LOG_ERROR, ("value %d for .res(length, value) "
"is out of range\n", value));
exit(1);
}
LOG(LOG_DEBUG, ("output: .RES %d, %d\n", value, value2));
while(--value >= 0)
{
membuf_append_char(out, value2);
}
break;
case ATOM_TYPE_BUFFER:
/* include binary file statement */
value = atom->u.buffer.skip;
if(!is_valid_u16(value))
{
LOG(LOG_ERROR, ("value %d for .res(length, value) "
"is out of range\n", value));
exit(1);
}
value2 = atom->u.buffer.length;
if(!is_valid_u16(value2))
{
LOG(LOG_ERROR, ("length %d for .incbin(name, skip, length) "
"is out of range\n", value2));
exit(1);
}
LOG(LOG_DEBUG, ("output: .INCBIN \"%s\", %d, %d\n",
atom->u.buffer.name, value, value2));
in = get_named_buffer(s->named_buffer, atom->u.buffer.name);
p = membuf_get(in);
p += value;
while(--value2 >= 0)
{
membuf_append_char(out, *p++);
}
break;
case ATOM_TYPE_WORD_EXPRS:
vec_get_iterator(atom->u.exprs, i2);
while((exprp = vec_iterator_next(i2)) != NULL)
{
expr = *exprp;
value = resolve_expr(expr);
if(!is_valid_ui16(value))
{
LOG(LOG_ERROR, ("value %d for .word(value, ...) "
"is out of range\n", value));
}
value2 = value / 256;
value = value % 256;
membuf_append_char(out, value);
membuf_append_char(out, value2);
}
LOG(LOG_DEBUG, ("output: %d words\n", vec_count(atom->u.exprs)));
break;
case ATOM_TYPE_BYTE_EXPRS:
vec_get_iterator(atom->u.exprs, i2);
while((exprp = vec_iterator_next(i2)) != NULL)
{
expr = *exprp;
value = resolve_expr(expr);
if(!is_valid_ui8(value))
{
LOG(LOG_ERROR, ("value %d for .byte(value, ...) "
"is out of range\n", value));
}
membuf_append_char(out, value);
}
LOG(LOG_DEBUG, ("output: %d bytes\n", vec_count(atom->u.exprs)));
break;
default:
LOG(LOG_ERROR, ("invalid atom_type %d @%p\n",
atom->type, (void*)atom));
exit(1);
}
}
}
memptr do_join_operation(memptr func_expr, JoinOperation operation_type) {
if (num_nodes(func_expr) != 3) {
#ifdef DEBUG
printf("1\n");
#endif
switch (operation_type) {
case PLUS:
ERROR(ERROR_PLUS, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case MINUS:
ERROR(ERROR_MINUS, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case MULT:
ERROR(ERROR_MULT, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case DIV:
ERROR(ERROR_DIV, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case EQUAL:
ERROR(ERROR_EQUALS, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case SMALLER:
ERROR(ERROR_SMALLER, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case GREATER:
ERROR(ERROR_GREATER, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case OR:
ERROR(ERROR_OR, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case AND:
ERROR(ERROR_AND, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case XOR:
ERROR(ERROR_XOR, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
default:
break;
}
return NOT_FOUND;
}
memptr current_node = cons_pool[func_expr].cdr;
memptr local_security = safe_allocate_cons();
cons_pool[local_security].carKind = NIL;
cons_pool[local_security].cdrKind = NIL;
memptr first_param = resolve_expr(cons_pool[current_node].car);
if (first_param == NOT_FOUND) {
#ifdef DEBUG
printf("2\n");
#endif
switch (operation_type) {
case PLUS:
ERROR(ERROR_PLUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MINUS:
ERROR(ERROR_MINUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MULT:
ERROR(ERROR_MULT, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case DIV:
ERROR(ERROR_DIV, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case EQUAL:
ERROR(ERROR_EQUALS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case SMALLER:
ERROR(ERROR_SMALLER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case GREATER:
ERROR(ERROR_GREATER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case OR:
ERROR(ERROR_OR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case AND:
ERROR(ERROR_AND, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case XOR:
ERROR(ERROR_XOR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
default:
break;
}
return NOT_FOUND;
}
cons_pool[local_security].car = first_param;
cons_pool[local_security].carKind = CONS;
Type first_param_type = type(first_param);
if (first_param_type == TYPE_OBJECT) {
memptr lu = object_lookup(first_param, cons_pool[func_expr].car);
if (lu == NOT_FOUND) {
first_param = object_lookup(first_param, core_symbol);
first_param_type = type(first_param);
} else {
return resolve_func_expr(func_expr, first_param, lu, true);
}
}
current_node = cons_pool[current_node].cdr;
memptr second_param = resolve_expr(cons_pool[current_node].car);
if (second_param == NOT_FOUND) {
#ifdef DEBUG
printf("3\n");
#endif
switch (operation_type) {
case PLUS:
ERROR(ERROR_PLUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MINUS:
ERROR(ERROR_MINUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MULT:
ERROR(ERROR_MULT, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case DIV:
ERROR(ERROR_DIV, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case EQUAL:
ERROR(ERROR_EQUALS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case SMALLER:
ERROR(ERROR_SMALLER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case GREATER:
ERROR(ERROR_GREATER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case OR:
ERROR(ERROR_OR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case AND:
ERROR(ERROR_AND, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case XOR:
ERROR(ERROR_XOR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
default:
break;
}
return NOT_FOUND;
}
cons_pool[local_security].cdr = second_param;
cons_pool[local_security].cdrKind = CONS;
Type second_param_type = type(second_param);
if (second_param_type == TYPE_OBJECT) {
second_param = object_lookup(second_param, core_symbol);
second_param_type = type(second_param);
}
memptr result = NOT_FOUND;
if (operation_type == PLUS || operation_type == MINUS
|| operation_type == MULT || operation_type == DIV) {
if (first_param_type != TYPE_INTEGER
|| second_param_type != TYPE_INTEGER) {
#ifdef DEBUG
printf("4\n");
#endif
switch (operation_type) {
case PLUS:
ERROR(ERROR_PLUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MINUS:
ERROR(ERROR_MINUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MULT:
ERROR(ERROR_MULT, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case DIV:
ERROR(ERROR_DIV, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case EQUAL:
ERROR(ERROR_EQUALS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case SMALLER:
ERROR(ERROR_SMALLER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case GREATER:
ERROR(ERROR_GREATER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case OR:
ERROR(ERROR_OR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case AND:
ERROR(ERROR_AND, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case XOR:
ERROR(ERROR_XOR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
default:
break;
}
return NOT_FOUND;
}
int first_value = fix_integer(cons_pool[first_param].car);
int second_value = fix_integer(cons_pool[second_param].car);
result = allocate_cons();
cons_pool[result].carKind = INTEGER;
cons_pool[result].cdrKind = NIL;
switch (operation_type) {
case PLUS:
cons_pool[result].car = first_value + second_value;
break;
case MINUS:
cons_pool[result].car = first_value - second_value;
break;
case MULT:
cons_pool[result].car = first_value * second_value;
break;
case DIV:
if (second_value == 0) {
#ifdef DEBUG
printf("5\n");
#endif
return NOT_FOUND;
}
cons_pool[result].car = first_value / second_value;
break;
default:
break;
}
} else if (operation_type == EQUAL || operation_type == SMALLER
|| operation_type == GREATER) {
if (first_param_type != second_param_type) {
#ifdef DEBUG
printf("6\n");
#endif
switch (operation_type) {
case PLUS:
ERROR(ERROR_PLUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MINUS:
ERROR(ERROR_MINUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MULT:
ERROR(ERROR_MULT, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case DIV:
ERROR(ERROR_DIV, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case EQUAL:
ERROR(ERROR_EQUALS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case SMALLER:
ERROR(ERROR_SMALLER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case GREATER:
ERROR(ERROR_GREATER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case OR:
ERROR(ERROR_OR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case AND:
ERROR(ERROR_AND, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case XOR:
ERROR(ERROR_XOR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
default:
break;
}
}
int first_value;
int second_value;
if (first_param_type == TYPE_NIL_TRUE) {
first_value = ((first_param == nil) ? 0 : 1);
second_value = ((second_param == nil) ? 0 : 1);
} else if (first_param_type == TYPE_INTEGER) {
first_value = fix_integer(cons_pool[first_param].car);
second_value = fix_integer(cons_pool[second_param].car);
} else {
// addresses comparison
first_value = first_param;
second_value = second_param;
}
// strings logic
if (first_param_type == TYPE_STRING) {
bool full_equal = false;
int len1 = string_length(first_param);
int len2 = string_length(second_param);
if ((len1 == 1) || (len2 == 1)) {
first_value =
strings_pool[get_string(cons_pool[first_param].car,
cons_pool[first_param].cdr)];
second_value = strings_pool[get_string(
cons_pool[second_param].car,
cons_pool[second_param].cdr)];
if (len1 != 1) {
if (first_value == second_value) {
first_value++;
}
}
if (len2 != 1) {
if (first_value == second_value) {
second_value++;
}
}
} else {
int iter1 = get_string(cons_pool[first_param].car,
cons_pool[first_param].cdr), iter2 = get_string(
cons_pool[second_param].car,
cons_pool[second_param].cdr);
first_value = second_value = 0;
while (first_value == second_value
&& strings_pool[iter1] != '\0'
&& strings_pool[iter2] != '\0') {
first_value = strings_pool[iter1++];
second_value = strings_pool[iter2++];
}
if ((strings_pool[iter1] != '\0')
&& (strings_pool[iter2] == '\0')
&& (first_value == second_value)) {
first_value++;
} else if ((strings_pool[iter1] == '\0')
&& (strings_pool[iter2] != '\0')
&& (first_value == second_value)) {
second_value++;
}
}
}
switch (operation_type) {
case EQUAL:
result = ((first_value == second_value) ? t : nil);
break;
case SMALLER:
result = ((first_value < second_value) ? t : nil);
break;
case GREATER:
result = ((first_value > second_value) ? t : nil);
break;
default:
#ifdef DEBUG
printf("7\n");
#endif
return NOT_FOUND;
break;
}
} else if (operation_type == XOR || operation_type == OR
|| operation_type == AND) {
if (first_param_type != TYPE_NIL_TRUE
|| second_param_type != TYPE_NIL_TRUE) {
#ifdef DEBUG
printf("7.5\n");
#endif
switch (operation_type) {
case PLUS:
ERROR(ERROR_PLUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MINUS:
ERROR(ERROR_MINUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MULT:
ERROR(ERROR_MULT, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case DIV:
ERROR(ERROR_DIV, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case EQUAL:
ERROR(ERROR_EQUALS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case SMALLER:
ERROR(ERROR_SMALLER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case GREATER:
ERROR(ERROR_GREATER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case OR:
ERROR(ERROR_OR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case AND:
ERROR(ERROR_AND, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case XOR:
ERROR(ERROR_XOR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
default:
break;
}
return NOT_FOUND;
}
switch (operation_type) {
case XOR:
result = ((first_param != second_param) ? t : nil);
break;
case OR:
result = ((first_param == t || second_param == t) ? t : nil);
break;
case AND:
result = ((first_param == t && second_param == t) ? t : nil);
break;
default:
#ifdef DEBUG
printf("8\n");
#endif
return NOT_FOUND;
break;
}
}
return result;
}
