void f_or(t_champion *ch, t_vm *vm, char **arg, char *type)
{
int re;
int i;
int val1;
int val2;
if (type[2] == REG_CODE && check_reg(arg[2]) && ((type[0] == REG_CODE &&
check_reg(arg[0])) || type[0] == DIR_CODE || type[0] == IND_CODE) &&
((type[1] == REG_CODE && check_reg(arg[1])) || type[1] == DIR_CODE ||
type[1] == IND_CODE))
{
val1 = convert(ch, vm, arg[0], type[0]);
val2 = convert(ch, vm, arg[1], type[1]);
re = val1 | val2;
i = cast_int_frone(arg[2][0]) - 1;
ch->registre[i][0] = (char)(re >> 0);
ch->registre[i][1] = (char)(re >> 8);
ch->registre[i][2] = (char)(re >> 16);
ch->registre[i][3] = (char)(re >> 24);
if (re == 0)
ch->carry = 1;
else
ch->carry = 0;
}
int main() {
printf("input.txt is a regular file? %s\n",
check_reg("input.txt") ? "yes" : "no");
printf("docs is a directory? %s\n",
check_dir("docs") ? "yes" : "no");
printf("/input.txt is a regular file? %s\n",
check_reg("/input.txt") ? "yes" : "no");
printf("/docs is a directory? %s\n",
check_dir("/docs") ? "yes" : "no");
return 0;
}
void my_lldi(t_champ *champ, t_cor *cor)
{
int **tab;
int arg1;
int arg2;
int err;
tab = get_encode(cor->mem, champ->pc);
err = 0;
arg1 = get_all_type_arg_noidx(tab[0], champ, cor->mem, &err);
arg2 = get_dir_reg_arg(tab[1], champ, cor->mem, &err);
if (err != -1 &&
(tab[2][0] == 1 && check_reg(tab[2][2]) == 1) && tab[3][0] == 0)
{
champ->carry = 1;
champ->reg[tab[2][2] - 1] = get_nbr_action(cor->mem,
champ->pc + arg1 + arg2, 4);
champ->pc += tab[0][1] + tab[1][1] + tab[2][1] + 2;
}
else
{
champ->carry = 0;
my_none(champ, cor);
}
ifree(tab, 4);
}
void my_or(t_champ *champ, t_cor *cor)
{
int arg1;
int arg2;
int **tab;
int err;
tab = get_encode(cor->mem, champ->pc);
err = 0;
arg1 = get_all_type_arg(tab[0], champ, cor->mem, &err);
arg2 = get_all_type_arg(tab[1], champ, cor->mem, &err);
if (err != -1 && tab[2][0] == 1 && tab[3][0] == 0 &&
check_reg(tab[2][2]) == 1)
{
champ->carry = 1;
champ->reg[tab[2][2] - 1] = arg1 | arg2;
champ->pc += tab[0][1] + tab[1][1] + 3;
}
else
{
my_none(champ, cor);
champ->carry = 0;
}
ifree(tab, 4);
}
int main()
{
check_mem();
check_reg();
check_command();
return 0;
}
int get_dir_reg_arg(int *tab, t_champ *champ, unsigned char *mem, int *err)
{
(void)mem;
if (tab[0] == 0 || tab[0] == 3)
{
*err = -1;
return (-1);
}
else if (tab[0] == 2)
return (tab[2]);
else
{
*err = (check_reg(tab[2]) == 1) ? *err : -1;
return ((check_reg(tab[2])) ? champ->reg[tab[2] - 1] : -1);
}
}
/*---------------------------------------------------------------------------*
* place entry into logfile
*---------------------------------------------------------------------------*/
void
dolog(int what, const char *fmt, ...)
{
char buffer[LOGBUFLEN];
char *dp;
va_list ap;
va_start(ap, fmt);
vsnprintf(buffer, LOGBUFLEN-1, fmt, ap);
va_end(ap);
dp = getlogdatetime(); /* get time string ptr */
#ifdef USE_CURSES
/* put log on screen ? */
if((do_fullscreen && curses_ready) &&
((!debug_noscreen) || (debug_noscreen && (what != LL_DBG))))
{
wprintw(lower_w, "%s %s %-.*s\n", dp, logtab[what].text,
/*
* FreeBSD-current integrated ncurses. Since then it is no longer possible
* to write to the last column in the logfilewindow without causing an
* automatic newline to occur resulting in a blank line in that window.
*/
COLS-((strlen(dp))+(strlen(logtab[what].text))+3), buffer);
wrefresh(lower_w);
}
#endif
#ifdef I4B_EXTERNAL_MONITOR
if(what != LL_MER) /* don't send monitor errs, endless loop !!! */
monitor_evnt_log(logtab[what].pri, logtab[what].text, buffer);
#endif
if(uselogfile)
{
fprintf(logfp, "%s %s %s\n", dp, logtab[what].text, buffer);
}
else
{
char *s = buffer;
/* strip leading spaces from syslog output */
while(*s && (*s == ' '))
s++;
syslog(logtab[what].pri, "%s %s", logtab[what].text, s);
}
#if DEBUG
if(what != LL_DBG) /* don't check debug logs, endless loop !!! */
#endif
check_reg(buffer);
}
void
check_regs(union fpregs *fr1, union fpregs *fr2, union fpregs *fr3)
{
int i;
for (i = 0; i < 16; i++)
check_reg(i * 4, fr1, fr2, fr3);
}
int get_all_type_arg(int *tab, t_champ *champ, unsigned char *mem, int *err)
{
if (tab[0] == 0)
{
*err = -1;
return (-1);
}
else if (tab[0] == 2)
return (tab[2]);
else if (tab[0] == 1)
{
*err = (check_reg(tab[2]) == 1) ? *err : -1;
return ((check_reg(tab[2]) == 1) ? champ->reg[tab[2] - 1] : -1);
}
else
return (get_nbr_action(mem,
mod_mem(champ->pc + (tab[2] % IDX_MOD)), tab[1]));
}
static errno_t check_pl192_sanity(int iobase)
{
u_int32_t id = R32(iobase+VIC_REG_HID0);
if( (id & 0xFF) != 0x192 )
{
SHOW_ERROR( 0, "Part number is %x", id & 0xFF );
return ENXIO;
}
SHOW_INFO( 1, "Id is %x", id );
check_reg(iobase+VIC_REG_PCELLID0, 0x0D );
check_reg(iobase+VIC_REG_PCELLID1, 0xF0 );
check_reg(iobase+VIC_REG_PCELLID2, 0x05 );
check_reg(iobase+VIC_REG_PCELLID3, 0xB1 );
return 0;
}
static int
addr_reg(int reg) {
check_reg(reg);
if (regs[reg].store_type != TYPE_ADDRESS) {
print_dynamic_context();
fprintf(stderr, "register %d doesn't contain an address\n", reg);
found_error = TRUE;
}
return regs[reg].int_val;
}
static float
real_reg(int reg) {
check_reg(reg);
if (regs[reg].store_type != TYPE_REAL) {
print_dynamic_context();
fprintf(stderr, "register %d doesn't contain a real\n", reg);
found_error = TRUE;
}
return regs[reg].real_val;
}
static char *
string_reg(int reg) {
check_reg(reg);
if (regs[reg].store_type != TYPE_STRING) {
print_dynamic_context();
fprintf(stderr, "register %d doesn't contain a string\n", reg);
found_error = TRUE;
}
return regs[reg].string_val;
}
void my_sub(t_champ *champ, t_cor *cor)
{
int **tab;
tab = get_encode(cor->mem, champ->pc);
if (tab[0][0] == 1 && tab[1][0] == 1 && tab[2][0] == 1 &&
tab[3][0] == 0 && check_reg(tab[0][2]) == 1 &&
check_reg(tab[1][2]) == 1 && check_reg(tab[2][2]) == 1)
{
champ->carry = 1;
champ->reg[tab[2][2] - 1] = champ->reg[tab[0][2] - 1] -
champ->reg[tab[1][2] - 1];
champ->pc += 5;
}
else
{
my_none(champ, cor);
champ->carry = 0;
}
ifree(tab, 4);
}
void check_ld(char *args, char *cmd, t_label *list)
{
if (args[0] != '%' && (args[0] < '0' || args[0] > '9') && args[0] != '-')
printthiserror(cmd);
else if (args[1] == ':' && check_label_exist(list, copi_labelde(args)) != 1)
errorlabel(copi_labelde(args));
else if (args[1] != ':' && args[0] == '%')
{
if (args[1] < '0' || args[1] > '9' || args[1] == '-')
{
if (args[1] != '-')
errorvalue(args);
else if (args[2] < '0' || args[2] > '9')
errorvalue(args);
}
check_reg(args, cmd);
}
}
static u32 pmic_reg(struct pmic *p, u32 reg, u32 *val, u32 write)
{
u32 pmic_tx, pmic_rx;
u32 tmp;
if (!slave) {
slave = spi_setup_slave(p->bus, p->hw.spi.cs, p->hw.spi.clk,
p->hw.spi.mode);
if (!slave)
return -ENODEV;
}
if (check_reg(p, reg))
return -EINVAL;
if (spi_claim_bus(slave))
return -EBUSY;
pmic_tx = p->hw.spi.prepare_tx(reg, val, write);
tmp = cpu_to_be32(pmic_tx);
if (spi_xfer(slave, pmic_spi_bitlen, &tmp, &pmic_rx,
pmic_spi_flags))
goto err;
if (write) {
pmic_tx = p->hw.spi.prepare_tx(reg, val, 0);
tmp = cpu_to_be32(pmic_tx);
if (spi_xfer(slave, pmic_spi_bitlen, &tmp, &pmic_rx,
pmic_spi_flags))
goto err;
}
spi_release_bus(slave);
*val = cpu_to_be32(pmic_rx);
return 0;
err:
spi_release_bus(slave);
return -ENOTSUPP;
}
static u32 pmic_reg(struct pmic *p, u32 reg, u32 *val, u32 write)
{
u32 pmic_tx, pmic_rx;
u32 tmp;
if (!slave) {
slave = pmic_spi_probe(p);
if (!slave)
return -1;
}
if (check_reg(p, reg))
return -1;
if (spi_claim_bus(slave))
return -1;
pmic_tx = p->hw.spi.prepare_tx(reg, val, write);
tmp = cpu_to_be32(pmic_tx);
if (spi_xfer(slave, pmic_spi_bitlen, &tmp, &pmic_rx,
pmic_spi_flags)) {
spi_release_bus(slave);
return -1;
}
if (write) {
pmic_tx = p->hw.spi.prepare_tx(reg, val, 0);
tmp = cpu_to_be32(pmic_tx);
if (spi_xfer(slave, pmic_spi_bitlen, &tmp, &pmic_rx,
pmic_spi_flags)) {
spi_release_bus(slave);
return -1;
}
}
spi_release_bus(slave);
*val = cpu_to_be32(pmic_rx);
return 0;
}
static void ex_st(t_processes *current, int paff, int p[4], int ocp)
{
if (check_type(ocp, 4) == 'r' && check_reg(p[2]))
current->reg[p[2] - 1] = current->reg[p[1] - 1];
else
{
paff = p[2];
p[2] %= IDX_MOD;
p[2] += current->pc;
p[2] %= MEM_SIZE;
while (p[2] < 0)
p[2] += MEM_SIZE;
g_data->vm[p[2]] = current->reg[p[1] - 1] >> 24;
write_val(p[2], current->reg[p[1] - 1], current->player_id);
if (g_data->arg & 4 && !g_data->ncurse)
ft_printf("P%5d | st r%d %d\n",
current->id + 1, p[1], paff);
}
}
void f_ld(t_champion *ch, t_vm *vm, char **arg, char *type)
{
int arg1;
int val;
if ((type[0] == IND_CODE || type[0] == DIR_CODE) && type[1] == REG_CODE &&
check_reg(arg[1]))
{
val = convert(ch, vm, arg[0], type[0]);
arg1 = cast_int_frone(arg[1][0]) - 1;
ch->registre[arg1][0] = (char)(val >> 0);
ch->registre[arg1][1] = (char)(val >> 8);
ch->registre[arg1][2] = (char)(val >> 16);
ch->registre[arg1][3] = (char)(val >> 24);
if (val == 0)
ch->carry = 1;
else
ch->carry = 0;
}
void *proc_echo(void *cache){
int cnt;
Parket buf={0};
int fd=((Cache *)cache)->fd;
while(1){
cnt = read(fd,&buf,sizeof(Parket));
if(cnt == 0){
printf("client closed!\n");
break;
}else if(cnt == -1){
if(errno==EINTR){
continue;
}else{
break;
}
}else{
switch(buf.data_type){
case TYPE_REG:
check_reg(cache,&buf);
break;
case TYPE_LOGIN:
check_log(cache,&buf);
break;
case TYPE_HEART:
server_heart(cache);
break;
case TYPE_CMD:
execmd(&buf,cache);
case TYPE_EXIT:
check_exit(&buf,cache);
break;
default :
break;
}
}
}
close(fd);
return NULL;
}
void my_lld(t_champ *champ, t_cor *cor)
{
int **tab;
int arg;
int err;
tab = get_encode(cor->mem, champ->pc);
err = 0;
arg = get_dir_ind_arg_noidx(tab[0], champ, cor->mem, &err);
if (err != -1 && tab[1][0] == 1 && check_reg(tab[1][2]) == 1 &&
tab[2][0] == 0 && tab[3][0] == 0)
{
champ->carry = 1;
champ->reg[tab[1][2] - 1] = arg;
champ->pc += tab[0][1] + tab[1][1] + 2;
}
else
{
my_none(champ, cor);
champ->carry = 0;
}
ifree(tab, 4);
}
static void
execute_instr_at_pc(void) {
Instr *instr;
int i1, i2;
float r1, r2;
char *s1, *s2;
int l;
char *s;
const char *builtin_func;
int slot;
int offset;
char buf[1024];
if (print_instrs)
printf("instr %d, pc %d: ", cur_instr, pc);
instr = &instrs[pc];
switch (instr->opcode) {
case OP_PUSH_STACK_FRAME:
if (print_instrs)
printf("push_stack_frame %d\n", instr->int_const);
top_slot++;
if (stack_check_overflow())
break;
stack[top_slot].store_valid = TRUE;
stack[top_slot].store_type = TYPE_FRAME_SIZE;
stack[top_slot].int_val = cur_frame_size;
cur_frame_size = instr->int_const;
top_slot += instr->int_const;
if (stack_check_overflow())
break;
break;
case OP_POP_STACK_FRAME:
if (print_instrs)
printf("pop_stack_frame %d\n", instr->int_const);
if (instr->int_const != cur_frame_size) {
fprintf(stderr, "pop_stack_frame %d doesn't match "
"previous push_stack_frame %d\n",
instr->int_const, cur_frame_size);
found_error = TRUE;
break;
}
for (slot = 0; slot < instr->int_const; slot++)
stack_slot(slot).store_valid = FALSE;
top_slot -= instr->int_const;
cur_frame_size = stack[top_slot].int_val;
stack[top_slot].store_valid = FALSE;
top_slot--;
break;
case OP_LOAD:
if (print_instrs)
printf("load r%d, %d\n", instr->rd, instr->int_const);
check_slot(instr->int_const, TRUE, TRUE);
regs[instr->rd] = stack_slot(instr->int_const);
break;
case OP_STORE:
if (print_instrs)
printf("store %d, r%d\n", instr->int_const, instr->rs1);
check_reg(instr->rs1);
check_slot(instr->int_const, FALSE, TRUE);
stack_slot(instr->int_const) = regs[instr->rs1];
break;
case OP_LOAD_ADDRESS:
if (print_instrs)
printf("load_address r%d, %d\n", instr->rd, instr->int_const);
check_slot(instr->int_const, FALSE, TRUE);
set_reg_addr(instr->rd, top_slot - instr->int_const);
break;
case OP_LOAD_INDIRECT:
if (print_instrs)
printf("load_indirect r%d, r%d\n", instr->rd, instr->rs1);
offset = addr_reg(instr->rs1);
check_offset(offset, TRUE, TRUE); /* Must be valid */
regs[instr->rd] = stack[offset];
break;
case OP_STORE_INDIRECT:
if (print_instrs)
printf("store_indirect r%d, r%d\n", instr->rd, instr->rs1);
check_reg(instr->rs1);
offset = addr_reg(instr->rd);
check_offset(offset, FALSE, TRUE); /* Need not be valid */
stack[offset] = regs[instr->rs1];
break;
case OP_INT_CONST:
if (print_instrs)
printf("int_const r%d, %d\n", instr->rd, instr->int_const);
set_reg_int(instr->rd, instr->int_const);
break;
case OP_REAL_CONST:
if (print_instrs)
printf("real_const r%d, %f\n", instr->rd, instr->real_const);
set_reg_real(instr->rd, instr->real_const);
break;
case OP_STRING_CONST:
if (print_instrs)
printf("string_const r%d, %s\n", instr->rd, instr->string_const);
set_reg_string(instr->rd, make_string_const(instr->string_const));
break;
case OP_ADD_INT:
if (print_instrs)
printf("add_int r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
i1 = int_reg(instr->rs1);
i2 = int_reg(instr->rs2);
set_reg_int(instr->rd, i1 + i2);
break;
case OP_ADD_REAL:
if (print_instrs)
printf("add_real r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
r1 = real_reg(instr->rs1);
r2 = real_reg(instr->rs2);
set_reg_real(instr->rd, r1 + r2);
break;
case OP_ADD_OFFSET:
if (print_instrs)
printf("add_offset r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
offset = addr_reg(instr->rs1);
i2 = int_reg(instr->rs2);
offset += i2;
check_offset(offset, FALSE, TRUE);
set_reg_addr(instr->rd, offset);
break;
case OP_SUB_INT:
if (print_instrs)
printf("sub_int r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
i1 = int_reg(instr->rs1);
i2 = int_reg(instr->rs2);
set_reg_int(instr->rd, i1 - i2);
break;
case OP_SUB_REAL:
if (print_instrs)
printf("sub_real r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
r1 = real_reg(instr->rs1);
r2 = real_reg(instr->rs2);
set_reg_real(instr->rd, r1 - r2);
break;
case OP_SUB_OFFSET:
if (print_instrs)
printf("sub_offset r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
offset = addr_reg(instr->rs1);
i2 = int_reg(instr->rs2);
offset -= i2;
check_offset(offset, FALSE, TRUE);
set_reg_addr(instr->rd, offset);
break;
case OP_MUL_INT:
if (print_instrs)
printf("mul_int r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
i1 = int_reg(instr->rs1);
i2 = int_reg(instr->rs2);
set_reg_int(instr->rd, i1 * i2);
break;
case OP_MUL_REAL:
if (print_instrs)
printf("mul_real r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
r1 = real_reg(instr->rs1);
r2 = real_reg(instr->rs2);
set_reg_real(instr->rd, r1 * r2);
break;
case OP_DIV_INT:
if (print_instrs)
printf("div_int r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
i1 = int_reg(instr->rs1);
i2 = int_reg(instr->rs2);
set_reg_int(instr->rd, i1 / i2);
break;
case OP_DIV_REAL:
if (print_instrs)
printf("div_real r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
r1 = real_reg(instr->rs1);
r2 = real_reg(instr->rs2);
set_reg_real(instr->rd, r1 / r2);
break;
case OP_CMP_EQ_INT:
if (print_instrs)
printf("cmp_eq_int r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
i1 = int_reg(instr->rs1);
i2 = int_reg(instr->rs2);
set_reg_int(instr->rd, i1 == i2);
break;
case OP_CMP_NE_INT:
if (print_instrs)
printf("cmp_ne_int r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
i1 = int_reg(instr->rs1);
i2 = int_reg(instr->rs2);
set_reg_int(instr->rd, i1 != i2);
break;
case OP_CMP_GT_INT:
if (print_instrs)
printf("cmp_gt_int r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
i1 = int_reg(instr->rs1);
i2 = int_reg(instr->rs2);
set_reg_int(instr->rd, i1 > i2);
break;
case OP_CMP_GE_INT:
if (print_instrs)
printf("cmp_ge_int r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
i1 = int_reg(instr->rs1);
i2 = int_reg(instr->rs2);
set_reg_int(instr->rd, i1 >= i2);
break;
case OP_CMP_LT_INT:
if (print_instrs)
printf("cmp_lt_int r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
i1 = int_reg(instr->rs1);
i2 = int_reg(instr->rs2);
set_reg_int(instr->rd, i1 < i2);
break;
case OP_CMP_LE_INT:
if (print_instrs)
printf("cmp_le_int r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
i1 = int_reg(instr->rs1);
i2 = int_reg(instr->rs2);
set_reg_int(instr->rd, i1 <= i2);
break;
case OP_CMP_EQ_REAL:
if (print_instrs)
printf("cmp_eq_real r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
r1 = real_reg(instr->rs1);
r2 = real_reg(instr->rs2);
set_reg_int(instr->rd, r1 == r2);
break;
case OP_CMP_NE_REAL:
if (print_instrs)
printf("cmp_ne_real r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
r1 = real_reg(instr->rs1);
r2 = real_reg(instr->rs2);
set_reg_int(instr->rd, r1 != r2);
break;
case OP_CMP_GT_REAL:
if (print_instrs)
printf("cmp_gt_real r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
r1 = real_reg(instr->rs1);
r2 = real_reg(instr->rs2);
set_reg_int(instr->rd, r1 > r2);
break;
case OP_CMP_GE_REAL:
if (print_instrs)
printf("cmp_ge_real r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
r1 = real_reg(instr->rs1);
r2 = real_reg(instr->rs2);
set_reg_int(instr->rd, r1 >= r2);
break;
case OP_CMP_LT_REAL:
if (print_instrs)
printf("cmp_lt_real r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
r1 = real_reg(instr->rs1);
r2 = real_reg(instr->rs2);
set_reg_int(instr->rd, r1 < r2);
break;
case OP_CMP_LE_REAL:
if (print_instrs)
printf("cmp_le_real r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
r1 = real_reg(instr->rs1);
r2 = real_reg(instr->rs2);
set_reg_int(instr->rd, r1 <= r2);
break;
case OP_CMP_EQ_STRING:
if (print_instrs)
printf("cmp_eq_string r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
s1 = string_reg(instr->rs1);
s2 = string_reg(instr->rs2);
set_reg_int(instr->rd, strcmp(s1, s2) == 0);
break;
case OP_CMP_NE_STRING:
if (print_instrs)
printf("cmp_ne_string r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
s1 = string_reg(instr->rs1);
s2 = string_reg(instr->rs2);
set_reg_int(instr->rd, strcmp(s1, s2) != 0);
break;
case OP_CMP_GT_STRING:
if (print_instrs)
printf("cmp_gt_string r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
s1 = string_reg(instr->rs1);
s2 = string_reg(instr->rs2);
set_reg_int(instr->rd, strcmp(s1, s2) > 0);
break;
case OP_CMP_GE_STRING:
if (print_instrs)
printf("cmp_ge_string r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
s1 = string_reg(instr->rs1);
s2 = string_reg(instr->rs2);
set_reg_int(instr->rd, strcmp(s1, s2) >= 0);
break;
case OP_CMP_LT_STRING:
if (print_instrs)
printf("cmp_lt_string r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
s1 = string_reg(instr->rs1);
s2 = string_reg(instr->rs2);
set_reg_int(instr->rd, strcmp(s1, s2) < 0);
break;
case OP_CMP_LE_STRING:
if (print_instrs)
printf("cmp_le_string r%d, r%d, r%d\n",
instr->rd, instr->rs1, instr->rs2);
s1 = string_reg(instr->rs1);
s2 = string_reg(instr->rs2);
set_reg_int(instr->rd, strcmp(s1, s2) <= 0);
break;
case OP_AND:
if (print_instrs)
printf("and r%d, r%d, r%d\n", instr->rd, instr->rs1, instr->rs2);
i1 = int_reg(instr->rs1);
i2 = int_reg(instr->rs2);
set_reg_int(instr->rd, i1 && i2);
break;
case OP_OR:
if (print_instrs)
printf("or r%d, r%d, r%d\n", instr->rd, instr->rs1, instr->rs2);
i1 = int_reg(instr->rs1);
i2 = int_reg(instr->rs2);
set_reg_int(instr->rd, i1 || i2);
break;
case OP_NOT:
if (print_instrs)
printf("not r%d, r%d\n", instr->rd, instr->rs1);
i1 = int_reg(instr->rs1);
set_reg_int(instr->rd, !i1);
break;
case OP_BRANCH_UNCOND:
if (print_instrs)
printf("branch_uncond %s\n", instr->string_const);
next_pc = lookup_label(instr->string_const);
break;
case OP_BRANCH_ON_TRUE:
if (print_instrs)
printf("branch_on_true r%d, %s\n",
instr->rs1, instr->string_const);
i1 = int_reg(instr->rs1);
if (i1)
next_pc = lookup_label(instr->string_const);
break;
case OP_BRANCH_ON_FALSE:
if (print_instrs)
printf("branch_on_false r%d, %s\n",
instr->rs1, instr->string_const);
i1 = int_reg(instr->rs1);
if (! i1)
next_pc = lookup_label(instr->string_const);
break;
case OP_RETURN:
if (print_instrs)
printf("return\n");
check_slot(0, TRUE, FALSE);
if (stack_slot(0).store_type != TYPE_RETURN_ADDR) {
print_dynamic_context();
fprintf(stderr, "top of stack doesn't hold a return address\n");
found_error = TRUE;
}
next_pc = stack_slot(0).int_val;
top_slot--;
break;
case OP_CALL:
if (print_instrs)
printf("call %s\n", instr->string_const);
top_slot++;
if (stack_check_overflow())
break;
stack[top_slot].store_valid = TRUE;
stack[top_slot].store_type = TYPE_RETURN_ADDR;
stack[top_slot].int_val = next_pc;
next_pc = lookup_label(instr->string_const);
break;
case OP_CALL_BUILTIN:
if (instr->func >= FUNCOP_LAST)
report_error_and_exit("bad function in call");
builtin_func = func_names[instr->func];
if (print_instrs)
printf("call_builtin %s\n", builtin_func);
switch (instr->func) {
case FUNCOP_READ_INT:
init_all_regs();
if (scanf("%d", &i1) != 1)
report_error_and_exit("cannot read integer");
set_reg_int(0, i1);
break;
case FUNCOP_READ_REAL:
init_all_regs();
if (scanf("%f", &r1) != 1)
report_error_and_exit("cannot read real");
set_reg_real(0, r1);
break;
case FUNCOP_READ_BOOL:
init_all_regs();
if (scanf("%s", buf) != 1)
report_error_and_exit("cannot read bool");
if (streq(buf, "true"))
set_reg_int(0, 1);
else if (streq(buf, "false"))
set_reg_int(0, 0);
else
report_error_and_exit("read invalid bool");
break;
case FUNCOP_READ_STRING:
init_all_regs();
if (scanf("%s", buf) != 1)
report_error_and_exit("cannot read string");
set_reg_string(0, strdup(buf));
break;
case FUNCOP_PRINT_INT:
printf("%d", int_reg(0));
init_all_regs();
break;
case FUNCOP_PRINT_REAL:
printf("%f", real_reg(0));
init_all_regs();
break;
case FUNCOP_PRINT_BOOL:
printf("%s", int_reg(0) ? "true" : "false");
init_all_regs();
break;
case FUNCOP_PRINT_STRING:
printf("%s", string_reg(0));
init_all_regs();
break;
case FUNCOP_STRING_CONCAT:
s1 = string_reg(0);
s2 = string_reg(1);
l = (int) strlen(s1) + (int) strlen(s2) + 1;
s = checked_malloc(l);
s = strcpy(s, s1);
s = strcat(s, s2);
init_all_regs();
set_reg_string(0, s);
break;
case FUNCOP_STRING_LENGTH:
s1 = string_reg(0);
init_all_regs();
set_reg_int(0, (int) strlen(s1));
break;
case FUNCOP_SUBSTRING:
s1 = string_reg(0);
i1 = int_reg(1);
i2 = int_reg(2);
l = (int) strlen(s1) + 1;
s = checked_malloc(l);
if (i1 > l)
report_error_and_exit("substring: invalid start");
strcpy(s, s1 + i1);
l = l - i1;
if (i2 < l)
s[i2] = '\0';
init_all_regs();
set_reg_string(0, s);
break;
case FUNCOP_SQRT:
r1 = real_reg(0);
init_all_regs();
set_reg_real(0, (float) sqrt(r1));
break;
case FUNCOP_TRUNC:
r1 = real_reg(0);
init_all_regs();
set_reg_int(instr->rd, oztrunc(r1));
break;
case FUNCOP_ROUND:
r1 = real_reg(0);
init_all_regs();
set_reg_int(instr->rd, ozround(r1));
break;
case FUNCOP_LAST:
report_error_and_exit("call: invalid function");
}
break;
case OP_INT_TO_REAL:
if (print_instrs)
printf("int_to_real r%d, r%d\n", instr->rd, instr->rs1);
i1 = int_reg(instr->rs1);
set_reg_real(instr->rd, (float) i1);
break;
case OP_MOVE:
if (print_instrs)
printf("move r%d, r%d\n", instr->rd, instr->rs1);
set_reg_any(instr->rd, instr->rs1);
break;
case OP_DEBUG_REG:
if (print_instrs)
printf("debug_reg r%d\n", instr->rs1);
check_reg(instr->rs1);
if (quiet)
break;
switch (regs[instr->rs1].store_type) {
case TYPE_INT:
printf("register %d: %d\n", instr->rs1, int_reg(instr->rs1));
break;
case TYPE_REAL:
printf("register %d: %f\n", instr->rs1, real_reg(instr->rs1));
break;
case TYPE_ADDRESS:
printf("register %d: @%d\n", instr->rs1,
regs[instr->rs1].int_val);
break;
case TYPE_STRING:
printf("register %d: %s\n",
instr->rs1, string_reg(instr->rs1));
break;
default:
report_error_and_exit("invalid register type");
break;
}
break;
case OP_DEBUG_SLOT:
if (print_instrs)
printf("debug_slot %d\n", instr->int_const);
check_slot(instr->int_const, TRUE, TRUE);
if (quiet)
break;
switch (stack_slot(instr->int_const).store_type) {
case TYPE_INT:
printf("slot %d: %d\n",
instr->int_const, int_slot(instr->int_const));
break;
case TYPE_REAL:
printf("slot %d: %f\n",
instr->int_const, real_slot(instr->int_const));
break;
case TYPE_ADDRESS:
printf("slot %d: @%d\n",
instr->int_const, stack_slot(instr->int_const).int_val);
break;
case TYPE_STRING:
printf("slot %d: %s\n",
instr->int_const, string_slot(instr->int_const));
break;
case TYPE_FRAME_SIZE:
report_error_and_exit("frame size slot");
break;
case TYPE_RETURN_ADDR:
report_error_and_exit("return address slot");
break;
default:
report_error_and_exit("invalid slot type");
break;
}
break;
case OP_DEBUG_STACK:
if (print_instrs)
printf("debug_stack\n");
if (quiet)
break;
printf("\n");
printf("cur_frame_size = %d\n", cur_frame_size);
for (offset = 0; offset <= top_slot; offset++) {
if (! stack[offset].store_valid) {
printf("offset %d is invalid\n", offset);
continue;
}
switch (stack[offset].store_type) {
case TYPE_INT:
printf("offset %d: %d\n", offset, stack[offset].int_val);
break;
case TYPE_REAL:
printf("offset %d: %f\n", offset, stack[offset].real_val);
break;
case TYPE_ADDRESS:
printf("offset %d: @%d\n", offset, stack[offset].int_val);
break;
case TYPE_STRING:
printf("offset %d: %s\n", offset, stack[offset].string_val);
break;
case TYPE_FRAME_SIZE:
printf("offset %d: frame size %d\n",
offset, stack[offset].int_val);
break;
case TYPE_RETURN_ADDR:
printf("offset %d: return address %d\n",
offset, stack[offset].int_val);
break;
default:
report_error_and_exit("invalid slot type");
break;
}
}
printf("\n");
break;
case OP_HALT:
if (print_instrs)
printf("halt\n");
halted = TRUE;
break;
default:
report_internal_error_and_exit("unknown opcode");
break;
}
}
vm_value vm_execute(vm_instruction *program, int program_length, vm_value *ctable, int ctable_length) {
++invocation;
vm_state state0;
vm_state *state = &state0;
reset(state);
state->const_table = ctable;
state->const_table_length = ctable_length;
bool is_running = true;
restart:
while(is_running && state->program_pointer < program_length) {
is_running = true;
vm_value instr = program[state->program_pointer];
vm_opcode opcode = get_opcode(instr);
++state->program_pointer;
switch (opcode) {
case OP_LOAD_i: {
int reg0 = get_arg_r0(instr);
int val = get_arg_i(instr);
check_reg(reg0);
get_reg(reg0) = val;
}
break;
case OP_LOAD_ps: {
int reg0 = get_arg_r0(instr);
int value = get_arg_i(instr);
check_reg(reg0);
get_reg(reg0) = make_tagged_val(value, vm_tag_plain_symbol);
}
break;
case OP_LOAD_cs: {
int reg0 = get_arg_r0(instr);
int value = get_arg_i(instr);
check_reg(reg0);
get_reg(reg0) = make_tagged_val(value, vm_tag_compound_symbol);
}
break;
case OP_LOAD_os: {
int reg0 = get_arg_r0(instr);
int value = get_arg_i(instr);
check_reg(reg0);
get_reg(reg0) = make_tagged_val(value, vm_tag_opaque_symbol);
}
break;
case OP_LOAD_f: {
int reg0 = get_arg_r0(instr);
int value = get_arg_i(instr);
check_reg(reg0);
get_reg(reg0) = make_tagged_val(value, vm_tag_function);
}
break;
case OP_LOAD_str: {
int reg0 = get_arg_r0(instr);
int value = get_arg_i(instr);
check_reg(reg0);
get_reg(reg0) = make_tagged_val(value, vm_tag_string);
}
break;
case OP_ADD: {
int reg1 = get_arg_r1(instr);
int reg2 = get_arg_r2(instr);
check_reg(reg1);
int arg1 = get_reg(reg1);
check_reg(reg2);
int arg2 = get_reg(reg2);
int reg0 = get_arg_r0(instr);
if(get_tag(arg1) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(arg1));
}
else if(get_tag(arg2) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(arg2));
}
check_reg(reg0);
int result = ((arg1 - int_bias) + (arg2 - int_bias)) + int_bias;
if(result < min_biased_int || result > max_biased_int) {
fail("Int overflow");
}
get_reg(reg0) = result;
}
break;
case OP_SUB: {
int reg1 = get_arg_r1(instr);
int reg2 = get_arg_r2(instr);
check_reg(reg1);
int arg1 = get_reg(reg1);
check_reg(reg2);
int arg2 = get_reg(reg2);
int reg0 = get_arg_r0(instr);
if(get_tag(arg1) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(arg1));
}
if(get_tag(arg2) != vm_tag_number) {
fail("Expected a number, but got %s ", value_to_type_string(arg2));
}
check_reg(reg0);
int result = ((arg1 - int_bias) - (arg2 - int_bias)) + int_bias;
if(result < min_biased_int || result > max_biased_int) {
fail("Int overflow");
}
get_reg(reg0) = result;
}
break;
case OP_MUL: {
int reg1 = get_arg_r1(instr);
int reg2 = get_arg_r2(instr);
check_reg(reg1);
int arg1 = get_reg(reg1);
check_reg(reg2);
int arg2 = get_reg(reg2);
int reg0 = get_arg_r0(instr);
if(get_tag(arg1) != vm_tag_number) {
fail("Expected a number, but got %s ", value_to_type_string(arg1) );
}
if(get_tag(arg2) != vm_tag_number) {
fail("Expected a number, but got %s ", value_to_type_string(arg2) );
}
check_reg(reg0);
int result = ((arg1 - int_bias) * (arg2 - int_bias)) + int_bias;
if(result < min_biased_int || result > max_biased_int) {
panic_stop_vm_m("Int overflow");
}
get_reg(reg0) = result;
}
break;
case OP_DIV: {
int reg1 = get_arg_r1(instr);
int reg2 = get_arg_r2(instr);
check_reg(reg1);
int arg1 = get_reg(reg1);
check_reg(reg2);
int arg2 = get_reg(reg2);
if(arg2 == 0) {
fail("Division by 0");
}
if(get_tag(arg1) != vm_tag_number) {
fail("Expected a number, but got %s ", value_to_type_string(arg1) );
}
if(get_tag(arg2) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(arg2) );
}
int reg0 = get_arg_r0(instr);
check_reg(reg0);
int result = ((arg1 - int_bias) / (arg2 - int_bias)) + int_bias;
if(result < min_biased_int || result > max_biased_int) {
fail("Int overflow");
}
get_reg(reg0) = result;
}
break;
case OP_MOVE: {
int reg0 = get_arg_r0(instr);
int reg1 = get_arg_r1(instr);
check_reg(reg0);
check_reg(reg1);
get_reg(reg0) = get_reg(reg1);
}
break;
case OP_AP: {
if (state->stack_pointer + 1 == stack_size) {
fail("(call)!");
}
// this macro will create `return_pointer`
do_call((&next_frame), get_arg_r1(instr), instr);
if (call_failed) {
fail("call failed"); //TODO give a better error description
}
next_frame.return_address = return_pointer;
next_frame.result_register = get_arg_r0(instr);
++state->stack_pointer;
}
break;
case OP_TAIL_AP: {
do_call((¤t_frame), get_arg_r1(instr), instr);
if (call_failed) {
fail("call failed"); //TODO give a better error description
}
}
break;
case OP_GEN_AP: {
if (state->stack_pointer + 1 == stack_size) {
printf("Stack overflow (call cl)!");
panic_stop_vm();
}
int return_pointer = do_gen_ap(state, (&next_frame), instr, program);
if (return_pointer != -1) {
next_frame.return_address = return_pointer;
next_frame.result_register = get_arg_r0(instr);
++state->stack_pointer;
}
}
break;
// TODO It's not entirely clear yet what happens when this returns a new PAP
case OP_TAIL_GEN_AP: {
do_gen_ap(state, ¤t_frame, instr, program);
}
break;
op_ret:
case OP_RET: {
int return_val_reg = get_arg_r0(instr);
if (state->stack_pointer == 0) {
//We simply copy the result value to register 0, so that the runtime can find it
current_frame.reg[0] = current_frame.reg[return_val_reg];
is_running = false;
break;
}
--state->stack_pointer;
current_frame.reg[next_frame.result_register] = next_frame.reg[return_val_reg];
state->program_pointer = next_frame.return_address;
}
break;
case OP_JMP: {
int offset = get_arg_i(instr) - int_bias;
state->program_pointer += offset;
if(state->program_pointer < 0 || state->program_pointer > program_length) {
panic_stop_vm_m("Illegal address!");
}
}
break;
case OP_JMP_TRUE: {
check_reg(get_arg_r0(instr));
vm_value bool_value = get_reg(get_arg_r0(instr));
if( is_equal(state, bool_value, make_tagged_val(symbol_id_true, vm_tag_plain_symbol) )) {
int offset = get_arg_i(instr) - int_bias;
state->program_pointer += offset;
if(state->program_pointer < 0 || state->program_pointer > program_length) {
panic_stop_vm_m("Illegal address: %i", state->program_pointer);
}
}
// else: do nothing
}
break;
case OP_MATCH: {
check_reg(get_arg_r0(instr));
int subject = get_reg(get_arg_r0(instr));
check_reg(get_arg_r1(instr));
int patterns_addr = get_reg(get_arg_r1(instr));
int capture_reg = get_arg_r2(instr);
check_reg(capture_reg);
check_ctable_index(patterns_addr)
vm_value match_header = state->const_table[patterns_addr];
int number_of_patterns = from_match_value(match_header);
int i = 0;
for(i=0; i<number_of_patterns; ++i) {
int rel_pat_addr = patterns_addr + 1 + i;
check_ctable_index(rel_pat_addr)
vm_value pat = state->const_table[rel_pat_addr];
if(does_value_match(state, pat, subject, capture_reg)) {
break;
}
else {
continue;
}
}
if(i == number_of_patterns) {
throw("Pattern match failed!");
}
state->program_pointer += i;
}
break;
case OP_SET_ARG: {
int target_arg = get_arg_r0(instr);
int source_reg = get_arg_r1(instr);
int extra_amount = get_arg_r2(instr);
memcpy(&next_frame.reg[target_arg], ¤t_frame.reg[source_reg], (1 + extra_amount) * sizeof(vm_value));
}
break;
case OP_SET_CL_VAL: {
int cl_reg = get_arg_r0(instr);
check_reg(cl_reg);
vm_value closure = get_reg(cl_reg);
if( get_tag(closure) != vm_tag_pap ) {
fail("Expected a closure, but got %s", value_to_type_string(closure));
}
heap_address cl_address = get_val(closure);
check_reg(get_arg_r1(instr));
vm_value new_value = get_reg(get_arg_r1(instr));
int arg_index = get_arg_r2(instr);
vm_value *cl_pointer = heap_get_pointer(cl_address);
int header = *cl_pointer;
int num_env_args = pap_var_count(header);
if(arg_index >= num_env_args) {
panic_stop_vm_m("Illegal closure modification (index: %i, num env vars: %i)", arg_index, num_env_args);
}
cl_pointer[pap_header_size + arg_index] = new_value;
}
break;
case OP_PART_AP: {
int reg0 = get_arg_r0(instr);
int fun_reg = get_arg_r1(instr);
check_reg(fun_reg);
int func = get_reg(fun_reg);
if( get_tag(func) != vm_tag_function ) {
fail("Expected a function, but got %s", value_to_type_string(func));
}
int fun_address = get_val(func);
int num_args = get_arg_r2(instr);
vm_value fun_header = program[fun_address];
//TODO check that it's actually a function
int arity = get_arg_i(fun_header);
// TODO this was >= earlier, which apparently gave false positives. Find out why, and find out if > is the correct choice
if(num_args > arity) {
panic_stop_vm_m("Illegal partial application (num args: %i, arity: %i)", num_args, arity);
}
int pap_arity = arity - num_args;
build_pap(num_args, pap_arity, 0, num_args, fun_address);
check_reg(reg0);
get_reg(reg0) = pap_value;
}
break;
case OP_EQ: {
check_reg(get_arg_r1(instr));
check_reg(get_arg_r2(instr));
vm_value l = get_reg(get_arg_r1(instr));
vm_value r = get_reg(get_arg_r2(instr));
int result_reg = get_arg_r0(instr);
check_reg(result_reg);
if( is_equal(state, l, r)) {
get_reg(result_reg) = make_tagged_val(symbol_id_true, vm_tag_plain_symbol);
}
else {
get_reg(result_reg) = make_tagged_val(symbol_id_false, vm_tag_plain_symbol);
}
}
break;
case OP_LT: {
check_reg(get_arg_r1(instr));
check_reg(get_arg_r2(instr));
vm_value l = get_reg(get_arg_r1(instr));
vm_value r = get_reg(get_arg_r2(instr));
int result_reg = get_arg_r0(instr);
check_reg(result_reg);
if(get_tag(l) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(l));
}
else if(get_tag(r) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(r));
}
if( l < r) {
get_reg(result_reg) = make_tagged_val(symbol_id_true, vm_tag_plain_symbol);
}
else {
get_reg(result_reg) = make_tagged_val(symbol_id_false, vm_tag_plain_symbol);
}
}
break;
case OP_GT: {
check_reg(get_arg_r1(instr));
check_reg(get_arg_r2(instr));
vm_value l = get_reg(get_arg_r1(instr));
vm_value r = get_reg(get_arg_r2(instr));
int result_reg = get_arg_r0(instr);
check_reg(result_reg);
if(get_tag(l) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(l));
}
else if(get_tag(r) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(r));
}
if( l > r) {
get_reg(result_reg) = make_tagged_val(symbol_id_true, vm_tag_plain_symbol);
}
else {
get_reg(result_reg) = make_tagged_val(symbol_id_false, vm_tag_plain_symbol);
}
}
break;
case OP_COPY_SYM: {
check_reg(get_arg_r0(instr));
check_reg(get_arg_r1(instr));
vm_value const_symbol = get_reg(get_arg_r1(instr));
if ( get_tag(const_symbol) != vm_tag_compound_symbol ) {
panic_stop_vm_m("Expected a const symbol, but got %s", value_to_type_string(const_symbol));
}
int c_addr = get_val(const_symbol);
vm_value c_sym_header = state->const_table[c_addr];
int count = compound_symbol_count(c_sym_header);
size_t total_size = compound_symbol_header_size + count;
heap_address dyn_sym_address = heap_alloc(total_size);
vm_value *sym_pointer = heap_get_pointer(dyn_sym_address); \
memcpy(sym_pointer, &(state->const_table[c_addr]), total_size * sizeof(vm_value));
get_reg(get_arg_r0(instr)) = make_tagged_val(dyn_sym_address, vm_tag_dynamic_compound_symbol);
}
break;
case OP_SET_SYM_FIELD: {
check_reg(get_arg_r0(instr));
check_reg(get_arg_r1(instr));
vm_value heap_symbol = get_reg(get_arg_r0(instr));
if ( get_tag(heap_symbol) != vm_tag_dynamic_compound_symbol ) {
panic_stop_vm_m("Expected a dynamic symbol, but got %s", value_to_type_string(heap_symbol));
}
int h_addr = get_val(heap_symbol);
vm_value *p = heap_get_pointer(h_addr);
vm_value h_sym_header = *p;
int count = compound_symbol_count(h_sym_header);
int index = get_arg_r2(instr);
if(index < 0 || index >= count) {
panic_stop_vm_m("Illegal index while setting symbol field: %d", index);
}
p[compound_symbol_header_size + index] = get_reg(get_arg_r1(instr));
}
break;
case OP_STR_LEN: {
check_reg(get_arg_r0(instr));
check_reg(get_arg_r1(instr));
vm_value str = get_reg(get_arg_r1(instr));
int tag = get_tag(str);
if (tag != vm_tag_string && tag != vm_tag_dynamic_string ) {
fail("Expected a string, but got %s", value_to_type_string(str));
}
int str_addr = get_val(str);
vm_value *str_pointer;
if(tag == vm_tag_string) {
str_pointer = state->const_table + str_addr;
}
else {
str_pointer = heap_get_pointer(str_addr);
}
vm_value str_header = *str_pointer;
int count = string_length(str_header);
get_reg(get_arg_r0(instr)) = make_tagged_val(count + int_bias, vm_tag_number);
}
break;
case OP_NEW_STR: {
int result_reg = get_arg_r0(instr);
check_reg(result_reg);
check_reg(get_arg_r1(instr));
vm_value length_value = get_reg(get_arg_r1(instr));
if(get_tag(length_value) != vm_tag_number) {
panic_stop_vm_m("Expected a number, but got %s", value_to_type_string(length_value));
}
int length = length_value - int_bias;
if(length < 0) {
panic_stop_vm_m("Negative length for new string, got: %d", length);
}
int adjusted_length = length + 1; // allow space for trailing '\0'
int num_chunks = adjusted_length / char_per_string_chunk;
if( (adjusted_length % char_per_string_chunk) != 0 ) {
num_chunks += char_per_string_chunk - (adjusted_length % char_per_string_chunk);
}
size_t total_size = string_header_size + num_chunks;
heap_address string_address = heap_alloc(total_size);
vm_value *str_pointer = heap_get_pointer(string_address);
memset(str_pointer, 0, total_size * sizeof(vm_value));
*str_pointer = string_header(length, num_chunks);
get_reg(result_reg) = make_tagged_val(string_address, vm_tag_dynamic_string);
}
break;
case OP_GET_CHAR: {
int result_reg = get_arg_r0(instr);
check_reg(result_reg);
check_reg(get_arg_r1(instr));
check_reg(get_arg_r2(instr));
vm_value str = get_reg(get_arg_r1(instr));
vm_value str_tag = get_tag(str);
if(str_tag != vm_tag_string && str_tag != vm_tag_dynamic_string) {
panic_stop_vm_m("Expected a string, but got %s", value_to_type_string(str));
}
int str_addr = get_val(str);
vm_value *str_pointer;
if(str_tag == vm_tag_string) {
str_pointer = state->const_table + str_addr;
}
else {
str_pointer = heap_get_pointer(str_addr);
}
vm_value str_header = *str_pointer;
int index = get_reg(get_arg_r2(instr)) - int_bias;
int str_length = string_length(str_header);
if(index < 0 || index > str_length) {
panic_stop_vm_m("Illegal string index: %d", index);
}
char *char_pointer = (char *) (str_pointer + string_header_size);
int character = char_pointer[index];
get_reg(result_reg) = make_tagged_val(character, vm_tag_number);
}
break;
case OP_PUT_CHAR: {
check_reg(get_arg_r0(instr));
check_reg(get_arg_r1(instr));
check_reg(get_arg_r2(instr));
vm_value str = get_reg(get_arg_r1(instr));
vm_value str_tag = get_tag(str);
if(str_tag != vm_tag_dynamic_string) {
panic_stop_vm_m("Expected a dynamic string, but got %s", value_to_type_string(str));
}
int character = get_reg(get_arg_r0(instr));
if(get_tag(character) != vm_tag_number) {
panic_stop_vm_m("Expected a number, but got %s", value_to_type_string(character));
}
int str_addr = get_val(str);
vm_value *str_pointer = heap_get_pointer(str_addr);
vm_value str_header = *str_pointer;
int index = get_reg(get_arg_r2(instr)) - int_bias;
int str_length = string_length(str_header);
if(index < 0 || index > str_length) {
panic_stop_vm_m("Illegal string index: %d", index);
}
char *char_pointer = (char *) (str_pointer + string_header_size);
char_pointer[index] = (char) character;
}
break;
case OP_OR: {
int reg1 = get_arg_r1(instr);
int reg2 = get_arg_r2(instr);
check_reg(reg1);
int arg1 = get_reg(reg1);
check_reg(reg2);
int arg2 = get_reg(reg2);
int reg0 = get_arg_r0(instr);
check_reg(reg0);
vm_value result = make_tagged_val(symbol_id_false, vm_tag_plain_symbol);
vm_value true_sym = make_tagged_val(symbol_id_true, vm_tag_plain_symbol);
if(arg1 == true_sym || arg2 == true_sym) {
result = true_sym;
}
get_reg(reg0) = result;
}
break;
case OP_AND: {
int reg1 = get_arg_r1(instr);
int reg2 = get_arg_r2(instr);
check_reg(reg1);
int arg1 = get_reg(reg1);
check_reg(reg2);
int arg2 = get_reg(reg2);
int reg0 = get_arg_r0(instr);
check_reg(reg0);
vm_value result = make_tagged_val(symbol_id_false, vm_tag_plain_symbol);
vm_value true_sym = make_tagged_val(symbol_id_true, vm_tag_plain_symbol);
if(arg1 == true_sym && arg2 == true_sym) {
result = true_sym;
}
get_reg(reg0) = result;
}
break;
case OP_NOT: {
int reg1 = get_arg_r1(instr);
check_reg(reg1);
int arg1 = get_reg(reg1);
int reg0 = get_arg_r0(instr);
check_reg(reg0);
vm_value result = make_tagged_val(symbol_id_false, vm_tag_plain_symbol);
vm_value true_sym = make_tagged_val(symbol_id_true, vm_tag_plain_symbol);
if(arg1 != true_sym) {
result = true_sym;
}
//else: result is already set to false
get_reg(reg0) = result;
}
break;
case OP_GET_FIELD: {
int result_reg = get_arg_r0(instr);
int obj_reg = get_arg_r1(instr);
int sym_reg = get_arg_r2(instr);
check_reg(result_reg);
check_reg(obj_reg);
check_reg(sym_reg);
vm_value obj_ref = get_reg(obj_reg);
vm_value requested_name = get_reg(sym_reg);
if(get_tag(requested_name) != vm_tag_plain_symbol) {
panic_stop_vm_m("Malformed lookup!");
}
vm_value obj_header = 0;
vm_value *obj_fields = 0;
if(get_tag(obj_ref) == vm_tag_opaque_symbol) {
int obj_addr = get_val(obj_ref);
vm_value *obj_pointer = state->const_table + obj_addr;
vm_value obj_owner = obj_pointer[1];
if(obj_owner != make_tagged_val(0, vm_tag_plain_symbol)) {
panic_stop_vm_m("Malformed module!");
}
obj_header = obj_pointer[0];
obj_fields = obj_pointer + 2;
}
// TODO this branch is untested, as records are apparently always dynamic in this case (?!)
else if(get_tag(obj_ref) == vm_tag_compound_symbol) {
int obj_addr = get_val(obj_ref);
vm_value *obj_pointer = state->const_table + obj_addr;
obj_header = obj_pointer[0];
if(compound_symbol_id(obj_header) != symbol_id_record) {
fail("Expected a module or record, got %s", value_to_type_string(obj_ref));
}
obj_fields = obj_pointer + 1;
}
else if(get_tag(obj_ref) == vm_tag_dynamic_compound_symbol) {
int obj_addr = get_val(obj_ref);
vm_value *obj_pointer = heap_get_pointer(obj_addr);
//vm_value *obj_pointer = state->const_table + obj_addr;
obj_header = obj_pointer[0];
obj_fields = obj_pointer + 1;
if(compound_symbol_id(obj_header) != symbol_id_record) {
fail("Expected a module or record, got %s", value_to_type_string(obj_ref));
}
}
else {
// exits subroutine here
fail("Expected a module or record, got %s", value_to_type_string(obj_ref));
}
int num_symbol_fields = compound_symbol_count(obj_header);
bool found = false;
for(int i=0; i < num_symbol_fields; i += 2) {
vm_value name = obj_fields[i];
if(name == requested_name) {
get_reg(result_reg) = obj_fields[i+1];
found = true;
break;
}
}
if(found == false) {
//TODO change this to built-in nil type
get_reg(result_reg) = make_tagged_val(symbol_id_nil, vm_tag_plain_symbol);
}
}
break;
case OP_CONVERT: {
int result_reg = get_arg_r0(instr);
int source_reg = get_arg_r1(instr);
int type_reg = get_arg_r2(instr);
check_reg(result_reg);
check_reg(source_reg);
check_reg(type_reg);
vm_value source = get_reg(source_reg);
vm_value target_type = get_reg(type_reg);
if(get_tag(target_type) != vm_tag_plain_symbol) {
fail("Expected a symbol, got %s", value_to_type_string(target_type));
}
vm_value target_type_id = get_val(target_type);
vm_value result;
switch(target_type_id) {
case symbol_id_number:
result = convert_to_number(state, source);
break;
case symbol_id_string:
result = convert_to_string(state, source);
break;
default:
result = make_str_error("Unable to convert value");
}
get_reg(result_reg) = result;
}
break;
default:
panic_stop_vm_m("UNKNOWN OPCODE: %04x", opcode);
}
}
vm_value result = state->stack[state->stack_pointer].reg[0];
vm_value io_result_value = 0;
vm_value next_action;
io_action_result action_result = check_io_action(state, result, program, &io_result_value, &next_action);
switch(action_result) {
case no_io_action:
// do nothing
break;
case intermediary_io_action: {
state->stack_pointer = 0;
current_frame.reg[0] = next_action;
next_frame.reg[0] = io_result_value; // argument for next_action
vm_instruction instr = op_gen_ap(0, 0, 1);
int return_pointer = do_gen_ap(state, ¤t_frame, instr, program);
if (return_pointer != -1) {
current_frame.return_address = return_pointer;
current_frame.result_register = 0;
}
else {
// TODO is this malformed?
panic_stop_vm_m("malformed bound lambda in io action");
}
is_running = true;
}
goto restart;
case final_io_action:
result = io_result_value;
break;
default:
panic_stop_vm_m("Unknown result of io action: %d", action_result);
}
return result;
}
// TODO can we inline this?
// TODO document the algorithm
bool does_value_match(vm_state *state, vm_value pattern, vm_value subject, int start_register) {
vm_value pattern_tag = get_tag(pattern);
//if bit 27 (NUM_REGS - 5) is set, this is a match header, otherwise it is a variable
bool is_match_var = !(pattern & 0x8000000);
if(pattern_tag == vm_tag_match_data && is_match_var) {
//capturing match
int relative_reg = from_match_value(pattern);
if(relative_reg != match_wildcard_value) {
check_reg(start_register + relative_reg);
get_reg(start_register + relative_reg) = subject;
}
return true;
}
vm_value subject_tag = get_tag(subject);
if(pattern_tag != vm_tag_compound_symbol
&& pattern_tag != subject_tag) {
return false;
}
switch(pattern_tag) {
case vm_tag_number:
case vm_tag_plain_symbol:
return pattern == subject;
case vm_tag_compound_symbol: {
if(subject_tag != vm_tag_compound_symbol
&& subject_tag != vm_tag_dynamic_compound_symbol) {
return false;
}
vm_value pattern_address = get_val(pattern);
check_ctable_index(pattern_address)
vm_value pattern_header = state->const_table[pattern_address];
vm_value pattern_id = compound_symbol_id(pattern_header);
vm_value subject_address = get_val(subject);
vm_value *subject_pointer;
if(subject_tag == vm_tag_compound_symbol) {
check_ctable_index(subject_address)
subject_pointer = &state->const_table[subject_address];
}
else {
subject_pointer = heap_get_pointer(subject_address);
}
vm_value subject_header = subject_pointer[0];
vm_value subject_id = compound_symbol_id(subject_header);
if(pattern_id != subject_id) {
return false;
}
vm_value pattern_count = compound_symbol_count(pattern_header);
vm_value subject_count = compound_symbol_count(subject_header);
if(pattern_count != subject_count) {
return false;
}
int i = 0;
for(; i<pattern_count; ++i) {
int rel_pattern_address = pattern_address + compound_symbol_header_size + i;
int rel_subject_address = compound_symbol_header_size + i;
check_ctable_index(rel_pattern_address);
//check_ctable_index(rel_subject_address);
if( !does_value_match(state, state->const_table[rel_pattern_address], subject_pointer[rel_subject_address], start_register) ) {
return false;
}
}
return true;
}
default:
return false;
}
}
/*
How to handle oversaturated calls:
When a call is oversaturated, we set up the first call as usual. All additional
arguments are stored on the heap, with a very simple format: First word is the
number of stored arguments, followed by the arguments we want to store away. The
heap address of that arg array is stored in a special field in the frame.
The call is instructed to return to the gen_ap call. The result will be stored in
the calls result register (which is the only safe place to store it).
When returning to the gen_ap instruction, the field for oversaturated calls is checked.
If it is set, the arguments are copied to the next_frame and the number of arguments
is set to the number of arguments we had stored. The frame field for oversaturated calls
is reset to 0.
After this the call proceeds as usual, possibly leading to another oversaturated call.
*/
int do_gen_ap(vm_state *state, stack_frame *frame, vm_value instr, vm_instruction *program) {
// TODO remove code duplication (in here, stack push, etc)
// TODO find a better term for "function or closure" than lambda
int lambda_reg = get_arg_r1(instr);
int num_args = get_arg_r2(instr);
// Check whether we are currently applying an oversaturated call
if(current_frame.spilled_arguments != 0) {
vm_value *addr = heap_get_pointer(current_frame.spilled_arguments);
num_args = compound_symbol_count(*addr);
memcpy(next_frame.reg, addr + 1, num_args * sizeof(vm_value));
lambda_reg = get_arg_r0(instr);
current_frame.spilled_arguments = 0;
}
check_reg(lambda_reg);
vm_value lambda = get_reg(lambda_reg);
vm_value tag = get_tag(lambda);
if(tag == vm_tag_pap ) {
heap_address cl_address = (heap_address)get_val(lambda);
vm_value *cl_pointer = heap_get_pointer(cl_address);
int header = *cl_pointer;
int arity = pap_arity(header);
int num_cl_vars = pap_var_count(header);
// Saturated closure application
if (num_args == arity) {
memmove(&(frame->reg[num_cl_vars]), next_frame.reg, num_args * sizeof(vm_value));
memcpy(&(frame->reg[0]), cl_pointer + pap_header_size, num_cl_vars * sizeof(vm_value));
// do the call
vm_value fun_address = *(cl_pointer + 1);
int return_pointer = state->program_pointer;
state->program_pointer = fun_address + fun_header_size;
return return_pointer;
}
// Undersaturated closure application
else if (num_args < arity) {
// create a new PAP by copying the old one and adding the new arguments
vm_value fun_address = *(cl_pointer + 1);
vm_value reg0 = get_arg_r0(instr);
int num_pap_args = num_cl_vars + num_args;
int pap_arity = arity - num_args;
int offset = num_cl_vars;
build_pap(num_pap_args, pap_arity, offset, num_args, fun_address)
memcpy(pap_pointer + pap_header_size, cl_pointer + pap_header_size, num_cl_vars * sizeof(vm_value));
check_reg(reg0);
get_reg(reg0) = pap_value;
return -1;
}
// Oversaturated closure application
else { // num_args > arity
prep_oversaturated_call(arity, num_args)
// set arguments
memmove(&(next_frame.reg[num_cl_vars]), &(next_frame.reg[0]), arity * sizeof(vm_value));
memcpy(&(next_frame.reg[0]), cl_pointer + pap_header_size, num_cl_vars * sizeof(vm_value));
// do the call
vm_value fun_address = *(cl_pointer + 1);
state->program_pointer = fun_address + fun_header_size;
++state->stack_pointer;
return -1;
}
}
else if (tag == vm_tag_function) {
int fun_address = get_val(lambda);
vm_instruction fun_header = program[fun_address];
//TODO check fun header "opcode"
int arity = get_arg_i(fun_header);
// saturated function application
if (num_args == arity) {
do_call(frame, lambda_reg, instr);
if(call_failed) {
fprintf(stderr, "Call failed (not a function)\n");
return -1; //TODO exit here?
}
return return_pointer;
}
// Unsersaturated function application
else if (num_args < arity) {
//vm_value fun_header = program[fun_address];
//TODO check that it's actually a function
vm_value reg0 = get_arg_r0(instr);
int pap_arity = arity - num_args;
build_pap(num_args, pap_arity, 0, num_args, fun_address)
check_reg(reg0);
get_reg(reg0) = pap_value;
return -1;
}
// Oversaturated function application
else {
prep_oversaturated_call(arity, num_args)
do_call((&next_frame), lambda_reg, instr);
++state->stack_pointer;
return -1;
}
}
else {
fprintf(stderr, "Expected a function, but got %s \n", value_to_type_string(lambda));
//exit(-1);
}
return -1;
}
