int fn_do(_kforth_context *context) { LOOP_STACK_PUSH(STACK(0)); LOOP_STACK_PUSH(STACK(-1)); STACK_POP_X(2); return 0; }
void c_long_p(CL_FORM *base) { if(CL_C_LONG_P(STACK(base, 0))) { LOAD_T(STACK(base, 0)); } else { LOAD_NIL(STACK(base, 0)); } }
void Fset_hash_table_test(CL_FORM *base) { COPY(STACK(base, 1), STACK(base, 2)); LOAD_FIXNUM(4, STACK(base, 3)); LOAD_SYMBOL(SYMBOL(Slisp, 327), STACK(base, 4)); /* HASH-TABLE */ COPY(STACK(base, 0), STACK(base, 5)); set_struct_ref(STACK(base, 2)); COPY(STACK(base, 2), STACK(base, 0)); }
int task_run(task_id tid, lua_State *L, message_t *m) { task_t *t = task_ref(tid); if (!t) return ERR_INVAL; task_set_current(tid); int rc = 0; int count; switch (t->status) { case ready: if (!m) { t->status = finished; break; } t->L = lua_newthread(L); count = lua_decodemessage(t->L, m) - 1; msg_destroy(m); t->status = running; STACK(t->L,"Resume from ready %f\n",t->id); rc = lua_resume(t->L, count); break; case suspended: count = m ? lua_decodemessage(t->L, m) : 0; if (m) msg_destroy(m); t->status = running; STACK(t->L,"Resume from suspended %f\n",t->id); rc = lua_resume(t->L, count); break; default: break; } if (rc == LUA_ERRRUN) { INFO("Error code %d",rc); t->status = error; STACK(t->L,"Error running task"); } else if (rc == LUA_YIELD) { STACK(t->L,"YIELDED (ref = %d)",t->ref_count); t->status = suspended; // TODO YIELD } else if (rc == 0) { STACK(t->L,"QUITTED (ref = %d)",t->ref_count); t->status = finished; } // TODO task->coro = get current coroutine task_set_current(0); task_free(tid); // TODO handle rc return SUCCESS; }
static void Z130_mapcon_internal(CL_FORM *base, CL_FORM *display[]) { CONTENV new_cont; CL_FORM *caller_base; new_cont.bind_top = bind_top; new_cont.last = last_cont; LOAD_UNIQUE_TAG(ARG(0)); caller_base = (CL_FORM *)SETJMP(new_cont.jmp_buf); if(caller_base == NULL) { last_cont = &new_cont; if(CL_ATOMP(&display[0][1])) { LOAD_NIL(ARG(0)); } else { COPY(&display[0][0], ARG(1)); COPY(&display[0][1], ARG(2)); COPY(GET_CAR(&display[0][1]), ARG(3)); COPY(&display[0][1], ARG(4)); COPY(ARG(4), ARG(5)); COPY(GET_CDR(ARG(5)), &display[0][1]); COPY(&display[0][2], ARG(3)); display[1] = ARG(0); Z131_get_rest_args(ARG(3), display); Fapply(ARG(1), 3); mv_count = 1; Z130_mapcon_internal(ARG(2), display); Fnconc(ARG(1), 2); COPY(ARG(1), ARG(0)); } RETURN1:; last_cont = new_cont.last; } else { last_cont = new_cont.last; if(EQ(STACK(caller_base, 0), ARG(0))) { COPY(STACK(caller_base, 1), ARG(0)); } else { call_cont(caller_base); } } }
int fn_read(_kforth_context *context) { platform_printf("Reading From 0x%08X\r\n", STACK(0)); STACK_POP(); STACK_PUSH(0); return 0; }
void FILTER(stack& s) { quote* b = s.pop().get_quote(); quote* a = s.pop().get_quote(); quote* res = new quote(); while (!a->empty()) { s.push(a->pop_front()); STACK(s); quote* context = s.pop().get_quote(); b->execute(&s); bool result = s.pop().get_bool(); s.push(context); UNSTACK(s); if (result) { res->push(s.pop()); } else { if (s.top()->is_quote()) { delete s.top()->get_quote(); s.pop(); } } } s.push(res); delete b; delete a; }
void link_dialog_run(GtkWindow *win, JamDoc *doc) { STACK(LinkDialog, ld); GtkTextBuffer *buffer; GtkTextIter start, end; char *sel = NULL; char *link; JamAccount *acc = jam_doc_get_account(doc); make_link_dialog(ld, win, JAM_ACCOUNT_IS_LJ(acc)); buffer = jam_doc_get_text_buffer(doc); if (gtk_text_buffer_get_selection_bounds(buffer, &start, &end)) sel = gtk_text_buffer_get_text(buffer, &start, &end, FALSE); prepopulate_fields(ld, sel); g_free(sel); if (gtk_dialog_run(GTK_DIALOG(ld->dlg)) != GTK_RESPONSE_OK) { gtk_widget_destroy(ld->dlg); return; } link = get_link(ld, acc); gtk_widget_destroy(ld->dlg); if (link) { gtk_text_buffer_begin_user_action(buffer); gtk_text_buffer_delete(buffer, &start, &end); gtk_text_buffer_insert(buffer, &start, link, -1); gtk_text_buffer_end_user_action(buffer); g_free(link); } }
void WHILE(stack& s) { quote* d = s.pop().get_quote(); quote* b = s.pop().get_quote(); STACK(s); quote* context = s.pop().get_quote(); b->execute(&s); s.push(context); UNSTACK(s); while (s.pop().get_bool()) { d->execute(&s); STACK(s); context = s.pop().get_quote(); b->execute(&s); s.push(context); UNSTACK(s); } delete b; delete d; }
void NULLARY(stack& s) { quote* p = s.pop().get_quote(); STACK(s); quote* context = s.pop().get_quote(); s.push(p); I(s); stype st = s.pop(); s.push(context); UNSTACK(s); s.push(st); }
void OCamlTabCodeGen::RET( ostream &ret, bool inFinish ) { ret << "begin " << vCS() << " <- " << AT(STACK(), PRE_DECR(TOP()) ) << "; "; if ( postPopExpr != 0 ) { ret << "begin "; INLINE_LIST( ret, postPopExpr, 0, false ); ret << "end "; } ret << CTRL_FLOW() << "raise Goto_again end"; }
void CSharpFlatCodeGen::RET( ostream &ret, bool inFinish ) { ret << "{" << vCS() << " = " << STACK() << "[--" << TOP() << "];"; if ( postPopExpr != 0 ) { ret << "{"; INLINE_LIST( ret, postPopExpr, 0, false ); ret << "}"; } ret << CTRL_FLOW() << "goto _again;}"; }
void OCamlTabCodeGen::CALL( ostream &ret, int callDest, int targState, bool inFinish ) { if ( prePushExpr != 0 ) { ret << "begin "; INLINE_LIST( ret, prePushExpr, 0, false ); } ret << "begin " << AT( STACK(), POST_INCR(TOP()) ) << " <- " << vCS() << "; "; ret << vCS() << " <- " << callDest << "; " << CTRL_FLOW() << "raise Goto_again end "; if ( prePushExpr != 0 ) ret << "end"; }
void TabCodeGen::CALL( ostream &ret, int callDest, int targState, bool inFinish ) { if ( prePushExpr != 0 ) { ret << "{"; INLINE_LIST( ret, prePushExpr, 0, false, false ); } ret << "{" << STACK() << "[" << TOP() << "++] = " << vCS() << "; " << vCS() << " = " << callDest << "; " << CTRL_FLOW() << "goto _again;}"; if ( prePushExpr != 0 ) ret << "}"; }
void print_stack(){ int i; printf("printing stack, FP: %d SP: %d\n", (int)(FP), (int)(SP)); for(i=SP+5; i>=0; --i){ if(SP == i){ printf("SP "); } if(FP == i){ printf("FP "); } printf("\telement %d: %d \n", i, STACK(i)); } }
PollQuestion* pollmultidlg_run(GtkWindow *parent, PollQuestionMulti *qm) { PollQuestion *q = NULL; GtkTextBuffer *buffer; STACK(PollMultiDlg, pmdlg); pollmultidlg_init(pmdlg, parent); buffer = gtk_text_view_get_buffer(GTK_TEXT_VIEW(pmdlg->question)); if (qm) { GSList *l; GtkTreeIter iter; q = (PollQuestion*)qm; gtk_option_menu_set_history(GTK_OPTION_MENU(pmdlg->typemenu), q->type); gtk_text_buffer_insert_at_cursor(buffer, q->question, -1); for (l = qm->answers; l; l = l->next) { gtk_list_store_append(pmdlg->answers.store, &iter); gtk_list_store_set(pmdlg->answers.store, &iter, 0, l->data, -1); } } if (gtk_dialog_run(GTK_DIALOG(pmdlg->dlg)) == GTK_RESPONSE_OK) { GtkTextIter start, end; GtkTreeModel *model = GTK_TREE_MODEL(pmdlg->answers.store); GtkTreeIter iter; if (qm == NULL) qm = g_new0(PollQuestionMulti, 1); q = (PollQuestion*)qm; q->type = gtk_option_menu_get_history(GTK_OPTION_MENU(pmdlg->typemenu)); gtk_text_buffer_get_bounds(buffer, &start, &end); g_free(q->question); q->question = gtk_text_buffer_get_text(buffer, &start, &end, FALSE); g_slist_foreach(qm->answers, (GFunc)g_free, NULL); g_slist_free(qm->answers); qm->answers = NULL; if (gtk_tree_model_get_iter_first(model, &iter)) { /* this is probably O(n^2) or something like that. * but there hopefully won't be that many answers. */ do { char *text; gtk_tree_model_get(model, &iter, 0, &text, -1); qm->answers = g_slist_append(qm->answers, text); } while (gtk_tree_model_iter_next(model, &iter)); } } gtk_widget_destroy(GTK_WIDGET(pmdlg->dlg)); return q; }
PollQuestion* polltextdlg_run(GtkWindow *parent, PollQuestionText *pqt) { STACK(PollTextDlg, ptdlg); PollQuestion *q = NULL; GtkTextBuffer *buffer; polltextdlg_init(ptdlg, parent); buffer = gtk_text_view_get_buffer(GTK_TEXT_VIEW(ptdlg->question)); if (pqt) { char *text; q = (PollQuestion*)pqt; gtk_text_buffer_insert_at_cursor(buffer, q->question, -1); if (pqt->size) { text = g_strdup_printf("%d", pqt->size); gtk_entry_set_text(GTK_ENTRY(ptdlg->size), text); g_free(text); } if (pqt->width) { text = g_strdup_printf("%d", pqt->width); gtk_entry_set_text(GTK_ENTRY(ptdlg->width), text); g_free(text); } } if (gtk_dialog_run(GTK_DIALOG(ptdlg->dlg)) == GTK_RESPONSE_OK) { GtkTextIter start, end; const char *text; if (!pqt) pqt = g_new0(PollQuestionText, 1); q = (PollQuestion*)pqt; q->type = PQ_TEXT; gtk_text_buffer_get_bounds(buffer, &start, &end); g_free(q->question); q->question = gtk_text_buffer_get_text(buffer, &start, &end, FALSE); text = gtk_entry_get_text(GTK_ENTRY(ptdlg->size)); if (text && text[0]) pqt->size = atoi(text); text = gtk_entry_get_text(GTK_ENTRY(ptdlg->width)); if (text && text[0]) pqt->width = atoi(text); } gtk_widget_destroy(GTK_WIDGET(ptdlg->dlg)); return q; }
process_t *process_alloc(void *text, int argc, char **argv) { process_t *process = (process_t*)kalloc(sizeof(process_t)); memset(process, 0, sizeof(process_t)); process->text = kalloc_aligned(USER_TEXT_SIZE, 4096); memcpy(process->text, text, USER_TEXT_SIZE); process->stack_k = kalloc(K_STACK_SIZE); process->stack_u = kalloc_aligned(U_STACK_SIZE, 4096); process->pages = process_page_table_alloc((uintptr_t)process->stack_u, (uintptr_t)process->text); process->num_pages = 0; process->argc = argc; process->runstate = PROCESS_RUNNABLE; process->current = false; process->next_switch_is_kernel = false; process->num_waitable = 0; process->brk = USER_HEAP; process->files = kalloc(sizeof(file_t) * PROCESS_MAX_FILES); process->files[0] = g_termbuf->file; process->files[1] = g_term->file; process->files[2] = g_term->file; process->files[3] = g_devio->file; process->child_statuses = ll_alloc_a(kalloc); stackptr_t u = STACK(process->stack_u, U_STACK_SIZE); u = push_argv((void*)USER_STACK_VMA, process->stack_u, u, argc, argv); process->argv = (char**)u; process->pid = next_pid++; stackptr_t k = STACK(process->stack_k, K_STACK_SIZE); process->state = (system_state_t*)push_system_state(k, process->stack_u, process->argc, process->argv); process->kstate = NULL; return process; }
void TabCodeGen::CALL_EXPR( ostream &ret, GenInlineItem *ilItem, int targState, bool inFinish ) { if ( prePushExpr != 0 ) { ret << "{"; INLINE_LIST( ret, prePushExpr, 0, false, false ); } ret << "{" << STACK() << "[" << TOP() << "++] = " << vCS() << "; " << vCS() << " = ("; INLINE_LIST( ret, ilItem->children, targState, inFinish, false ); ret << "); " << CTRL_FLOW() << "goto _again;}"; if ( prePushExpr != 0 ) ret << "}"; }
void OCamlTabCodeGen::CALL_EXPR( ostream &ret, GenInlineItem *ilItem, int targState, bool inFinish ) { if ( prePushExpr != 0 ) { ret << "begin "; INLINE_LIST( ret, prePushExpr, 0, false ); } ret << "begin " << AT(STACK(), POST_INCR(TOP()) ) << " <- " << vCS() << "; " << vCS() << " <- ("; INLINE_LIST( ret, ilItem->children, targState, inFinish ); ret << "); " << CTRL_FLOW() << "raise Goto_again end "; if ( prePushExpr != 0 ) ret << "end"; }
void linrec(stack& s, quote* b, quote* t, quote* r1, quote* r2) { STACK(s); quote* context = s.pop().get_quote(); b->execute(&s); bool done = s.pop().get_bool(); s.push(context); UNSTACK(s); if (done) { t->execute(&s); } else { r1->execute(&s); linrec(s, b, t, r1, r2); r2->execute(&s); } }
void CLEAVE(stack& s) { quote* p2 = s.pop().get_quote(); quote* p1 = s.pop().get_quote(); STACK(s); quote* context = s.pop().get_quote(); s.push(p1); UNARY(s); stype r1 = s.pop(); s.push(context); UNSTACK(s); s.push(p2); UNARY(s); stype r2 = s.pop(); s.push(r1); s.push(r2); }
void Farray_element_type(CL_FORM *base) { if(CL_ARRAY_P(STACK(base, 0))) { } else { COPY(SYMVAL(Slisp, 121), STACK(base, 1)); /* NO_ARRAY */ COPY(STACK(base, 0), STACK(base, 2)); Ferror(STACK(base, 1), 2); } array_element_type_internal(STACK(base, 0)); to_element_type(STACK(base, 0)); }
void INFRA(stack& s) { quote* p = s.pop().get_quote(); quote* l1 = s.pop().get_quote(); quote* out = new quote(); STACK(s); quote* context = s.pop().get_quote(); s.push(l1); UNSTACK(s); p->execute(&s); for (vector<stype>::iterator it = s.stk.begin(); it != s.stk.end(); it++) { out->push((*it).copy()); } s.push(context); UNSTACK(s); s.push(out); delete p; }
void MAP(stack& s) { quote* p = s.pop().get_quote(); quote* a = s.pop().get_quote(); quote* res = new quote(); while (!a->empty()) { quote* context; STACK(s); context = s.pop().get_quote(); stype front = a->pop_front(); s.push(front); p->execute(&s); res->push(s.pop()); s.push(context); UNSTACK(s); } s.push(res); delete a; delete p; }
void TAILREC(stack& s) { quote* r1 = s.pop().get_quote(); quote* t = s.pop().get_quote(); quote* p = s.pop().get_quote(); bool done = false; while(!done) { STACK(s); quote* context = s.pop().get_quote(); p->execute(&s); done = s.pop().get_bool(); s.push(context); UNSTACK(s); if (done) { t->execute(&s); } else { r1->execute(&s); } } delete r1, delete t, delete p; }
PollQuestion* pollscaledlg_run(GtkWindow *parent, PollQuestionScale *pqs) { STACK(PollScaleDlg, psdlg); PollQuestion *q = NULL; GtkTextBuffer *buffer; pollscaledlg_init(psdlg, parent); buffer = gtk_text_view_get_buffer(GTK_TEXT_VIEW(psdlg->question)); if (pqs) { q = (PollQuestion*)pqs; gtk_text_buffer_insert_at_cursor(buffer, q->question, -1); gtk_spin_button_set_value(GTK_SPIN_BUTTON(psdlg->from), (gdouble)pqs->from); gtk_spin_button_set_value(GTK_SPIN_BUTTON(psdlg->to), (gdouble)pqs->to); gtk_spin_button_set_value(GTK_SPIN_BUTTON(psdlg->by), (gdouble)pqs->by); } if (gtk_dialog_run(GTK_DIALOG(psdlg->dlg)) == GTK_RESPONSE_OK) { GtkTextIter start, end; if (!pqs) pqs = g_new0(PollQuestionScale, 1); q = (PollQuestion*)pqs; q->type = PQ_SCALE; gtk_text_buffer_get_bounds(buffer, &start, &end); g_free(q->question); q->question = gtk_text_buffer_get_text(buffer, &start, &end, FALSE); pqs->from = gtk_spin_button_get_value_as_int(GTK_SPIN_BUTTON(psdlg->from)); pqs->to = gtk_spin_button_get_value_as_int(GTK_SPIN_BUTTON(psdlg->to)); pqs->by = gtk_spin_button_get_value_as_int(GTK_SPIN_BUTTON(psdlg->by)); } gtk_widget_destroy(GTK_WIDGET(psdlg->dlg)); return q; }
void SPLIT(stack& s) { quote* b = s.pop().get_quote(); quote* a = s.pop().get_quote(); quote* a1 = new quote(); quote* a2 = new quote(); while (!a->empty()) { s.push(a->pop_front()); STACK(s); quote* context = s.pop().get_quote(); b->execute(&s); bool result = s.pop().get_bool(); s.push(context); UNSTACK(s); if (result) { a1->push(s.pop()); } else { a2->push(s.pop()); } } s.push(a1); s.push(a2); delete b, delete a; }
void stream_close(CL_FORM *base) { LOAD_FIXNUM(9, STACK(base, 1)); LOAD_SYMBOL(SYMBOL(Slisp, 63), STACK(base, 2)); /* STREAM */ struct_ref(STACK(base, 0)); }
/* Subroutine */ int slasrt_(char *id, integer *n, real *d, integer *info) { /* -- LAPACK routine (version 2.0) -- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., Courant Institute, Argonne National Lab, and Rice University September 30, 1994 Purpose ======= Sort the numbers in D in increasing order (if ID = 'I') or in decreasing order (if ID = 'D' ). Use Quick Sort, reverting to Insertion sort on arrays of size <= 20. Dimension of STACK limits N to about 2**32. Arguments ========= ID (input) CHARACTER*1 = 'I': sort D in increasing order; = 'D': sort D in decreasing order. N (input) INTEGER The length of the array D. D (input/output) REAL array, dimension (N) On entry, the array to be sorted. On exit, D has been sorted into increasing order (D(1) <= ... <= D(N) ) or into decreasing order (D(1) >= ... >= D(N) ), depending on ID. INFO (output) INTEGER = 0: successful exit < 0: if INFO = -i, the i-th argument had an illegal value ===================================================================== Test the input paramters. Parameter adjustments Function Body */ /* System generated locals */ integer i__1, i__2; /* Local variables */ static integer endd, i, j; extern logical lsame_(char *, char *); static integer stack[64] /* was [2][32] */; static real dmnmx, d1, d2, d3; static integer start; extern /* Subroutine */ int xerbla_(char *, integer *); static integer stkpnt, dir; static real tmp; #define STACK(I) stack[(I)] #define WAS(I) was[(I)] #define D(I) d[(I)-1] *info = 0; dir = -1; if (lsame_(id, "D")) { dir = 0; } else if (lsame_(id, "I")) { dir = 1; } if (dir == -1) { *info = -1; } else if (*n < 0) { *info = -2; } if (*info != 0) { i__1 = -(*info); xerbla_("SLASRT", &i__1); return 0; } /* Quick return if possible */ if (*n <= 1) { return 0; } stkpnt = 1; STACK(0) = 1; STACK(1) = *n; L10: start = STACK((stkpnt << 1) - 2); endd = STACK((stkpnt << 1) - 1); --stkpnt; if (endd - start <= 20 && endd - start > 0) { /* Do Insertion sort on D( START:ENDD ) */ if (dir == 0) { /* Sort into decreasing order */ i__1 = endd; for (i = start + 1; i <= endd; ++i) { i__2 = start + 1; for (j = i; j >= start+1; --j) { if (D(j) > D(j - 1)) { dmnmx = D(j); D(j) = D(j - 1); D(j - 1) = dmnmx; } else { goto L30; } /* L20: */ } L30: ; } } else { /* Sort into increasing order */ i__1 = endd; for (i = start + 1; i <= endd; ++i) { i__2 = start + 1; for (j = i; j >= start+1; --j) { if (D(j) < D(j - 1)) { dmnmx = D(j); D(j) = D(j - 1); D(j - 1) = dmnmx; } else { goto L50; } /* L40: */ } L50: ; } } } else if (endd - start > 20) { /* Partition D( START:ENDD ) and stack parts, largest one first Choose partition entry as median of 3 */ d1 = D(start); d2 = D(endd); i = (start + endd) / 2; d3 = D(i); if (d1 < d2) { if (d3 < d1) { dmnmx = d1; } else if (d3 < d2) { dmnmx = d3; } else { dmnmx = d2; } } else { if (d3 < d2) { dmnmx = d2; } else if (d3 < d1) { dmnmx = d3; } else { dmnmx = d1; } } if (dir == 0) { /* Sort into decreasing order */ i = start - 1; j = endd + 1; L60: L70: --j; if (D(j) < dmnmx) { goto L70; } L80: ++i; if (D(i) > dmnmx) { goto L80; } if (i < j) { tmp = D(i); D(i) = D(j); D(j) = tmp; goto L60; } if (j - start > endd - j - 1) { ++stkpnt; STACK((stkpnt << 1) - 2) = start; STACK((stkpnt << 1) - 1) = j; ++stkpnt; STACK((stkpnt << 1) - 2) = j + 1; STACK((stkpnt << 1) - 1) = endd; } else { ++stkpnt; STACK((stkpnt << 1) - 2) = j + 1; STACK((stkpnt << 1) - 1) = endd; ++stkpnt; STACK((stkpnt << 1) - 2) = start; STACK((stkpnt << 1) - 1) = j; } } else { /* Sort into increasing order */ i = start - 1; j = endd + 1; L90: L100: --j; if (D(j) > dmnmx) { goto L100; } L110: ++i; if (D(i) < dmnmx) { goto L110; } if (i < j) { tmp = D(i); D(i) = D(j); D(j) = tmp; goto L90; } if (j - start > endd - j - 1) { ++stkpnt; STACK((stkpnt << 1) - 2) = start; STACK((stkpnt << 1) - 1) = j; ++stkpnt; STACK((stkpnt << 1) - 2) = j + 1; STACK((stkpnt << 1) - 1) = endd; } else { ++stkpnt; STACK((stkpnt << 1) - 2) = j + 1; STACK((stkpnt << 1) - 1) = endd; ++stkpnt; STACK((stkpnt << 1) - 2) = start; STACK((stkpnt << 1) - 1) = j; } } } if (stkpnt > 0) { goto L10; } return 0; /* End of SLASRT */ } /* slasrt_ */