Cell read_pair(FILE *in) {
int c;
Cell car_obj;
Cell cdr_obj;
skip_space(in);
c = getc(in);
if (c == ')') {
return null;
}
ungetc(c, in);
car_obj = read(in);
skip_space(in);
c = getc(in);
if (c == '.') {
c = peek(in);
if (!is_delimiter(c)) {
fprintf(stderr, "dot not followed by delimiter\n");
exit(1);
}
cdr_obj = read(in);
skip_space(in);
c = getc(in);
if (c != ')') {
fprintf(stderr, "missing right paren\n");
exit(1);
}
return cons(car_obj, cdr_obj);
}
else { /* read list */
ungetc(c, in);
cdr_obj = read_pair(in);
return cons(car_obj, cdr_obj);
}
}
atom* amaguq::read_pair(const std::string& s, unsigned& idx)
{
list* l;
atom* car;
atom* cdr;
if (s[idx] == ')') {
++idx;
return hp.h[2]; // empty list
}
car = reads(s, idx);
gobble_whitespace(s, idx);
if (s[idx] == '.') {
++idx;
cdr = reads(s, idx);
gobble_whitespace(s, idx);
if (s[idx] != ')') {
// expect ')' else throw excptn TODO
}
++idx;
} else {
cdr = read_pair(s, idx);
}
l = new list(car, cdr);
hp.alloc(l);
return l;
}
/* this is a horrifying hack */
object *string_to_list_proc(object *arguments) {
FILE *temp = fopen("temp", "w");
char *str = car(arguments)->data.string.value;
char exp[BUFFER_MAX];
int len = strlen(str);
int i = 0;
int j = 0;
object *pair;
while (i < len) {
exp[j++] = '#';
exp[j++] = '\\';
exp[j++] = str[i];
exp[j++] = ' ';
i++;
}
exp[j++] = ')';
exp[j] = '\0';
fputs(exp, temp);
fflush(temp);
fclose(temp);
temp = fopen("temp", "r+");
pair = read_pair(temp);
fclose(temp);
remove("temp");
return pair;
}
static void read_dialog_profiles(char *b, int l, struct dlg_cell *dlg,int double_check)
{
struct dlg_profile_table *profile;
struct dlg_profile_link *it;
str name, val;
char *end;
char *p;
char bk;
end = b + l;
p = b;
current_dlg_pointer = dlg;
do {
/* read a new pair from input string */
p = read_pair( p, end, &name, &val);
if (p==NULL) break;
LM_DBG("new profile found <%.*s>=<%.*s>\n",name.len,name.s,val.len,val.s);
if (double_check) {
for (it=dlg->profile_links;it;it=it->next) {
if (it->profile->name.len == name.len &&
memcmp(it->profile->name.s,name.s,name.len) == 0) {
LM_DBG("Profile is already linked into the dlg\n");
goto next;
}
}
}
/* add to the profile */
profile = search_dlg_profile( &name );
if (profile==NULL) {
LM_DBG("profile <%.*s> does not exist now, creating it\n",name.len,name.s);
/* create a new one */
bk = name.s[name.len];
name.s[name.len] = 0;
if (add_profile_definitions(name.s, (val.len && val.s)?1:0 ) != 0) {
LM_ERR("failed to add dialog profile <%.*s>\n", name.len, name.s);
name.s[name.len] = bk;
continue;
}
name.s[name.len] = bk;
/* double check the created profile */
profile = search_dlg_profile(&name);
if (profile == NULL) {
LM_CRIT("BUG - cannot find just added dialog profile <%.*s>\n", name.len, name.s);
continue;
}
}
if (set_dlg_profile( NULL, profile->has_value?&val:NULL, profile) < 0 )
LM_ERR("failed to add to profile, skipping....\n");
next:
;
} while(p!=end);
current_dlg_pointer = NULL;
}
static scheme_object* read_pair(vm* context, FILE* in)
{
int c;
scheme_object* car = NULL;
scheme_object* cdr = NULL;
eat_whitespace(in);
c = getc(in);
if(c ==')')
{
return the_empty_list;
}
gc_push_root((void**) &car);
gc_push_root((void**) &cdr);
ungetc(c, in);
car = read(context, in);
eat_whitespace(in);
c = getc(in);
if(c == '.')
{
if(!is_delimiter(peek(in)))
{
fprintf(stderr, "Expected a delimiter after '.'...\n");
exit(1);
}
cdr = read(context, in);
eat_whitespace(in);
c = getc(in);
if(c != ')')
{
fprintf(stderr, "Expected a ')'\n");
exit(1);
}
}
else
{
ungetc(c, in);
cdr = read_pair(context, in);
}
gc_pop_root();
gc_pop_root();
return cons(context, car, cdr);
}
static pSlipObject read_pair(pSlip gd)
{
pToken tok;
pSlipObject car_obj;
pSlipObject cdr_obj;
if (gd->running != SLIP_RUNNING)
return NULL;
tok = peek_input(gd);
if (tok->id == kCPAREN)
{
tok = read_input(gd);
return gd->singleton_EmptyList;
}
car_obj = slip_read(gd);
tok = peek_input(gd);
if (tok == NULL)
{
throw_error(gd, "Unclosed list\n");
return cons(gd, car_obj, gd->singleton_EmptyList);
}
else if (tok->id == kDOT)
{
tok = read_input(gd); // skip over dot
cdr_obj = slip_read(gd);
tok = read_input(gd);
if (tok->id != kCPAREN)
{
throw_error(gd, "where was the trailing right paren?\n");
return NULL;
}
return cons(gd, car_obj, cdr_obj);
}
else
{
cdr_obj = read_pair(gd);
return cons(gd, car_obj, cdr_obj);
}
}
object read_pair(FILE *in)
{
object the_car, the_cdr;
int c;
skip_atmospheric(in);
/* the empty list */
c = fgetc(in);
if (c == ')')
return nil;
ungetc(c, in);
the_car = lisp_read(in);
skip_atmospheric(in);
c = fgetc(in);
/* improper list ? */
if (c == '.') {
/* ... */
if (peek_char(in) == '.')
goto proper_pair;
c = fgetc(in);
if (!isspace(c))
error("Missing delimiter in improper list -- read", nil);
the_cdr = lisp_read(in);
skip_atmospheric(in);
c = fgetc(in);
if (c == ')')
return cons(the_car, the_cdr);
error("Missing parenthesis -- read", nil);
}
proper_pair:
ungetc(c, in);
the_cdr = read_pair(in);
return cons(the_car, the_cdr);
}
Cell read(FILE *in) {
int c;
int i;
Cell a;
skip_space(in);
c = getc(in);
if (c == '(') {
return read_pair(in);
} else if (c == '\'') {
return cons(atom("quote"), cons(read(in), null));
} else if (c == EOF) {
return atom("#<void>");
} else if (c == '"') {
c = getc(in);
a = atom("");
i = 0;
while (c != '"') {
if (c == '\\') {
c = getc(in);
c = c == 'n' ? '\n' : c;
}
if (i < 15) {
a->atom[i++] = c;
}
c = getc(in);
}
a->atom[i] = '\0';
return cons(atom("quote"), cons(a, null));
} else {
a = atom("");
i = 0;
while (!is_delimiter(c)) {
if (i < 15) {
a->atom[i++] = c;
}
c = getc(in);
}
a->atom[i] = '\0';
ungetc(c, in);
return a;
}
}
int cli_cd(char *arg)
{
char line[MAXPATHLEN];
char key[MAXPATHLEN];
char value[MAXPATHLEN];
if (strlen(arg) == 0)
{
get_home(line);
read_pair(line, key, value);
chdir(value);
cli_pwd();
return 0;
}
if (chdir(arg) == -1)
{
debugNetPrintf(ERROR,"%s %s\n",strerror(errno));
return 1;
}
cli_pwd();
return (0);
}
atom* amaguq::reads(const std::string& s, unsigned& idx)
{
atom *a = nullptr;
gobble_whitespace(s, idx);
if ('#' == s[idx]) {
if ('t' == s[idx + 1]) {
idx += 2;
a = hp.h[0];
} else if ('f' == s[idx + 1]) {
idx += 2;
a = hp.h[1];
} else if ('\\' == s[idx + 1]) {
a = char_helper(s, idx);
hp.alloc(a);
}
} else if ('"' == s[idx]) {
a = str_helper(s, idx);
hp.alloc(a);
} else if ('(' == s[idx]) {
a = read_pair(s, ++idx);
} else if ((s[idx] >= 'a' && s[idx] <= 'z')
|| (s[idx] >= 'A' && s[idx] <= 'Z')) {
a = symbol_helper(s, idx);
hp.alloc(a);
} else if (('\'' == s[idx])) {
a = reads(s, ++idx);
// TODO should the intermediate stuff be added to the heap?
// TODO this adds another cons cell allocation around the quoted
// symbol. Causing ('if ...) to not work. Should it?
a = new quote(a);
hp.alloc(a);
} else {
a = fixnum_helper(s, idx);
hp.alloc(a);
}
return a;
}
static void read_dialog_vars(char *b, int l, struct dlg_cell *dlg)
{
str name, val;
char *end;
char *p;
end = b + l;
p = b;
do {
/* read a new pair from input string */
p = read_pair( p, end, &name, &val);
if (p==NULL) break;
if (val.len==0) continue;
LM_DBG("new var found <%.*s>=<%.*s>\n",name.len,name.s,val.len,val.s);
/* add the variable */
if (store_dlg_value( dlg, &name, &val)!=0)
LM_ERR("failed to add val, skipping...\n");
} while(p!=end);
}
scheme_object* read(vm* context, FILE* in)
{
int c;
eat_whitespace(in);
c = getc(in);
if(isdigit(c) || (c == '-' && (isdigit(peek(in)))))
{
short sign = 1;//positive
long num = 0;
//read a number
if(c == '-')
{
sign = -1;
}
else
{
ungetc(c, in);
}
while(isdigit(c = getc(in)))
{
num = num *10 + (c -'0');
}
num *= sign;
if(is_delimiter(c))
{
ungetc(c, in);
return make_number(context, num);
}
//its not followed by a delimiter
fprintf(stderr, "Number not followed by a delimiter!\n");
exit(1);
}
else if(c == '#')
{//character or boolean
c = getc(in);
switch(c)
{
case 't':
return (scheme_object*) true;
case 'f':
return (scheme_object*) false;
case '\\':
return read_character(context, in);
default:
fprintf(stderr, "unknown boolean or character literal\n");
exit(1);
}
}
else if(c =='"')
{
return read_string(context, in);
}
else if(c == '(')
{
return read_pair(context, in);
}
else if(is_initial(c) || ((c == '+' || c == '-') && is_delimiter(peek(in))))
{
ungetc(c, in);
return read_symbol(context, in);
}
else if(c == '\'')
{
return cons(context, (scheme_object*) quote_symbol, cons(context, read(context, in), the_empty_list));
}
else if(c == EOF)
{
return NULL;
}
else
{
fprintf(stderr, "Unexpected input: '%c'\n", c);
exit(1);
}
fprintf(stderr, "read: illegal state\n");
exit(1);
}
pSlipObject slip_read(pSlip gd)
{
pToken tok;
pSlipObject obj;
int buff_idx;
uint8_t *buff;
if (gd->running != SLIP_RUNNING)
return NULL;
while ((tok = read_input(gd)) != NULL && gd->running == SLIP_RUNNING)
{
switch (tok->id)
{
case kCHAR:
{
expect_delimiter(gd);
return s_NewCharacter(gd, tok->z[2]);
}
break;
case kTRUE:
return gd->singleton_True;
break;
case kFALSE:
return gd->singleton_False;
break;
case kCHAR_NEWLINE:
return s_NewCharacter(gd, '\n');
break;
case kCHAR_TAB:
return s_NewCharacter(gd, '\t');
case kCHAR_SPACE:
return s_NewCharacter(gd, ' ');
break;
case kINT_NUMBER:
return s_NewInteger(gd, strtoll(tok->z, NULL, 10));
break;
case kOCT_NUMBER:
return s_NewInteger(gd, strtoll(tok->z, NULL, 8));
break;
case kHEX_NUMBER:
return s_NewInteger(gd, strtoll(tok->z, NULL, 16));
break;
case kID:
if (strcmp(tok->z, "quit") == 0)
gd->running = SLIP_SHUTDOWN;
return s_NewSymbol(gd, tok->z);
break;
case kSTRING:
{
buff_idx = 0;
buff = malloc(strlen(tok->z) + 1);
buff[0] = 0;
char *p;
p = tok->z;
p++;
while (*p != 0)
{
if (*p == '\\')
{
p++;
switch (*p)
{
case 'n':
buff[buff_idx++] = '\n';
p++;
break;
case 'r':
buff[buff_idx++] = '\r';
p++;
break;
case 't':
buff[buff_idx++] = '\t';
p++;
break;
default:
buff[buff_idx++] = *p++;
break;
}
}
else
{
buff[buff_idx++] = *p++;
}
buff[buff_idx] = 0;
}
buff[buff_idx-1] = 0;
obj = s_NewString(gd, buff, buff_idx);
free(buff);
return obj;
}
break;
case kOPAREN:
return read_pair(gd);
break;
case kQUOTE:
return cons(gd, gd->singleton_QuoteSymbol, cons(gd, slip_read(gd), gd->singleton_EmptyList));
break;
default:
throw_error(gd, "bad input. Unexpected \"%s\"\n", tok->z);
return NULL;
}
}
//throw_error(gd, "read illegal state\n");
gd->running = SLIP_SHUTDOWN;
return gd->singleton_OKSymbol;
}
void read_config(void)
{
static char key[MAXPATHLEN];
static char value[MAXPATHLEN];
static char line[MAXPATHLEN];
char *ptr = value;
FILE *fd;
if(get_home(line))
{
read_pair(line, key, value);
}
else
{
strcpy(value, "./");
}
strcat(value, "/.ps4shrc");
if ( (fd = fopen(value, "rb")) == NULL )
{
perror(value);
return;
}
while((read_line(fd, line)) != -1)
{
if (line[0] == '#')
{
continue;
}
read_pair(line, key, value);
trim(key);
ptr = stripwhite(value);
if (strcmp(key, "ip") == 0)
{
strcpy(dst_ip, ptr);
}
else if (strcmp(key, "log") == 0)
{
if (strcmp(ptr, "") == 0)
{
cli_log(stdout);
}
else {
cli_log(ptr);
}
}
/* else if (strcmp(key, "exception") == 0)
{
if (strcmp(ptr, "screen") == 0)
{
DUMPSCREEN = 1;
}
else
{
DUMPSCREEN = 0;
}
} */
else if (strcmp(key, "verbose") == 0)
{
if (strcmp(ptr, "yes") == 0)
{
printf(" Verbose mode on\n");
VERBOSE = 1;
}
}
else if (strcmp(key, "debug") == 0)
{
if (strcmp(ptr, "yes") == 0)
{
ps4link_set_debug(1);
}
}
else if (strcmp(key, "histfile") == 0)
{
if (strcmp(ptr, "") != 0)
{
strcpy(ps4sh_history, ptr);
}
}
else if (strcmp(key, "bind") == 0)
{
if (strcmp(ptr, "") != 0)
{
strcpy(src_ip, ptr);
}
}
else if (strcmp(key, "path") == 0)
{
if (strcmp(ptr, "") != 0)
{
ps4link_set_path(path_split(ptr));
}
}
else if (strcmp(key, "suffix") == 0)
{
if (strcmp(ptr, "") != 0)
{
common_set_suffix(path_split(ptr));
}
}
else if (strcmp(key, "setroot") == 0)
{
if (strcmp(ptr, "") != 0)
{
ps4link_set_root(ptr);
}
}
else if (strcmp(key, "logprompt") == 0)
{
if (strcmp(ptr, "") != 0)
{
/* pko_set_root(ptr); */
}
}
else if (strcmp(key, "home") == 0)
{
if (strcmp(ptr, "") != 0)
{
if (chdir(ptr) == -1)
{
perror(ptr);
}
}
}
}
return;
}
object lisp_read(FILE *in)
{
int c;
while ((c = fgetc(in)) != EOF) {
/* atmosphere */
if (isspace(c)) {
continue;
}
else if (c == ';') {
while (c != EOF && c != '\n')
c = fgetc(in);
continue;
}
/* characters, booleans or numbers with radix */
else if (c == '#') {
c = fgetc(in);
switch (c) {
/* number prefixes */
case 'b':
case 'B':
case 'o':
case 'O':
case 'x':
case 'X':
case 'd':
case 'D':
case 'e':
case 'i':
ungetc(c, in);
return read_number(in);
/* booleans */
case 't':
case 'T':
return the_truth;
case 'f':
case 'F':
return the_falsity;
/* characters */
case '\\':
return read_character(in);
/* vectors */
case '(':
ungetc(c, in);
return read_vector(in);
/* commented form, read and discard */
case ';':
lisp_read(in);
continue;
case '<':
error("Object cannot be read back -- read", nil);
default:
error("Unexpected character -- read", nil);
}
}
/* number */
else if (isdigit(c) ||
((c == '-') && isdigit(peek_char(in))) ||
((c == '+') && isdigit(peek_char(in)))) {
ungetc(c, in);
return read_number(in);
}
/* string */
else if (c == '"') {
return read_string(in);
}
/* symbol */
else if (is_initial(c)) {
ungetc(c, in);
return read_identifier(in);
}
/* peculiar identifiers */
else if (((c == '+') || c == '-') && is_delimiter(peek_char(in))) {
return make_symbol_c((c == '+' ? "+" : "-"));
}
/* stuff starting with dot, FIXME for floats */
else if (c == '.') {
if (is_delimiter(peek_char(in)))
error("Illegal use of . -- read", nil);
c = fgetc(in);
if (c != '.' || peek_char(in) != '.')
error("Symbol has bad name -- read", nil);
c = fgetc(in);
if (!is_delimiter(peek_char(in)))
error("Symbol has bad name -- read", nil);
return _ellipsis;
}
/* pair */
else if (c == '(') {
return read_pair(in);
}
/* quote */
else if (c == '\'') {
return cons(_quote, cons(lisp_read(in), nil));
}
/* quasiquote */
else if (c == '`') {
return cons(_quasiquote, cons(lisp_read(in), nil));
}
/* unquote & unquote-splicing */
else if (c == ',') {
if (peek_char(in) == '@') {
c = fgetc(in);
return cons(_unquote_splicing, cons(lisp_read(in), nil));
} else
return cons(_unquote, cons(lisp_read(in), nil));
}
else
error("Unexpected character -- read", nil);
}
return end_of_file;
}
