/*** if * Conditional form. Accepts exactly three arguments. First feeds its input * to the first argument. If the result is boolean True, it feeds the input to * its second argument, if False then it feeds it to its third argument, * otherwise it just returns Bottom. * * if{ f, g, h } : x = if f : x then g : x else h : x */ struct value *iff(struct list *args, struct value *in) { struct value *test = value_copy(in); struct value *out = NULL; // Checking for correct number of arguments if(args->count != 3) { value_delete(test); value_delete(in); return value_new(); } // Testing input with first argument test = function_exec(list_get(args, 0), test); if(test->type == BOOL_VAL) { if(test->data.bool_val) { value_delete(test); return function_exec(list_get(args, 1), in); } else { value_delete(test); return function_exec(list_get(args, 2), in); } } else { value_delete(in); return value_new(); } }
/*** map * Mapping functional form. Accepts a single function argument. Input to the * form should always be in the form of a list, and the return value will be * the result of applying the argument function to each element in the list. * * map{ f } : < x, y, z > = < f : x, f : y, f : z > */ struct value *map(struct list *args, struct value *in) { struct value *out = NULL; struct function *f = list_get(args, 0); struct list *l = NULL; struct cursor *c; // First ensure valid input if(args->count != 1 || in->type != SEQ_VAL) { value_delete(in); return value_new(); } // Otherwise create an output list by applying f to each element of in out = value_new(); out->type = SEQ_VAL; out->data.seq_val = list_new(); l = in->data.seq_val; for(c = cursor_new_front(l); cursor_valid(c); cursor_next(c)) list_push_back(out->data.seq_val, function_exec(f, value_copy(cursor_get(c)))); value_delete(in); cursor_delete(c); return out; }
static void value_delete (struct value *v) { if (v->parent) { switch (v->parent->type) { case NCDVALUE_LIST: { value_list_remove(v->parent, v); } break; case NCDVALUE_MAP: { value_map_remove(v->parent, v); } break; default: ASSERT(0); } } LinkedList0Node *ln; while (ln = LinkedList0_GetFirst(&v->refs_list)) { struct instance *inst = UPPER_OBJECT(ln, struct instance, refs_list_node); ASSERT(inst->v == v) LinkedList0_Remove(&v->refs_list, &inst->refs_list_node); inst->v = NULL; } switch (v->type) { case NCDVALUE_STRING: { free(v->string.string); } break; case NCDVALUE_LIST: { while (value_list_len(v) > 0) { struct value *ev = value_list_at(v, 0); value_delete(ev); } } break; case NCDVALUE_MAP: { while (value_map_len(v) > 0) { struct value *ev = value_map_at(v, 0); value_delete(ev); } } break; default: ASSERT(0); } free(v); }
// Deletes every value in a list void clear_value_list(struct list *args) { struct cursor *c = NULL; for(c = cursor_new_front(args); cursor_valid(c); cursor_next(c)) if(cursor_get(c)) value_delete(cursor_get(c)); list_delete(args); cursor_delete(c); }
/*** reduce * Reducing functional form. Accepts a single function argument. Expects * input in the form of a list, return value is the result of first applying * the argument function to a pair formed from the first two elements of the * input list, then forming a new pair from that result and the next * right-most element, and so on until the list is exhausted. * * reduce{ f } : < x, y, z > = f : < f : < x, y>, z > */ struct value *reduce(struct list *args, struct value *in) { struct value *out = value_new(); struct value *v = NULL; struct function *f = list_get(args, 0); int i = 0; // Check for valid input if (args->count != 1 || in->type != SEQ_VAL || in->data.seq_val->count < 2) { value_delete(in); return out; } // Setting up initial pair out->type = SEQ_VAL; out->data.seq_val = list_new(); list_push_back(out->data.seq_val, value_copy(list_get(in->data.seq_val, 0))); list_push_back(out->data.seq_val, value_copy(list_get(in->data.seq_val, 1))); // Pairing up elements and feeding them to f for (i = 2; i <= in->data.seq_val->count; i++) { out = function_exec(f, out); if (i < in->data.seq_val->count) { v = value_new(); v->type = SEQ_VAL; v->data.seq_val = list_new(); list_push_back(v->data.seq_val, out); list_push_back(v->data.seq_val, value_copy(list_get(in->data.seq_val, i))); out = v; } } value_delete(in); return out; }
/*** construct * Sequence construction. Feeds its input to each of its argument functions, * and generate a sequence where each element is the output of one of the * argument functions. * * construct{ f, g } : x = < f : x, g : x > */ struct value *construct(struct list *args, struct value *in) { struct value *out = value_new(); struct cursor *c = NULL; out->type = SEQ_VAL; out->data.seq_val = list_new(); for(c = cursor_new_front(args); cursor_valid(c); cursor_next(c)) { list_push_back(out->data.seq_val, function_exec(cursor_get(c), value_copy(in))); } value_delete(in); cursor_delete(c); return out; }
// Parses a constant struct value *parse_constant(struct lexer_state *lexer) { struct value *arg = value_new(); // First grab the next token lex(lexer); if(lexer->error == END_OF_INPUT) { print_error(lexer, UNEXPECTED_END); value_delete(arg); return NULL; } if(lexer->error == UNRECOGNIZED_TOKEN) { print_error(lexer, LEX_ERROR); value_delete(arg); return NULL; } switch(lexer->type) { case BOTTOM: arg->type = BOTTOM_VAL; break; case INT: arg->type = INT_VAL; arg->data.int_val = lexer->value.ival; break; case FLOAT: arg->type = FLOAT_VAL; arg->data.float_val = lexer->value.fval; break; case TRUE: arg->type = BOOL_VAL; arg->data.bool_val = 1; break; case FALSE: arg->type = BOOL_VAL; arg->data.bool_val = 0; break; case CHAR: arg->type = CHAR_VAL; arg->data.char_val = lexer->value.cval; break; case STRING: arg->type = STRING_VAL; arg->data.str_val = strdup(lexer->value.sval); break; case OPEN_SEQ: arg->type = SEQ_VAL; arg->data.seq_val = parse_constant_args(lexer, CLOSE_SEQ); if(!arg->data.seq_val) { value_delete(arg); return NULL; } break; default: print_error(lexer, EXPECTED_CONST); value_delete(arg); return NULL; } return arg; }
/* Invoke the argument FTL function with <addr> <buf> arguments for each of the ELF file's program segments */ static const value_t * elf_load_with_fn(const value_t *this_fn, parser_state_t *state, const char *filename, int binfd, Elf *e, GElf_Ehdr *ehdr, void *arg) { elf_loadfn_args_t *fnarg = (elf_loadfn_args_t *)arg; const value_t *hdrcheckfn = fnarg->hdrcheckfn; const value_t *memwrfn = fnarg->memwrfn; const value_t *resval = value_false; size_t n; if (elf_getphdrnum(e, &n) != 0) parser_report(state, "ELF file has unknown number of segments - %s\n", elf_errmsg(-1)); else { size_t i; bool ok = FALSE; if (hdrcheckfn != NULL) { const value_t *ehdrval = elf_get_ehdr(this_fn, state, filename, binfd, e, ehdr, /*arg*/NULL); if (ehdrval != NULL) { const value_t *code = value_closure_bind(hdrcheckfn, ehdrval); if (code == NULL) { parser_error(state, "couldn't apply " "header argument to check function\n"); } else { const value_t *fnres = invoke(code, state); /* we expect this to return a TRUE/FALSE value */ ok = (fnres == value_true); /*if (!ok) printf("%s: check fn returns non-TRUE\n", codeid());*/ } } } else ok = TRUE; resval = ok? value_true: value_false; if (ok && memwrfn != NULL) { for (i = 0; ok && i < n; i++) { GElf_Phdr phdr; if (gelf_getphdr(e, i, &phdr) != &phdr) parser_report(state, "ELF segment %d unretrievable - %s\n", i, elf_errmsg(-1)); else { long offset = (long)phdr.p_offset; if (phdr.p_offset != (Elf64_Off)offset) parser_report(state, "ELF segment %d - " "offset does not fit in 32-bits\n", i); else if (-1 == fe_lseek(binfd, offset)) parser_report(state, "ELF segment %d - " "offset 0X%lX is outside file\n", i, offset); else if (phdr.p_memsz < phdr.p_filesz) parser_report(state, "ELF segment %d - smaller size in memory (%d)" "than on file (%d) - corrupt header?\n", i, phdr.p_memsz, phdr.p_filesz); else { number_t addr = phdr.p_vaddr; /* where to load segment */ char *buf = NULL; size_t buflen = (size_t)phdr.p_memsz; value_t *addrval = value_int_new(addr); value_t *dataval = value_string_alloc_new(buflen, &buf); if (phdr.p_memsz != (Elf64_Xword)buflen) parser_report(state, "ELF segment %d - " "size does not fit in 32-bits\n", i); else if (dataval == NULL) parser_report(state, "ELF segment %d - no memory for " "next %d bytes\n", i, buflen); else { ssize_t readbytes = fe_read(binfd, buf, buflen); if (readbytes < buflen) parser_report(state, "ELF segment %d - " "only %d bytes of %d read\n", i, readbytes); else { const value_t *code; ok = TRUE; /* zero any uninitialized area */ if (phdr.p_memsz > phdr.p_filesz) { size_t extra_bytes = (size_t) (phdr.p_memsz - phdr.p_filesz); if ((Elf64_Xword)extra_bytes != phdr.p_memsz-phdr.p_filesz) { ok = FALSE; parser_report(state, "ELF segment %d - " "BSS area larger than 32-bits\n", i); } else memset(&buf[phdr.p_filesz], '\0', extra_bytes); } code = value_closure_bind_2(state, memwrfn, "address", addrval, "data", dataval); if (NULL != code) { const value_t *fnres = invoke(code, state); /* we expect this to return a TRUE/FALSE value */ if (fnres != value_true) { /*printf("%s: seg fn returns non-TRUE\n", codeid());*/ ok = FALSE; } /* we rely on garbage collection to collect the data * buffer */ } else value_delete(&dataval); } } } } } if (!ok) resval = value_false; } } return resval; }