void do_forget (void) { char name[16]; header *hd; int r; if (udfon) { output("Cannot forget functions in a function!\n"); error=720; return; } while (1) { scan_space(); scan_name(name); r=xor(name); hd=(header *)ramstart; while ((char *)hd<udfend) { if (r==hd->xor && !strcmp(hd->name,name)) break; hd=nextof(hd); } if ((char *)hd>=udfend) { output1("Function %s not found!\n",name); error=160; return; } kill_udf(name); scan_space(); if (*next!=',') break; else next++; } }
int JSON::parse_array(const char *begin, const char *end, bool withname, std::vector<JSON::Node> *children) { children->clear(); char const *ptr = begin; while (1) { int n; Node node; if (withname) { n = parse_name(ptr, end, &node); if (n > 0) { ptr += n; ptr += scan_space(ptr, end); if (*ptr == ':') { ptr++; } } } n = parse_value(ptr, end, &node); if (node.type != Type::Unknown) { children->push_back(node); } ptr += n; ptr += scan_space(ptr, end); if (ptr < end && *ptr == ',') { ptr++; continue; } return ptr - begin; } }
void do_loop (void) /***** do_loop do a loop command in a UDF. loop value to value; .... ; end *****/ { int h; char *jump; header *init,*end; long vend,oldindex; if (!udfon) { output("Loop only allowed in functions!\n"); error=57; return; } init=scan(); if (error) return; init=getvalue(init); if (error) return; if (init->type!=s_real) { output("Startvalue must be real!\n"); error=72; return; } oldindex=loopindex; loopindex=(long)*realof(init); scan_space(); if (strncmp(next,"to",2)) { output("Endvalue missing in loop!\n"); error=73; goto end; } next+=2; end=scan(); if (error) goto end; end=getvalue(end); if (error) goto end; if (end->type!=s_real) { output("Endvalue must be real!\n"); error=73; goto end; } vend=(long)*realof(end); if (loopindex>vend) { scan_end(); goto end; } newram=endlocal; scan_space(); if (*next==';' || *next==',') next++; jump=next; while (!error) { if (*next==1) { output("End missing in loop!\n"); error=401; goto end; } h=command(); if (udfon!=1 || h==c_return) break; if (h==c_break) { scan_end(); break; } if (h==c_end) { loopindex++; if (loopindex>vend) break; else next=jump; if (test_key()==escape) { output("User interrupted!\n"); error=1; break; } } } end : loopindex=oldindex; }
void do_repeat (void) /***** do_loop do a loop command in a UDF. for value to value; .... ; endfor *****/ { int h; char *jump; if (!udfon) { output("Repeat only allowed in functions!\n"); error=57; return; } newram=endlocal; scan_space(); if (*next==';' || *next==',') next++; jump=next; while (!error) { if (*next==1) { output("End missing in repeat statement!\n"); error=401; break; } h=command(); if (udfon!=1 || h==c_return) break; if (h==c_break) { scan_end(); break; } if (h==c_end) { next=jump; if (test_key()==escape) { output1("User interrupted\n"); error=1; break; } } } }
void do_do (void) { int udfold; char name[16]; char *oldnext=next,*udflineold; header *var; scan_space(); scan_name(name); if (error) return; var=searchudf(name); if (!var || var->type!=s_udf) { output("Need a udf!\n"); error=220; return; } udflineold=udfline; udfline=next=udfof(var); udfold=udfon; udfon=1; while (!error && udfon==1) { command(); if (udfon==2) break; if (test_key()==escape) { output("User interrupted!\n"); error=58; break; } } if (error) output1("Error in function %s\n",var->name); if (udfon==0) { output1("Return missing in %s!\n",var->name); error=55; } udfon=udfold; udfline=udflineold; if (udfon) next=oldnext; else { next=input_line; *next=0; } }
void do_cd (void) { header *hd; char name[256]; char *s; scan_space(); if (*next==';' || *next==',' || *next==0) { s=cd(""); output1("%s\n",s); return; } if (*next=='(') { hd=scan_value(); if (error) return; if (hd->type!=s_string) { output("String value expected!\n"); error=1; return; } strcpy(name,stringof(hd)); } else { scan_namemax(name,256); } if (error) return; s=cd(name); if (*next!=';') output1("%s\n",s); if (*next==',' || *next==';') next++; }
int JSON::parse_value(const char *begin, const char *end, JSON::Node *node) { char const *ptr = begin; int n; ptr += scan_space(ptr, end); if (ptr < end) { if (*ptr == '[') { ptr++; node->type = Type::Array; n = parse_array(ptr, end, false, &node->children); ptr += n; if (ptr < end && *ptr == ']') { ptr++; return ptr - begin; } } else if (*ptr == '{') { ptr++; node->type = Type::Object; n = parse_array(ptr, end, true, &node->children); ptr += n; if (ptr < end && *ptr == '}') { ptr++; return ptr - begin; } } else if (*ptr == '\"') { n = parse_string(ptr, end, &node->value); if (n > 0) { ptr += n; node->type = Type::String; return ptr - begin; } } else { char const *left = ptr; while (ptr < end) { int c = *ptr & 0xff; if (isspace(c)) break; if (strchr("[]{},:\"", c)) break; ptr++; } if (left < ptr) { std::string value(left, ptr); if (value == "null") { node->type = Type::Null; } else if (value == "false") { node->type = Type::Boolean; node->value = "0"; } else if (value == "true") { node->type = Type::Boolean; node->value = "1"; } else { node->type = Type::Number; node->value = value; } return ptr - begin; } } } return 0; }
void load_file (void) /***** load_file interpret a file. *****/ { char filename[256]; char oldline[1024],fn[256],*oldnext; int oldbooktype=booktype,pn; header *hd; FILE *oldinfile; if (udfon) { output("Cannot load a file in a function!\n"); error=221; return; } scan_space(); if (*next=='(') { hd=scan_value(); if (error) return; if (hd->type!=s_string) { output("String value expected!\n"); error=1; return; } strcpy(filename,stringof(hd)); } else { scan_namemax(filename,256); } if (error) return; oldinfile=infile; pn=-1; retry : if (pn>=0) { strcpy(fn,path[pn]); strcat(fn,PATH_DELIM_STR); strcat(fn,filename); } else strcpy(fn,filename); infile=fopen(fn,"r"); if (!infile) { strcat(fn,EXTENSION); infile=fopen(fn,"r"); pn++; if (!infile) { if (pn>=npath) { output1("Could not open %s!\n",filename); error=53; infile=oldinfile; return; } else goto retry; } } strcpy(oldline,input_line); oldnext=next; *input_line=0; next=input_line; booktype=0; while (!error && infile && !quit) command(); booktype=oldbooktype; if (infile) fclose(infile); infile=oldinfile; strcpy(input_line,oldline); next=oldnext; }
void do_trace(void) /**** do_trace toggles tracing or sets the trace bit of a udf. ****/ { header *f; char name[64]; scan_space(); if (!strncmp(next,"off",3)) { trace=0; next+=3; } else if (!strncmp(next,"alloff",6)) { next+=6; f=(header *)ramstart; while ((char *)f<udfend && f->type==s_udf) { f->flags&=~1; f=nextof(f); } trace=0; } else if (!strncmp(next,"on",2)) { trace=1; next+=2; } else if (*next==';' || *next==',' || *next==0) trace=!trace; else { if (*next=='"') next++; scan_name(name); if (error) return; if (*next=='"') next++; f=searchudf(name); if (!f || f->type!=s_udf) { output("Function not found!\n"); error=11021; return; } f->flags^=1; if (f->flags&1) output1("Tracing %s\n",name); else output1("No longer tracing %s\n",name); scan_space(); } if (*next==';' || *next==',') next++; }
void do_comments (void) /**** do_comments toggles comments ****/ { scan_space(); if (!strncmp(next,"off",3)) { printcomments=0; next+=3; } else if (!strncmp(next,"on",2)) { printcomments=1; output("\n"); next+=2; } else printcomments=!printcomments; }
void do_prompt (void) /**** do_prompt toggles notebook prompt. ****/ { scan_space(); if (!strncmp(next,"off",3)) { promptnotebook=0; next+=3; } else if (!strncmp(next,"on",2)) { promptnotebook=1; output("\n"); next+=2; } else promptnotebook=!promptnotebook; }
void do_output (void) /**** do_output toggles output. ****/ { scan_space(); if (!strncmp(next,"off",3)) { outputing=0; next+=3; } else if (!strncmp(next,"on",2)) { outputing=1; output("\n"); next+=2; } else outputing=!outputing; }
void load_book (void) /***** load_book interpret a notebook file. *****/ { header *hd; char name[256]; char oldline[1024],fn[256],*oldnext; int oldbooktype=booktype; FILE *oldinfile; if (udfon) { output("Cannot load a notebook in a function!\n"); error=221; return; } scan_space(); if (*next=='(') { hd=scan_value(); if (error) return; if (hd->type!=s_string) { output("String value expected!\n"); error=1; return; } strcpy(name,stringof(hd)); } else { scan_namemax(name,256); } if (error) return; oldinfile=infile; infile=fopen(name,"r"); if (!infile) { strcpy(fn,name); strcat(fn,BOOKEXTENSION); infile=fopen(fn,"r"); if (!infile) { output1("Could not open %s!\n",stringof(name)); error=53; infile=oldinfile; return; } } strcpy(oldline,input_line); oldnext=next; *input_line=0; next=input_line; booktype=1; while (!error && infile && !quit) { startglobal=startlocal; endglobal=endlocal; command(); } booktype=oldbooktype; if (infile) fclose(infile); infile=oldinfile; strcpy(input_line,oldline); next=oldnext; }
int command (void) /***** command scan a command and interpret it. return, if the user wants to quit. *****/ { header *expr; int ret=c_none; quit=0; error=0; errorout=0; while(1) { scan_space(); if (*next) break; else next_line(); } if (*next==1) return ret; expr=scan_expression(); if (!expr) { newram=endlocal; return ret; } if (error) { newram=endlocal; print_error(next); next=input_line; input_line[0]=0; return ret; } if (expr==&commandheader) { newram=endlocal; return commandtype; } switch (expr->type) { case s_real : case s_complex : case s_matrix : case s_cmatrix : case s_imatrix : case s_string : case s_interval : if (*next!=';') give_out(expr); if (*next==',' || *next==';') next++; break; case s_reference : case s_submatrix : case s_csubmatrix : case s_isubmatrix : do_assignment(expr); break; default : break; } if (error) print_error(next); newram=endlocal; if (error) { next=input_line; input_line[0]=0; } return ret; }
void do_global (void) { char name[16]; int r; header *hd; while (1) { scan_space(); scan_name(name); r=xor(name); hd=(header *)udfend; if (hd==(header *)startlocal) break; while ((char *)hd<startlocal) { if (r==hd->xor && !strcmp(hd->name,name)) break; hd=nextof(hd); } if ((char *)hd>=startlocal) { output1("Variable %s not found!\n",name); error=160; return; } newram=endlocal; hd=new_reference(hd,name); newram=endlocal=(char *)nextof(hd); scan_space(); if (*next!=',') break; else next++; } }
void do_postscript (void) { header *file; scan_space(); file=scan_value(); if (error || file->type!=s_string) { output("Postscript needs a filename!\n"); error=201; return; } FILE *metafile=fopen(stringof(file),"w"); if (!metafile) { output1("Could not open %s.\n",stringof(file)); } dump_postscript(metafile); fclose(metafile); }
void do_dump (void) { header *file; if (outfile) { if (fclose(outfile)) { output("Error while closing dumpfile.\n"); } outfile=0; } scan_space(); if (*next==';' || *next==',' || *next==0) { if (*next) next++; return; } file=scan_value(); if (error || file->type!=s_string) { output("Dump needs a filename!\n"); error=201; return; } outfile=fopen(stringof(file),"a"); if (!outfile) { output1("Could not open %s.\n",stringof(file)); } }
void do_dir (void) { header *file; char *s; scan_space(); if (*next==';' || *next==',' || *next==0) { file=new_string("*.*",5,""); } else file=scan_value(); if (error || file->type!=s_string) { output("Dir needs a string!\n"); error=201; return; } s=dir(stringof(file)); if (!s || !*s) return; output1("%s\n",s); while (1) { s=dir(0); if (!s || !*s) break; output1("%s\n",s); } if (*next==',' || *next==';') next++; }
void do_path (void) { header *ppath; char s[256],*p,*q; int i; scan_space(); if (*next==';' || *next==',' || *next==0) { out : for (i=0; i<npath; i++) { output1("%s;",path[i]); } output("\n"); return; } ppath=scan_value(); if (error || ppath->type!=s_string) { output("Path needs a string!\n"); error=201; return; } p=stringof(ppath); for (i=0; i<npath; i++) free(path[i]); npath=0; while (*p) { q=s; while (*p && *p!=';') *q++=*p++; if (q>s && *(q-1)==PATH_DELIM_CHAR) q--; *q=0; if (*p==';') p++; path[npath]=(char *)malloc(strlen(s)+1); strcpy(path[npath],s); npath++; } if (npath==0) { path[0]=(char *)malloc(5); strcpy(path[0],"."); } if (*next!=';') goto out; }
int JSON::parse_name(const char *begin, const char *end, JSON::Node *node) { char const *ptr = begin; ptr += scan_space(ptr, end); char const *name = ptr; int quote = 0; if (*ptr == '\"') { quote = *ptr; name++; ptr++; } while (ptr < end) { if (quote) { if (*ptr == quote) { if (name < ptr) { node->name = std::string(name, ptr); ptr++; return ptr - begin; } else { return 0; } } else { ptr++; } } else if (strchr(":={}[]", *ptr) || isspace(*ptr & 0xff)) { if (name < ptr) { node->name = std::string(name, ptr); return ptr - begin; } return 0; } else { ptr++; } } return 0; }
void do_hexdump (void) { char name[16]; unsigned char *p,*end; int i=0,j; ULONG count=0; header *hd; scan_space(); scan_name(name); if (error) return; hd=searchvar(name); if (!hd) hd=searchudf(name); if (error || hd==0) return; p=(unsigned char *)hd; end=p+hd->size; output1("\n%5lx ",count); while (p<end) { hex_out(*p++); i++; count++; if (i>=16) { i=0; string_out(p-16); output1("\n%5lx ",count); if (test_key()==escape) break; } } for (j=i; j<16; j++) output(" "); string_out(p-i); output("\n"); }
callin_entry_list* citab_parse (void) { int parameter_count, i, fclose_res; uint4 inp_mask, out_mask, mask; mstr labref, callnam; enum xc_types ret_tok, parameter_types[MAXIMUM_PARAMETERS], pr; char str_buffer[MAX_TABLINE_LEN], *tbp, *end; FILE *ext_table_file_handle; callin_entry_list *entry_ptr, *save_entry_ptr = 0; error_def(ERR_CITABENV); error_def(ERR_CITABOPN); error_def(ERR_CIENTNAME); error_def(ERR_COLON); error_def(ERR_CIRTNTYP); error_def(ERR_CIRCALLNAME); error_def(ERR_CIDIRECTIVE); error_def(ERR_CIRPARMNAME); error_def(ERR_CIPARTYPE); error_def(ERR_CIUNTYPE); error_def(ERR_SYSCALL); error_def(ERR_CIMAXPARAM); ext_table_file_name = GETENV(CALLIN_ENV_NAME); if (!ext_table_file_name) /* environment variable not set */ rts_error(VARLSTCNT(4) ERR_CITABENV, 2, LEN_AND_STR(CALLIN_ENV_NAME)); ext_table_file_handle = Fopen(ext_table_file_name, "r"); if (!ext_table_file_handle) /* call-in table not found */ rts_error(VARLSTCNT(11) ERR_CITABOPN, 2, LEN_AND_STR(ext_table_file_name), ERR_SYSCALL, 5, LEN_AND_LIT("fopen"), CALLFROM, errno); ext_source_line_num = 0; while (read_table(LIT_AND_LEN(str_buffer), ext_table_file_handle)) { if (!*(tbp = scan_space(str_buffer))) continue; if (!(end = scan_ident(tbp))) ext_stx_error(ERR_CIRCALLNAME, ext_table_file_name); callnam.addr = tbp; callnam.len = INTCAST(end - tbp); tbp = scan_space(end); if (':' != *tbp++) ext_stx_error(ERR_COLON, ext_table_file_name); ret_tok = scan_keyword(&tbp); /* return type */ switch (ret_tok) /* return type valid ? */ { case xc_void: case xc_char_star: case xc_int_star: case xc_uint_star: case xc_long_star: case xc_ulong_star: case xc_float_star: case xc_double_star: case xc_string_star: break; default: ext_stx_error(ERR_CIRTNTYP, ext_table_file_name); } labref.addr = tbp; if ((end = scan_labelref(tbp))) labref.len = INTCAST(end - tbp); else ext_stx_error(ERR_CIENTNAME, ext_table_file_name); tbp = scan_space(end); inp_mask = out_mask = 0; for (parameter_count = 0; (*tbp && ')' != *tbp); parameter_count++) { if (MAXIMUM_PARAMETERS <= parameter_count) ext_stx_error(ERR_CIMAXPARAM, ext_table_file_name); /* must have comma if this is not the first parameter, otherwise '(' */ if (((0 == parameter_count)?'(':',') != *tbp++) ext_stx_error(ERR_CIRPARMNAME, ext_table_file_name); tbp = scan_space(tbp); if ((0 == parameter_count) && (*tbp == ')')) /* special case () */ break; /* looking for an I, a O or an IO */ mask = (1 << parameter_count); inp_mask |= ('I' == *tbp) ? (tbp++, mask) : 0; out_mask |= ('O' == *tbp) ? (tbp++, mask) : 0; if ((!(inp_mask & mask) && !(out_mask & mask)) || (':' != *tbp++)) ext_stx_error(ERR_CIDIRECTIVE, ext_table_file_name); switch ((pr = scan_keyword(&tbp))) /* valid param type? */ { case xc_int: case xc_uint: case xc_long: case xc_ulong: case xc_float: case xc_double: if (out_mask & mask) ext_stx_error(ERR_CIPARTYPE, ext_table_file_name); /* fall-thru */ case xc_char_star: case xc_int_star: case xc_uint_star: case xc_long_star: case xc_ulong_star: case xc_float_star: case xc_double_star: case xc_string_star: break; default: ext_stx_error(ERR_CIUNTYPE, ext_table_file_name); } parameter_types[parameter_count] = pr; tbp = scan_space(tbp); } if (!*tbp) ext_stx_error(ERR_CIRPARMNAME, ext_table_file_name); entry_ptr = get_memory(sizeof(callin_entry_list)); entry_ptr->next_entry = save_entry_ptr; save_entry_ptr = entry_ptr; entry_ptr->return_type = ret_tok; entry_ptr->argcnt = parameter_count; entry_ptr->input_mask = inp_mask; entry_ptr->output_mask = out_mask; entry_ptr->parms = get_memory(parameter_count * sizeof(entry_ptr->parms[0])); for (i = 0 ; i < parameter_count ; i++) entry_ptr->parms[i] = parameter_types[i]; put_mstr(&labref, &entry_ptr->label_ref); put_mstr(&callnam, &entry_ptr->call_name); } FCLOSE(ext_table_file_handle, fclose_res); return entry_ptr; }
/* Note: need condition handler to clean-up allocated structures and close intput file in the event of an error */ struct extcall_package_list *exttab_parse(mval *package) { int parameter_alloc_values[MAXIMUM_PARAMETERS], parameter_count, ret_pre_alloc_val, i, fclose_res; boolean_t is_input[MAXIMUM_PARAMETERS], is_output[MAXIMUM_PARAMETERS], got_status; mstr callnam, rtnnam; void_ptr_t pakhandle; enum xc_types ret_tok, parameter_types[MAXIMUM_PARAMETERS], pr; char str_buffer[MAX_TABLINE_LEN], *tbp, *end; FILE *ext_table_file_handle; struct extcall_package_list *pak; struct extcall_entry_list *entry_ptr; error_def(ERR_ZCRTENOTF); error_def(ERR_ZCALLTABLE); error_def(ERR_ZCUSRRTN); error_def(ERR_ZCCTENV); error_def(ERR_ZCCTOPN); error_def(ERR_ZCCTNULLF); error_def(ERR_ZCUNAVAIL); error_def(ERR_ZCENTNAME); error_def(ERR_ZCCOLON); error_def(ERR_ZCRTNTYP); error_def(ERR_ZCRCALLNAME); error_def(ERR_ZCUNTYPE); error_def(ERR_ZCMLTSTATUS); error_def(ERR_ZCRPARMNAME); error_def(ERR_ZCPREALLVALPAR); error_def(ERR_ZCPREALLVALINV); /* First, construct package name environment variable */ memcpy(str_buffer, PACKAGE_ENV_PREFIX, sizeof(PACKAGE_ENV_PREFIX)); tbp = &str_buffer[sizeof(PACKAGE_ENV_PREFIX) - 1]; if (package->str.len) { /* guaranteed by compiler */ assert(package->str.len < MAX_NAME_LENGTH - sizeof(PACKAGE_ENV_PREFIX) - 1); *tbp++ = '_'; memcpy(tbp, package->str.addr, package->str.len); tbp += package->str.len; } *tbp = 0; /* Now we have the environment name, lookup file name */ ext_table_file_name = GETENV(str_buffer); if (NULL == ext_table_file_name) { /* Environment variable for the package not found */ rts_error(VARLSTCNT(4) ERR_ZCCTENV, 2, LEN_AND_STR(str_buffer)); } ext_table_file_handle = Fopen(ext_table_file_name, "r"); if (NULL == ext_table_file_handle) { /* Package's external call table could not be found */ rts_error(VARLSTCNT(4) ERR_ZCCTOPN, 2, LEN_AND_STR(ext_table_file_name)); } ext_source_line_num = 0; /* pick-up name of shareable library */ tbp = read_table(LIT_AND_LEN(str_buffer), ext_table_file_handle); if (NULL == tbp) { /* External call table is a null file */ rts_error(VARLSTCNT(4) ERR_ZCCTNULLF, 2, package->str.len, package->str.addr); } pakhandle = fgn_getpak(str_buffer, INFO); if (NULL == pakhandle) { /* Unable to obtain handle to the shared library */ rts_error(VARLSTCNT(4) ERR_ZCUNAVAIL, 2, package->str.len, package->str.addr); } pak = get_memory(sizeof(*pak)); pak->first_entry = 0; put_mstr(&package->str, &pak->package_name); pak->package_handle = pakhandle; /* At this point, we have a valid package, pointed to by pak */ #ifdef DEBUG_EXTCALL FPRINTF(stderr, "GT.M external call opened package name: %s\n", pak->package_name.addr); #endif for (;;) { star_found = FALSE; tbp = read_table(LIT_AND_LEN(str_buffer), ext_table_file_handle); if (NULL == tbp) break; tbp = scan_space(str_buffer); /* empty line? */ if (!*tbp) continue; /* No, must be entryref */ end = scan_ident(tbp); if (!end) ext_stx_error(ERR_ZCENTNAME, ext_table_file_name); if ('^' == *end) { end++; end = scan_ident(end); if (!end) ext_stx_error(ERR_ZCENTNAME, ext_table_file_name); } rtnnam.addr = tbp; rtnnam.len = INTCAST(end - tbp); tbp = scan_space(end); if (':' != *tbp++) ext_stx_error(ERR_ZCCOLON, ext_table_file_name); /* get return type */ ret_tok = scan_keyword(&tbp); /* check for legal return type */ switch (ret_tok) { case xc_status: case xc_void: case xc_int: case xc_uint: case xc_long: case xc_ulong: case xc_char_star: case xc_float_star: case xc_string_star: case xc_int_star: case xc_uint_star: case xc_long_star: case xc_ulong_star: case xc_double_star: case xc_char_starstar: case xc_pointertofunc: case xc_pointertofunc_star: break; default: ext_stx_error(ERR_ZCRTNTYP, ext_table_file_name); } got_status = (ret_tok == xc_status); /* get call name */ if ('[' == *tbp) { if (star_found) ret_pre_alloc_val = scan_array_bound(&tbp,ret_tok); else ext_stx_error(ERR_ZCPREALLVALPAR, ext_table_file_name); /* We should allow the pre-allocated value upto to the maximum string size (MAX_STRLEN) plus 1 for the * extra terminating NULL. Negative values would have been caught by scan_array_bound() above */ if (ret_pre_alloc_val > MAX_STRLEN + 1) ext_stx_error(ERR_ZCPREALLVALINV, ext_table_file_name); } else ret_pre_alloc_val = -1; end = scan_ident(tbp); if (!end) ext_stx_error(ERR_ZCRCALLNAME, ext_table_file_name); callnam.addr = tbp; callnam.len = INTCAST(end - tbp); tbp = scan_space(end); tbp = scan_space(tbp); for (parameter_count = 0;(MAXIMUM_PARAMETERS > parameter_count) && (')' != *tbp); parameter_count++) { star_found = FALSE; /* must have comma if this is not the first parameter, otherwise '(' */ if (((0 == parameter_count)?'(':',') != *tbp++) ext_stx_error(ERR_ZCRPARMNAME, ext_table_file_name); tbp = scan_space(tbp); /* special case: () is ok */ if ((0 == parameter_count) && (*tbp == ')')) break; /* looking for an I, an O or an IO */ is_input[parameter_count] = is_output[parameter_count] = FALSE; if ('I' == *tbp) { is_input[parameter_count] = TRUE; tbp++; } if ('O' == *tbp) { is_output[parameter_count] = TRUE; tbp++; } if (((FALSE == is_input[parameter_count]) && (FALSE == is_output[parameter_count])) ||(':' != *tbp++)) ext_stx_error(ERR_ZCRCALLNAME, ext_table_file_name); /* scanned colon--now get type */ pr = scan_keyword(&tbp); if (xc_notfound == pr) ext_stx_error(ERR_ZCUNTYPE, ext_table_file_name); if (xc_status == pr) { /* Only one type "status" allowed per call */ if (got_status) ext_stx_error(ERR_ZCMLTSTATUS, ext_table_file_name); else got_status = TRUE; } parameter_types[parameter_count] = pr; if ('[' == *tbp) { if (star_found && !is_input[parameter_count]) parameter_alloc_values[parameter_count] = scan_array_bound(&tbp, pr); else ext_stx_error(ERR_ZCPREALLVALPAR, ext_table_file_name); /* We should allow the pre-allocated value upto to the maximum string size (MAX_STRLEN) plus 1 for * the extra terminating NULL. Negative values would have been caught by scan_array_bound() above */ if (parameter_alloc_values[parameter_count] > MAX_STRLEN + 1) ext_stx_error(ERR_ZCPREALLVALINV, ext_table_file_name); } else parameter_alloc_values[parameter_count] = -1; tbp = scan_space(tbp); } entry_ptr = get_memory(sizeof(*entry_ptr)); entry_ptr->next_entry = pak->first_entry; pak->first_entry = entry_ptr; entry_ptr->return_type = ret_tok; entry_ptr->ret_pre_alloc_val = ret_pre_alloc_val; entry_ptr->argcnt = parameter_count; entry_ptr->input_mask = array_to_mask(is_input, parameter_count); entry_ptr->output_mask = array_to_mask(is_output, parameter_count); entry_ptr->parms = get_memory(parameter_count * sizeof(entry_ptr->parms[0])); entry_ptr->param_pre_alloc_size = get_memory(parameter_count * sizeof(intszofptr_t)); entry_ptr->parmblk_size = (SIZEOF(void *) * parameter_count) + SIZEOF(intszofptr_t); for (i = 0 ; i < parameter_count ; i++) { entry_ptr->parms[i] = parameter_types[i]; entry_ptr->parmblk_size += parm_space_needed[parameter_types[i]]; entry_ptr->param_pre_alloc_size[i] = parameter_alloc_values[i]; } put_mstr(&rtnnam, &entry_ptr->entry_name); put_mstr(&callnam, &entry_ptr->call_name); /* the reason for passing INFO severity is that PROFILE has several routines listed in * the external call table that are not in the shared library. PROFILE folks would * rather see info/warning messages for such routines at shared library open time, * than error out. These unimplemented routines, they say were not being called from * the application and wouldn't cause any application failures. If we fail to open * the shared libary, or we fail to locate a routine that is called from the * application, we issue rts_error message (in extab_parse.c) */ entry_ptr->fcn = fgn_getrtn(pak->package_handle, &entry_ptr->call_name, INFO); #ifdef DEBUG_EXTCALL FPRINTF(stderr, " package entry point: %s, address: %x\n", entry_ptr->entry_name.addr, entry_ptr->fcn); #endif } FCLOSE(ext_table_file_handle, fclose_res); return pak; }
static enum xc_types scan_keyword(char **c) { const static struct { char nam[MAX_NAM_LEN]; enum xc_types typ[MAXIMUM_STARS + 1]; /* one entry for each level of indirection eg [1] is type* */ } xctab[] = { /* typename type type * type ** */ {"void", xc_void, xc_notfound, xc_notfound }, {"gtm_int_t", xc_int, xc_int_star, xc_notfound }, {"xc_int_t", xc_int, xc_int_star, xc_notfound }, {"int", xc_int, xc_int_star, xc_notfound }, {"gtm_uint_t", xc_uint, xc_uint_star, xc_notfound }, {"xc_uint_t", xc_uint, xc_uint_star, xc_notfound }, {"uint", xc_uint, xc_uint_star, xc_notfound }, {"gtm_long_t", xc_long, xc_long_star, xc_notfound }, {"xc_long_t", xc_long, xc_long_star, xc_notfound }, {"long", xc_long, xc_long_star, xc_notfound }, {"gtm_ulong_t", xc_ulong, xc_ulong_star, xc_notfound }, {"xc_ulong_t", xc_ulong, xc_ulong_star, xc_notfound }, {"ulong", xc_ulong, xc_ulong_star, xc_notfound }, {"gtm_status_t", xc_status, xc_notfound, xc_notfound }, {"xc_status_t", xc_status, xc_notfound, xc_notfound }, {"gtm_char_t", xc_notfound, xc_char_star, xc_char_starstar }, {"xc_char_t", xc_notfound, xc_char_star, xc_char_starstar }, {"char", xc_notfound, xc_char_star, xc_char_starstar }, {"gtm_string_t", xc_notfound, xc_string_star, xc_notfound }, {"xc_string_t", xc_notfound, xc_string_star, xc_notfound }, {"string", xc_notfound, xc_string_star, xc_notfound }, {"gtm_float_t", xc_float, xc_float_star, xc_notfound }, {"xc_float_t", xc_float, xc_float_star, xc_notfound }, {"float", xc_float, xc_float_star, xc_notfound }, {"gtm_double_t", xc_double, xc_double_star, xc_notfound }, {"xc_double_t", xc_double, xc_double_star, xc_notfound }, {"double", xc_double, xc_double_star, xc_notfound }, {"gtm_pointertofunc_t", xc_pointertofunc, xc_pointertofunc_star, xc_notfound }, {"xc_pointertofunc_t", xc_pointertofunc, xc_pointertofunc_star, xc_notfound } }; char *b = *c; char *d; int len, i, star_count; b = scan_space(b); d = scan_ident(b); if (!d) return xc_notfound; len = (int)(d - b); for (i = 0 ; i < sizeof(xctab) / sizeof(xctab[0]) ; i++) { if ((0 == memcmp(xctab[i].nam, b, len)) && ('\0' == xctab[i].nam[len])) { /* got name */ /* scan stars */ for (star_count = 0;(MAXIMUM_STARS >= star_count);star_count++, d++) { d = scan_space(d); if ('*' != *d) break; star_found = TRUE; } assert(star_count <= MAXIMUM_STARS); *c = scan_space(d); return xctab[i].typ[star_count]; } } return xc_notfound; }
int JSON::parse_string(const char *begin, const char *end, std::string *out) { char const *ptr = begin; ptr += scan_space(ptr, end); if (*ptr == '\"') { ptr++; std::vector<char> vec; while (ptr < end) { if (*ptr == '\"') { *out = to_stdstr(vec); ptr++; return ptr - begin; } else if (*ptr == '\\') { ptr++; if (ptr < end) { auto push = [&](char c){ vec.push_back(c); ptr++; }; switch (*ptr) { case 'a': push('\a'); break; case 'b': push('\b'); break; case 'n': push('\n'); break; case 'r': push('\r'); break; case 'f': push('\f'); break; case 't': push('\t'); break; case 'v': push('\v'); break; case '\\': case '\'': case '\"': push(*ptr); break; case 'x': ptr++; if (ptr + 1 < end && isxdigit(ptr[0] & 0xff) && isxdigit(ptr[1] & 0xff)) { char tmp[3]; tmp[0] = ptr[0]; tmp[1] = ptr[1]; tmp[2] = 0; vec.push_back((char)strtol(tmp, 0, 16)); ptr += 2; } break; default: if (*ptr >= '0' && *ptr <= '7') { int i; int v = 0; for (i = 0; i < 3; i++) { if (ptr + i < end && ptr[i] >= '0' && ptr[i] <= '7') { v = v * 8 + (ptr[i] - '0'); } else { break; } } vec.push_back(v); ptr += i; } else { vec.push_back(*ptr); ptr++; } break; } } } else { vec.push_back(*ptr); ptr++; } } } return 0; }
void do_assignment (header *var) /***** do_assignment assign a value to a variable. *****/ { header *variable[8],*rightside[8],*rs,*v,*mark; int rscount,varcount,i,j; ULONG offset,oldoffset,dif; char *oldendlocal; scan_space(); if (*next=='=') { next++; nosubmref=1; rs=scan_value(); nosubmref=0; if (error) return; varcount=0; /* count the variables, that get assigned something */ while (var<rs) { if (var->type!=s_reference && var->type!=s_submatrix && var->type!=s_csubmatrix && var->type!=s_isubmatrix) { output("Cannot assign to value!\n"); error=210; } variable[varcount]=var; var=nextof(var); varcount++; if (varcount>=8) { output("To many commas!\n"); error=100; return; } } /* count and note the values, that are assigned to the variables */ rscount=0; while (rs<(header *)newram) { rightside[rscount]=rs; rs=nextof(rs); rscount++; if (rscount>=8) { output("To many commas!\n"); error=101; return; } } /* cannot assign 2 values to 3 variables , e.g. */ if (rscount>1 && rscount<varcount) { output("Illegal multiple assignment!\n"); error=102; return; } oldendlocal=endlocal; offset=0; /* do all the assignments */ if (varcount==1) var=assign(variable[0],rightside[0]); else for (i=0; i<varcount; i++) { oldoffset=offset; /* assign a variable */ var=assign(addsize(variable[i],offset), addsize(rightside[(rscount>1)?i:0],offset)); if (error) return; offset=endlocal-oldendlocal; if (oldoffset!=offset) /* size of var. changed */ { v=addsize(variable[i],offset); if (v->type==s_reference) mark=referenceof(v); else mark=submrefof(v); /* now shift all references of the var.s */ if (mark) /* not a new variable */ for (j=i+1; j<varcount; j++) { v=addsize(variable[j],offset); dif=offset-oldoffset; if (v->type==s_reference && referenceof(v)>mark) referenceof(v)=addsize(referenceof(v),dif); else if (submrefof(v)>mark) submrefof(v)=addsize(submrefof(v),dif); } } } } else /* just an expression which is a variable */ { var=getvalue(var); } if (error) return; if (*next!=';') give_out(var); if (*next==',' || *next==';') next++; }
void do_for (void) /***** do_for do a for command in a UDF. for i=value to value step value; .... ; end *****/ { int h,signum; char name[16],*jump; header *hd,*init,*end,*step; double vend,vstep; struct { header hd; double value; } rv; if (!udfon) { output("For only allowed in functions!\n"); error=57; return; } rv.hd.type=s_real; *rv.hd.name=0; rv.hd.size=sizeof(header)+sizeof(double); rv.value=0.0; scan_space(); scan_name(name); if (error) return; kill_local(name); newram=endlocal; hd=new_reference(&rv.hd,name); if (error) return; endlocal=newram=(char *)hd+hd->size; scan_space(); if (*next!='=') { output("Syntax error in for.\n"); error=71; goto end; } next++; init=scan(); if (error) goto end; init=getvalue(init); if (error) goto end; if (init->type!=s_real) { output("Startvalue must be real!\n"); error=72; goto end; } rv.value=*realof(init); scan_space(); if (strncmp(next,"to",2)) { output("Endvalue missing in for!\n"); error=73; goto end; } next+=2; end=scan(); if (error) goto end; end=getvalue(end); if (error) goto end; if (end->type!=s_real) { output("Endvalue must be real!\n"); error=73; goto end; } vend=*realof(end); scan_space(); if (!strncmp(next,"step",4)) { next+=4; step=scan(); if (error) goto end; step=getvalue(step); if (error) goto end; if (step->type!=s_real) { output("Stepvalue must be real!\n"); error=73; goto end; } vstep=*realof(step); } else vstep=1.0; signum=(vstep>=0)?1:-1; vend=vend+signum*epsilon; if (signum>0 && rv.value>vend) { scan_end(); goto end; } else if (signum<0 && rv.value<vend) { scan_end(); goto end; } newram=endlocal; scan_space(); if (*next==';' || *next==',') next++; jump=next; while (!error) { if (*next==1) { output("End missing!\n"); error=401; goto end; } h=command(); if (udfon!=1 || h==c_return) break; if (h==c_break) { scan_end(); break; } if (h==c_end) { rv.value+=vstep; if (signum>0 && rv.value>vend) break; else if (signum<0 && rv.value<vend) break; else next=jump; if (test_key()==escape) { output("User interrupted!\n"); error=1; break; } } } end : kill_local(name); }