/// Funkce vloží na danou pozici řetězec @a s
void printxyd_P(int y,int x,void * s){
int n = 0;
int n_x = 0;
char c;
if ((x < LCD_X_MAX)&&(y < LCD_Y_MAX)){
//Kopíruj do pole lcd
c = pgm_read_byte_near(s);
while ((c != '\0') && ( (x + n_x) < LCD_X_MAX)){
//screen[y][x+n_x]=c;
default_screen[y][x+n_x] = c;
n++;
n_x++;
c = pgm_read_byte_near(s+n);
if(c == '\n'){
y++;
n_x = 0;
n++;
c = pgm_read_byte_near(s+n);
if (y >= LCD_Y_MAX){
new_error(80);
break;
}
}
}
if ((x+n_x) > LCD_X_MAX){
new_error(81);
}
}
else{
new_error(82);
}
}
error oprdStackCalcuOnce(OprdStack* oprdstk, OptrInfo op) {
switch (op.op_type) {
case OP_TYPE_LUNARY:
case OP_TYPE_RUNARY: {
// get the operand of the unary operator
if (oprdStackIsEmpty(oprdstk) == true) {
return new_error("no enough operands.");
}
ASTNodeExpr* oprd = oprdStackTop(oprdstk);
oprdStackPop(oprdstk);
// get the result expression
ASTNodeExpr* calcu_ret = (ASTNodeExpr*)mem_alloc(sizeof(ASTNodeExpr*));
calcu_ret->expr_type = AST_NODE_EXPR_UNRY;
calcu_ret->expr.expr_unary = (ASTNodeExprUnry*)mem_alloc(sizeof(ASTNodeExprUnry));
calcu_ret->expr.expr_unary->op_token_code = op.op_token_code;
calcu_ret->expr.expr_unary->oprd = oprd;
oprdStackPush(oprdstk, calcu_ret);
}
break;
case OP_TYPE_BINARY: {
// get the two operands of the binary operator
if (oprdStackIsEmpty(oprdstk) == true) {
return new_error("no enough operands.");
}
ASTNodeExpr* oprd2 = oprdStackTop(oprdstk);
oprdStackPop(oprdstk);
if (oprdStackIsEmpty(oprdstk) == true) {
return new_error("no enough operands.");
}
ASTNodeExpr* oprd1 = oprdStackTop(oprdstk);
oprdStackPop(oprdstk);
// get the result expression
ASTNodeExpr* calcu_ret = (ASTNodeExpr*)mem_alloc(sizeof(ASTNodeExpr));
calcu_ret->expr_type = AST_NODE_EXPR_BNRY;
calcu_ret->expr.expr_binary = (ASTNodeExprBnry*)mem_alloc(sizeof(ASTNodeExprBnry));
calcu_ret->expr.expr_binary->op_token_code = op.op_token_code;
calcu_ret->expr.expr_binary->oprd1 = oprd1;
calcu_ret->expr.expr_binary->oprd2 = oprd2;
oprdStackPush(oprdstk, calcu_ret);
}
break;
}
return NULL;
}
/*
* Port allocation
*/
static cell_t *init_port_mode(secd_t *secd, cell_t *cell, const char *mode) {
switch (mode[0]) {
case 'r':
cell->as.port.input = true;
if (mode[1] == '+') {
cell->as.port.output = true;
++mode;
} else
cell->as.port.output = false;
if (mode[1] == '\0')
return cell;
break;
case 'w': case 'a':
cell->as.port.output = true;
if (mode[1] == '+') {
cell->as.port.input = true;
++mode;
} else
cell->as.port.input = false;
if (mode[1] == '\0')
return cell;
}
// otherwise fail:
drop_cell(secd, cell);
errorf("new_fileport: failed to parse mode\n");
return new_error(secd, "new_port: failed to parse mode");
}
/* check arity;
* possibly rewrite dot-lists into regular arguments;
* look for overriden *stdin*|*stdout* */
static cell_t *
walk_through_arguments(secd_t *secd, cell_t *frame, cell_t **args_io) {
cell_t *symlist = get_car(frame);
cell_t *vallist = get_cdr(frame);
size_t valcount = 0;
while (not_nil(symlist)) {
if (is_symbol(symlist)) {
break;
}
if (is_nil(vallist)) {
errorf(";; arity mismatch: %zd argument(s) is not enough\n", valcount);
return new_error(secd, SECD_NIL,
"arity mismatch: %zd argument(s) is not enough", valcount);
}
cell_t *sym = get_car(symlist);
check_io_args(secd, sym, get_car(vallist), args_io);
cell_t *nextsyms = list_next(secd, symlist);
cell_t *nextvals = list_next(secd, vallist);
++valcount;
symlist = nextsyms;
vallist = nextvals;
}
return SECD_NIL;
}
/// Funkce vloží na danou pozici řetězec @a s
void printxy(char (*screen)[LCD_X_MAX],int y,int x,char * s){
int n = 0;
int n_x = 0;
char c;
if (s == NULL){
s = "NULL";
}
if ((x < LCD_X_MAX)&&(y < LCD_Y_MAX)){
//Kopíruj do pole lcd
c = s[0];
while ((c != '\0') && ( (x + n_x) < LCD_X_MAX)){
screen[y][x+n_x]=c;
//default_screen[y][x+n_x] = c;
n++;
n_x++;
c = s[n];
if(c == '\n'){
y++;
n_x = 0;
n++;
c = s[n];
if (y >= LCD_Y_MAX){
new_error(80);
break;
}
}
}
if ((x+n_x) > LCD_X_MAX){
new_error(81);
}
}
else{
new_error(82);
}
}
cell_t *lookup_env(secd_t *secd, const char *symbol, cell_t **symc) {
cell_t *env = secd->env;
assert(cell_type(env) == CELL_CONS,
"lookup_env: environment is not a list");
cell_t *res = lookup_fake_variables(secd, symbol);
if (not_nil(res))
return res;
hash_t symh = secd_strhash(symbol);
while (not_nil(env)) { // walk through frames
cell_t *frame = get_car(env);
if (is_nil(frame)) {
/* skip omega-frame */
env = list_next(secd, env);
continue;
}
cell_t *symlist = get_car(frame);
cell_t *vallist = get_cdr(frame);
while (not_nil(symlist)) { // walk through symbols
if (is_symbol(symlist)) {
if (symh == symhash(symlist) && str_eq(symbol, symname(symlist))) {
if (symc != NULL) *symc = symlist;
return vallist;
}
break;
}
cell_t *curc = get_car(symlist);
assert(is_symbol(curc),
"lookup_env: variable at [%ld] is not a symbol\n",
cell_index(secd, curc));
if (symh == symhash(curc) && str_eq(symbol, symname(curc))) {
if (symc != NULL) *symc = curc;
return get_car(vallist);
}
symlist = list_next(secd, symlist);
vallist = list_next(secd, vallist);
}
env = list_next(secd, env);
}
//errorf(";; error in lookup_env(): %s not found\n", symbol);
return new_error(secd, SECD_NIL, "Lookup failed for: '%s'", symbol);
}
/* Deallocation */
cell_t *drop_dependencies(secd_t *secd, cell_t *c) {
enum cell_type t = cell_type(c);
switch (t) {
case CELL_SYM:
if (c->as.sym.size != DONT_FREE_THIS)
free((char *)c->as.sym.data);
/* TODO: this silently ignores symbol memory corruption */
c->as.sym.size = DONT_FREE_THIS;
break;
case CELL_FRAME:
drop_cell(secd, c->as.frame.io);
// fall through
case CELL_CONS:
if (not_nil(c)) {
drop_cell(secd, get_car(c));
drop_cell(secd, get_cdr(c));
}
break;
case CELL_STR:
case CELL_ARRAY:
drop_array(secd, arr_mem(c));
break;
case CELL_REF:
drop_cell(secd, c->as.ref);
break;
case CELL_PORT:
secd_pclose(secd, c);
break;
case CELL_ARRMETA:
if (c->as.mcons.cells) {
size_t size = arrmeta_size(secd, c);
size_t i;
/* free the items */
for (i = 0; i < size; ++i) {
/* don't free uninitialized */
cell_t *ith = meta_mem(c) + i;
if (cell_type(ith) != CELL_UNDEF)
drop_dependencies(secd, ith);
}
}
break;
case CELL_INT: case CELL_FUNC: case CELL_OP:
case CELL_ERROR: case CELL_UNDEF:
return c;
default:
return new_error(secd, "drop_dependencies: unknown cell_type 0x%x", t);
}
return c;
}
/*
* allocate a symbol table data structure
*/
SYMBOL_TABLE *new_symbol_table( char *buffer, int length)
{
SYMBOL_TABLE *symbol_table;
if( !(symbol_table = ( SYMBOL_TABLE*)malloc( sizeof( SYMBOL_TABLE))))
new_error( sizeof( SYMBOL_TABLE));
else
{
memset( (void *)symbol_table, 0, (size_t)sizeof( SYMBOL_TABLE));
if( length)
{
symbol_table->string = new_buffer( buffer, length);
symbol_table->length = length;
symbol_table->index = data.count++;
}
data.memory += sizeof( SYMBOL_TABLE);
}
return( symbol_table);
}
/*
* allocate a quad data structure
*/
QUAD *new_quad( int operator, int dst_type, int dst_index, int op1_type, int op1_index, int op2_type, int op2_index)
{
QUAD *quad;
if( !(quad = ( QUAD*)malloc( sizeof( QUAD))))
new_error( sizeof( QUAD));
else
{
memset( (void *)quad, 0, (size_t)sizeof( QUAD));
quad->operator = operator;
quad->dst_type = dst_type;
quad->dst_index = dst_index;
quad->op1_type = op1_type;
quad->op1_index = op1_index;
quad->op2_type = op2_type;
quad->op2_index = op2_index;
data.memory += sizeof( QUAD);
}
return( quad);
}
/*
* allocate buffer memory routine
*/
char *new_buffer( char *text, int length)
{
char *buffer = 0;
if( 0 < length)
{
if( !( buffer = (char*)malloc( length)))
new_error( length);
else
{
/*
* initialize the buffer to zero and copy in text
*/
memset( (void *)buffer, 0, (size_t)length);
strncpy( buffer, text, length);
data.memory += length;
}
}
return( buffer);
}
static bool about_to_halt(secd_t *secd, int opind, cell_t **ret) {
switch (opind) {
case SECD_STOP:
*ret = SECD_NIL;
return true;
case SECD_RTN:
if (not_nil(secd->dump) && is_nil(get_car(secd->dump))) {
pop_dump(secd);
/* return into native code */
if (is_nil(secd->stack)) {
*ret = new_error(secd, SECD_NIL,
"secd_run: No value on stack to return");
} else {
*ret = list_head(secd->stack);
}
return true;
}
}
return false;
}
/*
* allocate a tuple data structure
*/
TUPLE *new_tuple( int token, unsigned char value, int address, int mask, char *buffer, int length)
{
TUPLE *tuple;
if( !(tuple = ( TUPLE*)malloc( sizeof( TUPLE))))
new_error( sizeof( TUPLE));
else
{
memset( (void *)tuple, 0, (size_t)sizeof( TUPLE));
tuple->token = token;
tuple->value = value;
tuple->address = address;
tuple->mask = mask;
if( 0 < length)
{
tuple->length = length;
tuple->buffer = new_buffer( buffer, length);
}
data.memory += sizeof( TUPLE);
}
return( tuple);
}
void kf_start(void){
switch(msr_status){
case ZMERENY_PRUMERY:
if (get_menu_jmena_i() == 255){
new_error(94);
}
else{
uloz_posledni_data();
msr_start();
}
break;
case VOLNO:
msr_start();
break;
case PAUSE_L_NEZMERENO:
case PAUSE_L_ZMERENO:
msr_unpause();
break;
default:
break;
}
}
void MainWindow::create_menu(Gtk::VBox *vbox)
{
// Create actions for menu and toolbar.
refActionGroup = Gtk::ActionGroup::create();
// File menu
refActionGroup->add(Gtk::Action::create("MenuFile", _("_File")));
// File submenu
refActionGroup->add(Gtk::Action::create("FileNew", Gtk::Stock::NEW, _("_New project...")),
sigc::mem_fun(*this, &MainWindow::on_action_file_new));
refActionGroup->add(Gtk::Action::create("FileOpen", Gtk::Stock::OPEN, _("_Open project")),
sigc::mem_fun(*this, &MainWindow::on_action_file_open));
refActionGroup->add(Gtk::Action::create("FileDelete", Gtk::Stock::DELETE, _("_Delete project")),
sigc::mem_fun(*this, &MainWindow::on_action_file_delete));
refActionGroup->add(Gtk::Action::create("FileExport", Gtk::Stock::GO_FORWARD, _("_Export project...")),
sigc::mem_fun(*this, &MainWindow::on_action_file_export));
refActionGroup->add(Gtk::Action::create("FileImport", Gtk::Stock::GO_BACK, _("_Import project...")),
sigc::mem_fun(*this, &MainWindow::on_action_file_import));
refActionGroup->add(Gtk::Action::create("FileExit", Gtk::Stock::QUIT, _("_Quit")),
sigc::mem_fun(*this, &MainWindow::on_action_file_exit));
// Help menu
refActionGroup->add(Gtk::Action::create("MenuHelp", _("_Help")));
// Help submenu
refActionGroup->add(Gtk::Action::create("HelpHelp", Gtk::Stock::HELP),
sigc::mem_fun(*this, &MainWindow::on_action_help_help));
refActionGroup->add(Gtk::Action::create("HelpAbout", Gtk::Stock::ABOUT, _("_About Handle Project")),
sigc::mem_fun(*this, &MainWindow::on_action_help_about));
refUIManager = Gtk::UIManager::create();
refUIManager->insert_action_group(refActionGroup);
add_accel_group(refUIManager->get_accel_group());
Glib::ustring ui_info =
"<ui>"
" <menubar name='MenuBar'>"
" <menu action='MenuFile'>"
" <menuitem action='FileNew'/>"
" <menuitem action='FileOpen'/>"
" <separator/>"
" <menuitem action='FileDelete'/>"
" <separator/>"
" <menuitem action='FileExport'/>"
" <menuitem action='FileImport'/>"
" <separator/>"
" <menuitem action='FileExit'/>"
" </menu>"
" <menu action='MenuHelp'>"
" <menuitem action='HelpHelp'/>"
" <menuitem action='HelpAbout'/>"
" </menu>"
" </menubar>"
" <toolbar name='ToolBar'>"
" <toolitem action='FileNew'/>"
" <toolitem action='FileOpen'/>"
" <toolitem action='FileDelete'/>"
" </toolbar>"
"</ui>";
try
{
refUIManager->add_ui_from_string(ui_info);
}
catch(const Glib::Error& err)
{
new_error("Can not create menu and toolbar."+ err.what(), "mainwindow.cpp",
"MainWindow::create_menu()");
}
Gtk::Widget* pMenubar = refUIManager->get_widget("/MenuBar");
if(pMenubar)
vbox->pack_start(*pMenubar, Gtk::PACK_SHRINK);
Gtk::Widget* pToolbar = refUIManager->get_widget("/ToolBar");
if(pToolbar)
vbox->pack_start(*pToolbar, Gtk::PACK_SHRINK);
}
cell_t *read_list(secd_t *secd, secd_parser_t *p) {
const char *parse_err = NULL;
cell_t *head = SECD_NIL;
cell_t *tail = SECD_NIL;
cell_t *newtail, *val;
while (true) {
int tok = lexnext(p);
switch (tok) {
case TOK_EOF: case ')':
-- p->nested;
return head;
case '(':
++ p->nested;
val = read_list(secd, p);
if (p->token == TOK_ERR) {
parse_err = "read_list: error reading subexpression";
goto error_exit;
}
if (p->token != ')') {
parse_err = "read_list: TOK_EOF, ')' expected";
goto error_exit;
}
break;
default:
val = read_token(secd, p);
if (is_error(val)) {
parse_err = "read_list: read_token failed";
goto error_exit;
}
/* reading dot-lists */
if (is_symbol(val) && (str_eq(symname(val), "."))) {
free_cell(secd, val);
switch (lexnext(p)) {
case TOK_ERR: case ')':
parse_err = "read_list: failed to read a token after dot";
goto error_exit;
case '(':
/* there may be a list after dot */
val = read_list(secd, p);
if (p->token != ')') {
parse_err = "read_list: expected a ')' reading sublist after dot";
goto error_exit;
}
lexnext(p); // consume ')'
break;
default:
val = read_token(secd, p);
lexnext(p);
}
if (is_nil(head)) /* Guile-like: (. val) returns val */
return val;
tail->as.cons.cdr = share_cell(secd, val);
return head;
}
}
newtail = new_cons(secd, val, SECD_NIL);
if (not_nil(head)) {
tail->as.cons.cdr = share_cell(secd, newtail);
tail = newtail;
} else {
head = tail = newtail;
}
}
error_exit:
free_cell(secd, head);
errorf("read_list: TOK_ERR, %s\n", parse_err);
return new_error(secd, SECD_NIL, parse_err);
}
static cell_t *read_token(secd_t *secd, secd_parser_t *p) {
int tok;
cell_t *inp = NULL;
switch (tok = p->token) {
case '(':
++p->nested;
inp = read_list(secd, p);
if (p->token != ')')
goto error_exit;
return inp;
case TOK_NUM:
return new_number(secd, p->numtok);
case TOK_CHAR:
return new_char(secd, p->numtok);
case TOK_SYM:
return new_symbol(secd, p->symtok);
case TOK_STR:
inp = new_string(secd, strmem(p->strtok));
drop_cell(secd, p->strtok);
return inp;
case TOK_EOF:
return new_symbol(secd, EOF_OBJ);
case TOK_QUOTE: case TOK_QQ:
case TOK_UQ: case TOK_UQSPL: {
const char *formname = special_form_for(tok);
assert(formname, "No special form for token=%d\n", tok);
inp = sexp_read(secd, p);
assert_cell(inp, "sexp_read: reading subexpression failed");
return new_cons(secd, new_symbol(secd, formname),
new_cons(secd, inp, SECD_NIL));
}
case '#':
switch (tok = lexnext(p)) {
case '(': {
cell_t *tmplist = read_list(secd, p);
if (p->token != ')') {
free_cell(secd, tmplist);
goto error_exit;
}
inp = list_to_vector(secd, tmplist);
free_cell(secd, tmplist);
return inp;
}
case TOK_SYM: {
if (p->symtok[0] == '.') {
int op = secdop_by_name(p->symtok + 1);
if (op < 0)
goto error_exit;
return new_op(secd, op);
}
if (str_eq(p->symtok, "u8")) {
lexnext(p);
inp = read_bytevector(p);
if (p->token != ')')
goto error_exit;
return inp;
}
}
}
errorf("Unknown suffix for #\n");
}
error_exit:
if (inp) free_cell(secd, inp);
errorf("read_token: failed\n");
return new_error(secd, SECD_NIL,
"read_token: failed on token %1$d '%1$c'", p->token);
}
static void err_msg_big_integer(const char *msg, int bits, linepos_t epoint) {
char msg2[256];
new_error(SV_CONDERROR, current_file_list, epoint);
sprintf(msg2, msg, bits);
adderror(msg2);
}
static void err_msg_char_name(const char *msg, const char *name, linepos_t epoint) {
new_error(SV_CONDERROR, current_file_list, epoint);
adderror(msg);
str_name((const uint8_t *)name, strlen(name));
}
static void err_msg_str_name(const char *msg, const str_t *name, linepos_t epoint) {
new_error(SV_ERROR, current_file_list, epoint);
adderror(msg);
if (name) str_name(name->data, name->len);
}
void err_msg2(enum errors_e no, const void *prm, linepos_t epoint) {
if (no < 0x40) {
new_error(SV_WARNING, current_file_list, epoint);
if (!arguments.warning) return;
if (no == ERROR_WUSER_DEFINED) adderror2(((value_t)prm)->u.str.data, ((value_t)prm)->u.str.len);
else adderror(terr_warning[no]);
return;
}
if (no < 0x80) {
char line[1024];
switch (no) {
case ERROR____PAGE_ERROR:
case ERROR_BRANCH_TOOFAR:
case ERROR____PTEXT_LONG:
case ERROR__BRANCH_CROSS:
case ERROR__USER_DEFINED:
case ERROR___UNKNOWN_CHR:
case ERROR_CANT_CROSS_BA:
case ERROR_OUTOF_SECTION:
case ERROR_DIVISION_BY_Z:
case ERROR_NO_ZERO_VALUE:
case ERROR_CONSTNT_LARGE:
case ERROR_NUMERIC_OVERF:
case ERROR_NEGFRAC_POWER:
case ERROR_SQUARE_ROOT_N:
case ERROR_LOG_NON_POSIT:
case ERROR___MATH_DOMAIN: new_error(SV_CONDERROR, current_file_list, epoint); break;
default: new_error(SV_ERROR, current_file_list, epoint);
}
switch (no) {
case ERROR____PAGE_ERROR:
adderror("page error at $");
sprintf(line,"%06" PRIaddress, *(const address_t *)prm); adderror(line);
break;
case ERROR_BRANCH_TOOFAR:
sprintf(line,"branch too far by %+d bytes", *(const int *)prm); adderror(line);
break;
case ERROR____PTEXT_LONG:
sprintf(line,"ptext too long by %lu bytes", (unsigned long)*(const size_t *)prm - 0x100); adderror(line);
break;
case ERROR__BRANCH_CROSS:
adderror("branch crosses page");
break;
case ERROR__USER_DEFINED:
adderror2(((value_t)prm)->u.str.data, ((value_t)prm)->u.str.len);
break;
case ERROR___UNKNOWN_CHR:
sprintf(line,"can't encode character $%02x", *(const uint32_t *)prm); adderror(line);
break;
case ERROR______EXPECTED:
adderror((char *)prm);
adderror(" expected");
break;
case ERROR___NOT_ALLOWED:
adderror("not allowed here: ");
adderror((char *)prm);
break;
case ERROR_RESERVED_LABL:
adderror("reserved symbol name '");
adderror2(((str_t *)prm)->data, ((str_t *)prm)->len);
adderror("'");
break;
case ERROR_____NOT_BANK0:
case ERROR____NOT_DIRECT:
case ERROR__NOT_DATABANK:
adderror(terr_error[no & 63]);
adderror(" '");
err_msg_variable((value_t)prm, epoint);
adderror("'");
break;
case ERROR___UNKNOWN_CPU:
adderror("unknown processor ");
err_msg_variable((value_t)prm, epoint);
break;
default:
adderror(terr_error[no & 63]);
}
return;
}
new_error(SV_FATAL, current_file_list, epoint);
switch (no) {
case ERROR_UNKNOWN_OPTIO:
adderror("unknown option '");
adderror2(((str_t *)prm)->data, ((str_t *)prm)->len);
adderror("'");
break;
default:
adderror(terr_fatal[no & 63]);
}
status(1);exit(1);
}