exprtree*
make_if_then_else (exprtree *condition, exprtree *consequent, exprtree *alternative)
{
exprtree *tree = alloc_exprtree();
if (condition->result.length != 1)
{
sprintf(error_string, _("Condition to if statement must have length 1."));
error_region = condition->region;
JUMP(1);
}
if (consequent->result.number != alternative->result.number
|| consequent->result.length != alternative->result.length)
{
sprintf(error_string, _("Consequent and alternative must have the same type in if statement."));
error_region = scanner_region_merge(consequent->region, alternative->region);
JUMP(1);
}
tree->type = EXPR_IF_THEN_ELSE;
tree->val.ifExpr.condition = condition;
tree->val.ifExpr.consequent = consequent;
tree->val.ifExpr.alternative = alternative;
tree->result = consequent->result;
tree->region = scanner_region_merge(condition->region,
scanner_region_merge(consequent->region, alternative->region));
return tree;
}
exprtree*
make_sub_assignment (scanner_ident_t *name_ident, exprtree *subscripts, exprtree *value)
{
char *name = name_ident->str;
scanner_region_t region = scanner_region_merge(name_ident->region,
scanner_region_merge(exprlist_region(subscripts), value->region));
exprtree *tree = alloc_exprtree();
tuple_info_t info;
variable_t *var = lookup_variable(the_mathmap->current_filter->v.mathmap.variables, name, &info);
if (var == 0)
{
sprintf(error_string, _("Undefined variable %s."), name);
error_region = name_ident->region;
JUMP(1);
}
if (subscripts->result.length != value->result.length)
{
sprintf(error_string, _("Lhs does not match rhs in sub assignment."));
error_region = region;
JUMP(1);
}
tree->type = EXPR_SUB_ASSIGNMENT;
tree->val.sub_assignment.var = var;
tree->val.sub_assignment.subscripts = subscripts;
tree->val.sub_assignment.value = value;
tree->result = value->result;
tree->region = region;
return tree;
}
/* patch a while */
void fytheCodegenPatchWhile(struct Buffer_char *buf, int wHead, int wCond, int wMid, int wBody, int wTail, int wEnd)
{
size_t jsz;
jsz = JUMP_SZ(wBody, wEnd) + 1;
*((int *) (buf->buf + wBody - 8)) = JUMP(0, jsz);
jsz = JUMP_SZ(wEnd, wCond);
*((int *) (buf->buf + wEnd - 4)) = JUMP(0xe, jsz);
}
/* update the surrounding bits of an if to jump to the right places */
void fytheCodegenPatchIf(struct Buffer_char *buf, int ifHead, int ifTrue, int ifMid, int ifFalse, int ifTail, int ifEnd)
{
size_t jsz;
jsz = JUMP_SZ(ifTrue, ifFalse);
*((int *) (buf->buf + ifTrue - 4)) = JUMP(0, jsz); /* 0 means equal */
jsz = JUMP_SZ(ifFalse, ifTail);
*((int *) (buf->buf + ifFalse - 4)) = JUMP(0xe, jsz); /* 0xe is unconditional */
}
void
apply_limits_to_arg_decl (arg_decl_t *arg_decl, limits_t *limits)
{
if (arg_decl->type == ARG_TYPE_INT)
{
if (limits->type != LIMITS_INT)
{
strcpy(error_string, _("Only integers can be limits for an int argument"));
error_region = limits->region;
JUMP(1);
}
arg_decl->v.integer.have_limits = 1;
arg_decl->v.integer.min = limits->v.integer.min;
arg_decl->v.integer.max = limits->v.integer.max;
arg_decl->v.integer.default_value = arg_decl->v.integer.min;
}
else if (arg_decl->type == ARG_TYPE_FLOAT)
{
float min = 0.0, max = 0.0;
if (limits->type == LIMITS_INT)
{
min = (float)limits->v.integer.min;
max = (float)limits->v.integer.max;
}
else if (limits->type == LIMITS_FLOAT)
{
min = limits->v.floating.min;
max = limits->v.floating.max;
}
else
{
strcpy(error_string, _("Only integers and floats can be limits for a float argument"));
error_region = limits->region;
JUMP(1);
}
arg_decl->v.floating.have_limits = 1;
arg_decl->v.floating.min = min;
arg_decl->v.floating.max = max;
arg_decl->v.floating.default_value = min;
}
else
{
strcpy(error_string, _("Limits applied to wrongly typed argument"));
error_region = limits->region;
JUMP(1);
}
}
int main()
{
START_MACHINE;
JUMP(CONTINUE);
#include "char.lib"
#include "io.lib"
#include "math.lib"
#include "string.lib"
#include "system.lib"
#include "scheme.lib"
CONTINUE:
/* initialize the 4 singletons */
PUSH(IMM(1));
CALL(MAKE_SOB_BOOL); /* define SOB_BOOL_TRUE in mem[1]*/
DROP(1);
PUSH(IMM(0));
CALL(MAKE_SOB_BOOL); /* define SOB_BOOL_FALSE in mem[3]*/
DROP(1);
CALL(MAKE_SOB_NIL); /* define nil in mem[5] */
CALL(MAKE_SOB_VOID); /* define #Void in mem[6] */
/* start of code */
/* CALL(MAKE_SOB_NIL); */
/* MOV(R0, IND(IMM(4))); */
MOV(R0, IMM(5));
PUSH(R0);
CALL(IS_SOB_TRUE);
CMP(R0, IMM(1)); /* 1 means R0 was true, 0 means it
was #f */
JUMP_EQ(Lelse1);
PUSH(IMM(1));
CALL(MAKE_SOB_BOOL);
JUMP(Lexit1);
Lelse1:
PUSH(IMM(0));
CALL(MAKE_SOB_BOOL);
Lexit1:
PUSH(R0);
CALL(WRITE_SOB);
/* newline and stop machine */
PUSH(IMM('\n'));
CALL(PUTCHAR);
STOP_MACHINE;
return 0;
}
address CompiledStaticCall::emit_to_interp_stub(CodeBuffer &cbuf, address mark) {
// Stub is fixed up when the corresponding call is converted from calling
// compiled code to calling interpreted code.
// set (empty), G5
// jmp -1
if (mark == NULL) {
mark = cbuf.insts_mark(); // Get mark within main instrs section.
}
MacroAssembler _masm(&cbuf);
address base = __ start_a_stub(to_interp_stub_size());
if (base == NULL) {
return NULL; // CodeBuffer::expand failed.
}
// Static stub relocation stores the instruction address of the call.
__ relocate(static_stub_Relocation::spec(mark));
__ set_metadata(NULL, as_Register(Matcher::inline_cache_reg_encode()));
__ set_inst_mark();
AddressLiteral addrlit(-1);
__ JUMP(addrlit, G3, 0);
__ delayed()->nop();
assert(__ pc() - base <= to_interp_stub_size(), "wrong stub size");
// Update current stubs pointer and restore code_end.
__ end_a_stub();
return base;
}
void
start_parsing_filter (mathmap_t *mathmap, top_level_decl_t *decl)
{
filter_t *filter;
g_assert(mathmap->current_filter == NULL);
if (lookup_filter(mathmap->filters, decl->name) != NULL)
{
sprintf(error_string, _("Filter `%s' is defined more than once."), decl->name);
error_region = decl->region;
JUMP(1);
}
filter = g_new0(filter_t, 1);
filter->kind = FILTER_MATHMAP;
filter->name = g_strdup(decl->name);
filter->v.mathmap.decl = decl;
init_internals(filter);
filter->next = mathmap->filters;
mathmap->filters = filter;
mathmap->current_filter = filter;
}
void CompiledStaticCall::emit_to_interp_stub(CodeBuffer &cbuf) {
#ifdef COMPILER2
// Stub is fixed up when the corresponding call is converted from calling
// compiled code to calling interpreted code.
// set (empty), G5
// jmp -1
address mark = cbuf.insts_mark(); // Get mark within main instrs section.
MacroAssembler _masm(&cbuf);
address base =
__ start_a_stub(to_interp_stub_size()*2);
if (base == NULL) return; // CodeBuffer::expand failed.
// Static stub relocation stores the instruction address of the call.
__ relocate(static_stub_Relocation::spec(mark));
__ set_metadata(NULL, as_Register(Matcher::inline_cache_reg_encode()));
__ set_inst_mark();
AddressLiteral addrlit(-1);
__ JUMP(addrlit, G3, 0);
__ delayed()->nop();
// Update current stubs pointer and restore code_end.
__ end_a_stub();
#else
ShouldNotReachHere();
#endif
}
exprtree*
make_for (scanner_ident_t *counter_name_ident, exprtree *counter_init, exprtree *start, exprtree *end, exprtree *body)
{
scanner_region_t region = counter_name_ident->region;
if (start->result.length != 1 || end->result.length != 1 || start->result.number != end->result.number)
{
sprintf(error_string, _("The start and end of a for loop interval must be tuples of the same tag and length 1."));
error_region = region;
JUMP(1);
}
else
{
char end_name_buf[MAX_GENSYM_LEN];
char *end_name = gensym(end_name_buf);
scanner_ident_t *end_name_ident = scanner_make_ident(scanner_null_region, end_name);
exprtree *end_init = make_assignment(end_name_ident, end);
exprtree *init = make_sequence(counter_init, end_init);
exprtree *inc = make_assignment(counter_name_ident,
make_function_from_string("__add",
exprlist_append(make_var(counter_name_ident),
make_int_number(1, scanner_null_region)),
scanner_null_region));
exprtree *invariant = make_function_from_string("__lessequal", exprlist_append(make_var(counter_name_ident),
make_var(end_name_ident)),
scanner_null_region);
free(end_name_ident);
return make_sequence(init, make_while(invariant, make_sequence(body, inc)));
}
}
/* Process 0OPI Integer instructions */
bool eval_Integer_0OPI(struct lilith* vm, struct Instruction* c)
{
#ifdef DEBUG
char Name[20] = "ILLEGAL_0OPI";
#endif
switch(c->raw_XOP)
{
case 0x00: /* JUMP */
{
#ifdef DEBUG
strncpy(Name, "JUMP", 19);
#elif TRACE
record_trace("JUMP");
#endif
JUMP(vm, c);
break;
}
default:
{
illegal_instruction(vm, c);
break;
}
}
#ifdef DEBUG
fprintf(stdout, "# %s %d\n", Name, c->raw_Immediate);
#endif
return false;
}
exprtree*
make_tuple_exprtree (exprtree *elems)
{
exprtree *tree, *elem;
int length;
length = 0;
for (elem = elems; elem != 0; elem = elem->next)
{
++length;
if (elem->result.length != 1)
{
sprintf(error_string, _("Tuples cannot contain tuples of length other than 1."));
error_region = elem->region;
JUMP(1);
}
}
tree = alloc_exprtree();
tree->type = EXPR_TUPLE;
tree->val.tuple.length = length;
tree->val.tuple.elems = elems;
tree->region = exprlist_region(elems);
tree->result = make_tuple_info(nil_tag_number, length);
return tree;
}
void reback_to_boot(u8 block_id)
{
u32 p_sr;
hal_timer_release(0);
hal_timer_release(1);
hal_timer_release(2);
hal_timer_release(3);
if(USB_TOOL_BLOCK_ID == block_id)
{
*boot_para1 = 0x12340000 | USB_TOOL_BLOCK_ID;
*boot_para2 = 0x80008000 + 0x1000000;// + 16M
*boot_para3 = 0x12340000 | 0x0001;//HDMI
// OS_PRINTF("goto usb update\n");
}
else
{
*boot_para1 = 0x12340000 | block_id;
*boot_para2 = 0x80008000;
*boot_para3 = 0x12340000 | 0x0001;
// OS_PRINTF("goto ota\n");
}
*boot_para4 = 0x80A00000; //memory location for lzma, 10M
*((volatile u32 *)(PARA_ADDRESS)) = (REBACK_BOOT_FLAG << 16) | boot_jump_ID;
mtos_critical_enter(&p_sr);
// OS_PRINTF("boot_para3=%x,*boot_para3=%x\n",boot_para3,*boot_para3);
JUMP(back_addr);
}
/**
* Removes an element from a hashset. Does nothing if the set doesn't contain
* the element.
*
* @param self the hashset
* @param key key that identifies the data to remove
*/
void hashset_remove(HashSet *self, ConstKeyType key)
{
size_t num_probes = 0;
size_t num_buckets = self->num_buckets;
size_t hashmask = num_buckets - 1;
unsigned hash = Hash(self, key);
size_t bucknum = hash & hashmask;
#ifndef NDEBUG
self->entries_version++;
#endif
while(1) {
HashSetEntry *entry = & self->entries[bucknum];
if(EntryIsEmpty(*entry)) {
return;
}
if(EntryIsDeleted(*entry)) {
// entry is deleted
} else if(EntryGetHash(self, *entry) == hash) {
if(KeysEqual(self, GetKey(EntryGetValue(*entry)), key)) {
EntrySetDeleted(*entry);
self->num_deleted++;
self->consider_shrink = 1;
return;
}
}
++num_probes;
bucknum = (bucknum + JUMP(num_probes)) & hashmask;
assert(num_probes < num_buckets);
}
}
limits_t*
make_float_limits (exprtree *min_tree, exprtree *max_tree)
{
scanner_region_t region = scanner_region_merge (min_tree->region, max_tree->region);
limits_t *limits;
float min, max;
g_assert((min_tree->type == EXPR_INT_CONST || min_tree->type == EXPR_FLOAT_CONST) &&
(max_tree->type == EXPR_INT_CONST || max_tree->type == EXPR_FLOAT_CONST));
if (min_tree->type == EXPR_INT_CONST)
min = (float)min_tree->val.int_const;
else
min = min_tree->val.float_const;
if (max_tree->type == EXPR_INT_CONST)
max = (float)max_tree->val.int_const;
else
max = max_tree->val.float_const;
if (min >= max)
{
strcpy(error_string, _("Lower limit must be less than upper limit"));
error_region = region;
JUMP(1);
}
limits = alloc_limits(LIMITS_FLOAT);
limits->region = region;
limits->v.floating.min = min;
limits->v.floating.max = max;
return limits;
}
limits_t*
make_int_limits (exprtree *min_tree, exprtree *max_tree)
{
scanner_region_t region = scanner_region_merge (min_tree->region, max_tree->region);
limits_t *limits;
int min, max;
g_assert(min_tree->type == EXPR_INT_CONST && max_tree->type == EXPR_INT_CONST);
min = min_tree->val.int_const;
max = max_tree->val.int_const;
if (min >= max)
{
strcpy(error_string, _("Lower limit must be less than upper limit"));
error_region = region;
JUMP(1);
}
limits = alloc_limits(LIMITS_INT);
limits->region = region;
limits->v.integer.min = min;
limits->v.integer.max = max;
return limits;
}
/**
* Searchs for an element with key @p key.
*
* @param self the hashset
* @param key the key to search for
* @returns the found value or NullValue if nothing was found
*/
InsertReturnValue hashset_find(const HashSet *self, ConstKeyType key)
{
size_t num_probes = 0;
size_t num_buckets = self->num_buckets;
size_t hashmask = num_buckets - 1;
unsigned hash = Hash(self, key);
size_t bucknum = hash & hashmask;
while(1) {
HashSetEntry *entry = & self->entries[bucknum];
if(EntryIsEmpty(*entry)) {
return NullReturnValue;
}
if(EntryIsDeleted(*entry)) {
// value is deleted
} else if(EntryGetHash(self, *entry) == hash) {
if(KeysEqual(self, GetKey(EntryGetValue(*entry)), key)) {
// found the value
return GetInsertReturnValue(*entry, 1);
}
}
++num_probes;
bucknum = (bucknum + JUMP(num_probes)) & hashmask;
assert(num_probes < num_buckets);
}
}
void
check_for_start (exprtree *start)
{
if (start->result.length != 1)
{
sprintf(error_string, _("The start and end of a for loop interval must be tuples of length 1."));
error_region = start->region;
JUMP(1);
}
}
Scalar CustomWeakFormDiscontinuousGalerkin::Diffusion::InterfaceJacobian::matrix_form(int n, double* wt,
Func< Scalar >* u_ext[], Func< Real >* u, Func< Real >* v,
Geom< Real >* e, ExtData< Scalar >* ext) const
{
Scalar result = 0;
//Real sigma = 2 * C_W / (e->diam + e->get_neighbor_diam());
Real edge_len = 0.;
for (int i = 0; i < n; i++)
edge_len += wt[i];
Real sigma = C_W * epsilon / (0.5*edge_len);
for (int i = 0; i < n; i++)
{
result += wt[i] * epsilon * (-AVG_GRAD(u) * JUMP(v) + theta * AVG_GRAD(v) * JUMP(u)); // diffusion
result += wt[i] * sigma * JUMP(u) * JUMP(v); // interior discontinuity penalization
}
return result;
}
static void drivecpu_set_bank_base(void *context)
{
drive_context_t *drv;
drivecpu_context_t *cpu;
drv = (drive_context_t *)context;
cpu = drv->cpu;
JUMP(reg_pc);
}
Scalar CustomWeakFormDiscontinuousGalerkin::Diffusion::InterfaceResidual::vector_form(int n, double* wt,
Func< Scalar >* u_ext[], Func< Real >* v,
Geom< Real >* e, ExtData< Scalar >* ext) const
{
Scalar result = 0;
//Real sigma = 2 * C_W / (e->diam + e->get_neighbor_diam());
Real edge_len = 0.;
for (int i = 0; i < n; i++)
edge_len += wt[i];
Real sigma = C_W * epsilon / (0.5*edge_len);
for (int i = 0; i < n; i++)
{
result += wt[i] * epsilon * (-AVG_GRAD(u_ext[0]) * JUMP(v) + theta * AVG_GRAD(v) * JUMP(u_ext[0]));
result += wt[i] * sigma * JUMP(u_ext[0]) * JUMP(v);
}
return result;
}
exprtree*
make_assignment (scanner_ident_t *name_ident, exprtree *value)
{
char *name = name_ident->str;
scanner_region_t region = name_ident->region;
exprtree *tree = alloc_exprtree();
variable_t *var = lookup_variable(the_mathmap->current_filter->v.mathmap.variables, name, &tree->result);
if (var == NULL)
{
if (lookup_internal(the_mathmap->current_filter->v.mathmap.internals, name, TRUE) != NULL
|| lookup_variable_macro(name, NULL) != NULL)
{
sprintf(error_string, _("Cannot assign to internal variable `%s'."), name);
error_region = region;
JUMP(1);
}
if (lookup_userval(the_mathmap->current_filter->userval_infos, name) != NULL)
{
sprintf(error_string, _("Cannot assign to filter argument `%s'."), name);
error_region = region;
JUMP(1);
}
var = register_variable(&the_mathmap->current_filter->v.mathmap.variables, name, value->result);
tree->result = value->result;
}
if (tree->result.number != value->result.number || tree->result.length != value->result.length)
{
sprintf(error_string, _("Variable %s is being assigned two different types."), name);
error_region = region;
JUMP(1);
}
tree->type = EXPR_ASSIGNMENT;
tree->val.assignment.var = var;
tree->val.assignment.value = value;
tree->region = region;
return tree;
}
Scalar CustomWeakFormDiscontinuousGalerkin::Advection::InterfaceResidual::vector_form(int n, double* wt,
Func< Scalar >* u_ext[], Func< Real >* v,
Geom< Real >* e, ExtData< Scalar >* ext) const
{
Scalar result = 0;
for (int i = 0; i < n; i++)
result += upwind_flux( u_ext[0]->get_val_central(i), u_ext[0]->get_val_neighbor(i), ConstFlowField::dot_n<Real>(e,i) )
* JUMP(v) * wt[i];
return result;
}
static exprtree*
make_image_call (exprtree *image, exprtree *args, scanner_region_t region)
{
exprtree *tree;
scanner_ident_t *ident;
if (exprlist_length(args) != 1 && exprlist_length(args) != 2)
{
sprintf(error_string, _("An image must be invoked with one or two arguments."));
error_region = region;
JUMP(1);
}
if (args->result.length != 2
|| (args->result.number != xy_tag_number
&& args->result.number != ra_tag_number))
{
sprintf(error_string, _("The coordinate argument to an image must be of type xy:2 or ra:2."));
error_region = region;
JUMP(1);
}
if (args->result.number == ra_tag_number)
args = make_function_from_string("toXY", args, args->region);
if (args->next != NULL)
{
if (args->next->result.length != 1)
{
sprintf(error_string, _("The time argument to an image have length 1."));
error_region = region;
JUMP(1);
}
}
ident = scanner_make_ident(scanner_null_region, "__origVal");
tree = make_function(ident, exprlist_append(args, image));
free(ident);
return tree;
}
static void recovery_xdata_block(struct hmfs_sb_info *sbi, seg_t src_segno,
int src_off, struct hmfs_summary *src_sum)
{
struct gc_move_arg arg;
struct hmfs_node *last = NULL, *this = NULL;
struct hmfs_cm_info *cm_i = CM_I(sbi);
block_t addr_in_par;
bool modify_vb = false;
int x_tag;
prepare_move_argument(&arg, sbi, src_segno, src_off, src_sum,
TYPE_DATA);
while (1) {
this = __get_node(sbi, arg.cp_i, arg.nid);
if (IS_ERR(this))
break;
if (this == last)
goto next;
x_tag = le64_to_cpu(XATTR_HDR(arg.src)->h_magic);
addr_in_par = XBLOCK_ADDR(this, x_tag);
if (addr_in_par != arg.src_addr && is_valid_address(sbi, addr_in_par)) {
break;
}
if (addr_in_par != arg.src_addr) {
hmfs_memcpy_atomic(JUMP(this, x_tag), &arg.src_addr, 8);
if (!modify_vb) {
arg.dest_sum = get_summary_by_addr(sbi, addr_in_par);
clear_summary_valid_bit(arg.dest_sum);
modify_vb = true;
}
}
last = this;
next:
if (arg.cp_i == cm_i->last_cp_i)
break;
arg.cp_i = get_next_checkpoint_info(sbi, arg.cp_i);
}
}
/**
* Inserts an element into a hashset without growing the set (you have to make
* sure there's enough room for that.
* @note also see comments for hashset_insert()
* @internal
*/
static inline
InsertReturnValue insert_nogrow(HashSet *self, KeyType key)
{
size_t num_probes = 0;
size_t num_buckets = self->num_buckets;
size_t hashmask = num_buckets - 1;
unsigned hash = Hash(self, key);
size_t bucknum = hash & hashmask;
size_t insert_pos = ILLEGAL_POS;
assert((num_buckets & (num_buckets - 1)) == 0);
while(1) {
HashSetEntry *entry = & self->entries[bucknum];
if(EntryIsEmpty(*entry)) {
size_t p;
HashSetEntry *nentry;
if(insert_pos != ILLEGAL_POS) {
p = insert_pos;
} else {
p = bucknum;
}
nentry = &self->entries[p];
InitData(self, EntryGetValue(*nentry), key);
EntrySetHash(*nentry, hash);
self->num_elements++;
return GetInsertReturnValue(*nentry, 0);
}
if(EntryIsDeleted(*entry)) {
if(insert_pos == ILLEGAL_POS)
insert_pos = bucknum;
} else if(EntryGetHash(self, *entry) == hash) {
if(KeysEqual(self, GetKey(EntryGetValue(*entry)), key)) {
// Value already in the set, return it
return GetInsertReturnValue(*entry, 1);
}
}
++num_probes;
bucknum = (bucknum + JUMP(num_probes)) & hashmask;
assert(num_probes < num_buckets);
}
}
exprtree*
make_var (scanner_ident_t *name_ident)
{
char *name = name_ident->str;
scanner_region_t region = name_ident->region;
tuple_info_t info;
exprtree *tree = 0;
if (lookup_internal(the_mathmap->current_filter->v.mathmap.internals, name, 0) != 0)
{
tree = alloc_exprtree();
tree->type = EXPR_INTERNAL;
tree->val.internal = lookup_internal(the_mathmap->current_filter->v.mathmap.internals, name, 0);
tree->result = make_tuple_info(nil_tag_number, 1);
tree->region = region;
}
else if (lookup_variable_macro(name, &info) != 0)
{
macro_function_t function = lookup_variable_macro(name, &info);
tree = function(0);
tree->region = name_ident->region;
}
else if (lookup_userval(the_mathmap->current_filter->userval_infos, name) != 0)
{
userval_info_t *info = lookup_userval(the_mathmap->current_filter->userval_infos, name);
tree = make_userval(info, 0, region);
}
else if (lookup_variable(the_mathmap->current_filter->v.mathmap.variables, name, &info) != 0)
{
variable_t *var = lookup_variable(the_mathmap->current_filter->v.mathmap.variables, name, &info);
return make_var_exprtree(var, info, region);
}
else
{
sprintf(error_string, _("Undefined variable %s."), name);
error_region = region;
JUMP(1);
}
return tree;
}
int main()
{
START_MACHINE;
JUMP(CONTINUE);
#include "char.lib"
#include "io.lib"
#include "math.lib"
#include "string.lib"
#include "system.lib"
#include "scheme.lib"
CONTINUE:
PUSH(IMM(64));
CALL(MALLOC);
SHOW("MALLOC RETURNED ", R0);
DROP(1);
PUSH(R0);
OUT(IMM(2), IMM('?'));
OUT(IMM(2), IMM(' '));
CALL(READLINE);
SHOW("READ IN STRING AT ADDRESS ", R0);
PUSH(R0);
CALL(STRING_TO_NUMBER);
DROP(1);
SHOW("READ IN ", R0);
MUL(R0, R0);
SHOW("SQUARE IS ", R0);
PUSH(R0);
CALL(NUMBER_TO_STRING);
DROP(1);
PUSH(R0);
SHOW("STR[0] = ", INDD(R0, 0));
SHOW("STR[1] = ", INDD(R1, 0));
SHOW("STR[2] = ", INDD(R2, 0));
SHOW("STR[3] = ", INDD(R3, 0));
CALL(WRITELN);
DROP(1);
STOP_MACHINE;
return 0;
}
exprtree*
make_do_while (exprtree *body, exprtree *invariant)
{
exprtree *tree = alloc_exprtree();
if (invariant->result.length != 1)
{
sprintf(error_string, _("Invariant of do-while loop must have length 1."));
error_region = invariant->region;
JUMP(1);
}
tree->type = EXPR_DO_WHILE;
tree->val.whileExpr.invariant = invariant;
tree->val.whileExpr.body = body;
tree->result = make_tuple_info(nil_tag_number, 1);
tree->region = scanner_region_merge(invariant->region, body->region);
return tree;
}
void
register_args_as_uservals (filter_t *filter, arg_decl_t *arg_decls)
{
arg_decl_t *decl;
for (decl = arg_decls; decl != NULL; decl = decl->next)
if (lookup_internal(filter->v.mathmap.internals, decl->name, TRUE) != NULL
|| lookup_variable_macro(decl->name, NULL) != NULL)
{
sprintf(error_string, _("Argument `%s' has the same name as an internal variable."), decl->name);
error_region = decl->region;
JUMP(1);
}
g_assert(filter->userval_infos == NULL && filter->num_uservals == 0);
filter->userval_infos = arg_decls_to_uservals(filter, arg_decls);
filter->num_uservals = count_userval_infos(filter->userval_infos);
}
