double parse_factors(char *& expression)
{
FAIL_CHECK;
double num1 = parse_atom(expression);
FAIL_CHECK;
for (;;)
{
skip_spaces(expression);
char op = *expression;
char *position = expression;
if (op != '/' && op != '*')
{
// nothing for us, pass it back
return num1;
}
expression++;
double num2 = parse_atom(expression);
FAIL_CHECK;
if (op == '/')
{
if (num2 == 0)
{
RETURN_FAILURE(DIV_ZERO, expression);
}
num1 /= num2;
}
else
{
num1 *= num2;
}
}
}
static expression_t*
parse_expression (scanner_t *scanner)
{
expression_t *exp = parse_atom (scanner);
while (LA_ID ("-") || LA_ID ("+")) {
char *text;
CONSUME_IDENTIFIER (text);
expression_t *left = exp;
exp = g_new0 (expression_t, 1);
exp->type = !strcmp ("+", text) ? EXPRESSION_ADD: EXPRESSION_SUB;
exp->data.bin.left = left;
exp->data.bin.right = parse_atom (scanner);
}
return exp;
}
/* The `input' will be free. Don't assign it directly. */
LispObject parse_sexp(char *input, int *offset)
{
if ('\0' == *input)
return NULL;
while ('\0' != *input && isblank(*input))
input++;
if ('\'' == *input) {
LispObject obj;
/* Symbol quote; */
/* quote = S("QUOTE"); */
obj = parse_input(input + 1);
/* return make_cons(S("QUOTE"), make_cons(obj, lt_nil)); */
return make_list(S("QUOTE"), obj);
}
if ('(' == input[0]) {
Cons cons;
cons = parse_cons(input + 1, offset);
(*offset)++;
return cons;
} else
return parse_atom(input, offset);
}
static int
delete_prop_xi1(Display *dpy, int argc, char** argv, char* n, char *desc)
{
XDevice *dev;
XDeviceInfo *info;
char *name;
Atom prop;
info = find_device_info(dpy, argv[0], False);
if (!info)
{
fprintf(stderr, "unable to find device %s\n", argv[0]);
return EXIT_FAILURE;
}
dev = XOpenDevice(dpy, info->id);
if (!dev)
{
fprintf(stderr, "unable to open device '%s'\n", info->name);
return EXIT_FAILURE;
}
name = argv[1];
prop = parse_atom(dpy, name);
XDeleteDeviceProperty(dpy, dev, prop);
XCloseDevice(dpy, dev);
return EXIT_SUCCESS;
}
/**
* Reads externalizable Lisp datum.
*
* For successful reads, a Lisp object is returned and `report` is not called.
*
* In case of syntax error, `report` is called at least once, and the return
* value must not be used.
*
* If the return value is `unspecific`, but `report` is not called, that means
* that no tokens left in the data source. @todo
*
* @param lexer
* Lexer state used to retrieve tokens.
* @param rep
* Reference to error-reporter object.
* @param arg
* Additional data which will be passed to `report` in case of a call.
* @return Lisp object, or `unspecific`. @todo
*/
obj_t read_datum(struct Lexer *lexer, Reporter rep)
{
struct Parser state;
state.lexer = lexer;
state.rep = rep;
state.ready = 0;
register_quotation_symbols();
return parse_atom(&state);
}
static obj_t parse_quotation(string sym, struct Parser *st)
{
struct token *t = peek(st);
switch (t->type) {
case END:
case DOT:
case CPAREN:
reportlocf(st->rep, t->loc, "missing datum after quotation");
return unspecific;
default:
return cons(make_symbol(sym), cons(parse_atom(st), null_obj));
}
}
/*
* Make sure the format string is well formed, and parse out
* the used atoms.
*/
static int verify_format(const char *format)
{
const char *cp, *sp;
for (cp = format; *cp && (sp = find_next(cp)); ) {
const char *ep = strchr(sp, ')');
if (!ep)
return error("malformed format string %s", sp);
/* sp points at "%(" and ep points at the closing ")" */
parse_atom(sp + 2, ep);
cp = ep + 1;
}
return 0;
}
int parse_atomlist(NLEnergy *p, Tcl_Interp *interp,
Tcl_Obj *const obj, boolean invert, int mark) {
char *atomsel = Array_data(&(p->atomsel));
char *nonbsel = Array_data(&(p->nonbsel));
char *asel = (mark > 0 ? nonbsel : atomsel);
char *invsel = Array_data(&(p->invsel));
char *sel = (invert ? invsel : asel);
const int32 natoms = Topology_atom_array_length(&(p->topo));
int32 id;
Tcl_Obj **objv;
int objc, n;
int m = (mark > 0 ? mark : -mark);
if (invert) {
memset(invsel, 0, natoms);
}
if ((id=parse_atom(p,interp,obj)) >= 0) { /* could be a singleton */
sel[id] |= (char)m;
}
else { /* its a list of atoms */
if (TCL_ERROR==Tcl_ListObjGetElements(interp, obj, &objc, &objv)) {
return FAIL;
}
for (n = 0; n < objc; n++) {
if ((id=parse_atom(p,interp,objv[n])) < 0) {
return FAIL;
}
sel[id] |= (char)m;
}
}
if (invert) {
for (id = 0; id < natoms; id++) {
if (FALSE==invsel[id]) asel[id] |= (char)m;
}
}
return OK;
}
LispVal* lisp_read(FILE* f)
{
eat_space(f);
char c = peek(f);
if (isdigit(c))
return parse_number(f);
else if (isalpha(c))
return parse_atom(f);
else if (c == '"')
return parse_string(f);
else if (c == '(')
return parse_list(f);
else
return NULL;
}
bool parser::parse_expr(utf8str::iterator& it, utf8str::iterator& it_end, shared_ptr<expr>& result)
{
if (it != it_end)
{
skip_whitespaces(it, it_end);
if (parse_list(it, it_end, result))
{
return true;
}
if (parse_atom(it, it_end, result))
{
return true;
}
}
return false;
}
static void
do_service_request(struct packet_handler *c,
struct ssh_connection *connection,
struct lsh_string *packet)
{
CAST(service_handler, closure, c);
struct simple_buffer buffer;
unsigned msg_number;
int name;
simple_buffer_init(&buffer, packet->length, packet->data);
if (parse_uint8(&buffer, &msg_number)
&& (msg_number == SSH_MSG_SERVICE_REQUEST)
&& parse_atom(&buffer, &name)
&& parse_eod(&buffer))
{
if (name)
{
CAST_SUBTYPE(command, service, ALIST_GET(closure->services, name));
if (service)
{
/* Don't accept any further service requests */
connection->dispatch[SSH_MSG_SERVICE_REQUEST]
= &connection_fail_handler;
/* Start service */
#if DATAFELLOWS_WORKAROUNDS
if (connection->peer_flags & PEER_SERVICE_ACCEPT_KLUDGE)
C_WRITE(connection, format_service_accept_kludge());
else
#endif /* DATAFELLOWS_WORKAROUNDS */
C_WRITE(connection, format_service_accept(name));
COMMAND_CALL(service, connection,
closure->c, closure->e);
return;
}
}
EXCEPTION_RAISE(connection->e,
make_protocol_exception(SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, NULL));
}
else
PROTOCOL_ERROR(connection->e, "Invalid SERVICE_REQUEST message");
}
Cons parse_cons(char *string, int *offset)
{
Cons cur, head, pre;
int step;
pre = head = make_cons(lt_nil, lt_nil);
for (int i = 0; string[i] != '\0'; i += step) {
switch (string[i]) {
case '(':
cur = make_cons(parse_cons(string + i + 1, &step), lt_nil);
break;
case ' ':
case '\n':
step = 1;
continue;
case ')':
*offset = i + 2;
pre = CDR(head);
free_cons(head);
return pre;
case '\'': {
/* Symbol quote; */
LispObject obj;
/* quote = S("QUOTE"); */
obj = parse_sexp(string + i + 1, &step);
/* cur = make_cons(make_cons(S("QUOTE"), make_cons(obj, lt_nil)), lt_nil); */
cur = make_cons(make_list(S("QUOTE"), obj), lt_nil);
step++;
break;
}
default :
cur = make_cons(parse_atom(string + i, &step), lt_nil);
}
set_cdr(pre, cur);
pre = cur;
}
pre = CDR(head);
free_cons(head);
return pre;
}
/*
* Make sure the format string is well formed, and parse out
* the used atoms.
*/
static int verify_format(const char *format)
{
const char *cp, *sp;
static const char color_reset[] = "color:reset";
need_color_reset_at_eol = 0;
for (cp = format; *cp && (sp = find_next(cp)); ) {
const char *ep = strchr(sp, ')');
int at;
if (!ep)
return error("malformed format string %s", sp);
/* sp points at "%(" and ep points at the closing ")" */
at = parse_atom(sp + 2, ep);
cp = ep + 1;
if (starts_with(used_atom[at], "color:"))
need_color_reset_at_eol = !!strcmp(used_atom[at], color_reset);
}
return 0;
}
static int
delete_prop_xi2(Display *dpy, int argc, char** argv, char* n, char *desc)
{
XIDeviceInfo *info;
char *name;
Atom prop;
info = xi2_find_device_info(dpy, argv[0]);
if (!info)
{
fprintf(stderr, "unable to find device %s\n", argv[0]);
return EXIT_FAILURE;
}
name = argv[1];
prop = parse_atom(dpy, name);
XIDeleteProperty(dpy, info->deviceid, prop);
return EXIT_SUCCESS;
}
static int
do_rsa_verify(struct verifier *v,
int algorithm,
UINT32 length,
const UINT8 *msg,
UINT32 signature_length,
const UINT8 *signature_data)
{
CAST(rsa_verifier, self, v);
mpz_t s;
int res = 0;
trace("do_rsa_verify: Verifying %a signature\n", algorithm);
mpz_init(s);
switch(algorithm)
{
#if 0
case ATOM_RSA_PKCS1_SHA1:
case ATOM_RSA_PKCS1_SHA1_LOCAL:
if (signature_length > self->size)
goto fail;
bignum_parse_u(s, signature_length, signature_data);
break;
case ATOM_SPKI:
#endif
case ATOM_SSH_RSA:
{
struct simple_buffer buffer;
UINT32 length;
const UINT8 *digits;
int atom;
simple_buffer_init(&buffer, signature_length, signature_data);
if (!(parse_atom(&buffer, &atom)
&& (atom == ATOM_SSH_RSA)
&& parse_string(&buffer, &length, &digits)
&& (length <= self->size)
&& parse_eod(&buffer) ))
goto fail;
bignum_parse_u(s, length, digits);
break;
}
/* It doesn't matter here which flavour of SPKI is used. */
case ATOM_SPKI_SIGN_RSA:
case ATOM_SPKI_SIGN_DSS:
{
struct simple_buffer buffer;
struct sexp *e;
simple_buffer_init(&buffer, signature_length, signature_data);
if (! ( (e = sexp_parse_canonical(&buffer))
&& parse_eod(&buffer)
&& decode_rsa_sig_val(e, s, self->size)) )
goto fail;
break;
}
default:
fatal("do_rsa_verify: Internal error!\n");
}
res = rsa_pkcs1_verify(self, length, msg, s);
fail:
mpz_clear(s);
return res;
}
static struct lsh_string *
lsh_decode_key(struct lsh_string *contents)
{
struct simple_buffer buffer;
enum lsh_atom type;
struct verifier *v;
simple_buffer_init(&buffer, STRING_LD(contents));
if (!parse_atom(&buffer, &type))
{
werror("Invalid (binary) input data.\n");
return NULL;
}
switch (type)
{
case ATOM_SSH_DSS:
{
werror("Reading key of type ssh-dss...\n");
v = parse_ssh_dss_public(&buffer);
if (!v)
{
werror("Invalid dsa key.\n");
return NULL;
}
break;
}
case ATOM_SSH_DSA_SHA256_LOCAL:
{
werror("Reading key of type ssh-dsa-sha256...\n");
v = parse_ssh_dsa_sha256_public(&buffer);
if (!v)
{
werror("Invalid dsa-sha256 key.\n");
return NULL;
}
break;
}
case ATOM_SSH_RSA:
{
werror("Reading key of type ssh-rsa...\n");
v = parse_ssh_rsa_public(&buffer);
if (!v)
{
werror("Invalid rsa key.\n");
return NULL;
}
break;
}
default:
werror("Unknown key type.");
return NULL;
}
return PUBLIC_SPKI_KEY(v, 1);
}
static
parse_err_t parse_sexpr(parse_state_t *state, node_t **result)
{
node_t *ret = NULL;
parse_err_t status = PARSE_OK;
switch(token_type(state->ts)) {
case TOK_END:
return PARSE_END;
case TOK_SYM:
case TOK_LIT:
status = parse_atom(state, &ret);
break;
case TOK_LPAREN:
/* ( ... */
token_chomp(state->ts);
switch(token_type(state->ts)) {
case TOK_END:
status = PARSE_TOKEN_UNDERFLOW;
goto error;
case TOK_RPAREN:
/* ( ) */
/* consume closing rparen */
token_chomp(state->ts);
*result = NULL;
goto tok_lparen_finish;
case TOK_DOT:
/* ( . */
status = PARSE_UNEXPECTED_DOT;
goto error;
default:
break;
}
/* ( ... */
status = parse_list(state, &ret);
/* ... ) */
switch(token_type(state->ts)) {
case TOK_END:
status = PARSE_TOKEN_UNDERFLOW;
goto error;
case TOK_RPAREN:
/* consume closing rparen */
token_chomp(state->ts);
break;
default:
status = PARSE_EXPECTED_RPAREN;
goto error;
}
tok_lparen_finish:
break;
default:
status = PARSE_EXPECTED_LPAREN_ATOM;
goto error;
}
*result = ret;
return status;
error:
node_droproot(ret);
return status;
}
static int
do_set_prop_xi2(Display *dpy, Atom type, int format, int argc, char **argv, char *n, char *desc)
{
XIDeviceInfo *info;
Atom prop;
Atom old_type;
char *name;
int i;
Atom float_atom;
int old_format, nelements = 0;
unsigned long act_nitems, bytes_after;
char *endptr;
union {
unsigned char *c;
int16_t *s;
int32_t *l;
} data;
if (argc < 3)
{
fprintf(stderr, "Usage: xinput %s %s\n", n, desc);
return EXIT_FAILURE;
}
info = xi2_find_device_info(dpy, argv[0]);
if (!info)
{
fprintf(stderr, "unable to find device %s\n", argv[0]);
return EXIT_FAILURE;
}
name = argv[1];
prop = parse_atom(dpy, name);
if (prop == None) {
fprintf(stderr, "invalid property %s\n", name);
return EXIT_FAILURE;
}
float_atom = XInternAtom(dpy, "FLOAT", False);
nelements = argc - 2;
if (type == None || format == 0) {
if (XIGetProperty(dpy, info->deviceid, prop, 0, 0, False,
AnyPropertyType, &old_type, &old_format, &act_nitems,
&bytes_after, &data.c) != Success) {
fprintf(stderr, "failed to get property type and format for %s\n",
name);
return EXIT_FAILURE;
} else {
if (type == None)
type = old_type;
if (format == 0)
format = old_format;
}
XFree(data.c);
}
if (type == None) {
fprintf(stderr, "property %s doesn't exist, you need to specify "
"its type and format\n", name);
return EXIT_FAILURE;
}
data.c = calloc(nelements, sizeof(int32_t));
for (i = 0; i < nelements; i++)
{
if (type == XA_INTEGER) {
switch (format)
{
case 8:
data.c[i] = atoi(argv[2 + i]);
break;
case 16:
data.s[i] = atoi(argv[2 + i]);
break;
case 32:
data.l[i] = atoi(argv[2 + i]);
break;
default:
fprintf(stderr, "unexpected size for property %s", name);
return EXIT_FAILURE;
}
} else if (type == float_atom) {
if (format != 32) {
fprintf(stderr, "unexpected format %d for property %s\n",
format, name);
return EXIT_FAILURE;
}
*(float *)(data.l + i) = strtod(argv[2 + i], &endptr);
if (endptr == argv[2 + i]) {
fprintf(stderr, "argument %s could not be parsed\n", argv[2 + i]);
return EXIT_FAILURE;
}
} else if (type == XA_ATOM) {
if (format != 32) {
fprintf(stderr, "unexpected format %d for property %s\n",
format, name);
return EXIT_FAILURE;
}
data.l[i] = parse_atom(dpy, argv[2 + i]);
} else {
fprintf(stderr, "unexpected type for property %s\n", name);
return EXIT_FAILURE;
}
}
XIChangeProperty(dpy, info->deviceid, prop, type, format, PropModeReplace,
data.c, nelements);
free(data.c);
return EXIT_SUCCESS;
}
static obj_t parse_list(struct Parser *st)
{
struct location op = st->token.loc;
obj_t head = unspecific;
obj_t tail = unspecific;
struct token *t;
t = peek(st);
switch (t->type) {
case END:
reportlocf(st->rep, op, "unmatched parenthesis");
return unspecific;
case CPAREN:
/* empty list */
next(st);
return null_obj;
case DOT:
reportlocf(st->rep, t->loc, "cannot start list with dot");
tail = cons(unspecific, unspecific);
goto read_tail;
default:
head = tail = cons(parse_atom(st), unspecific);
goto read_tail;
}
read_tail:
t = peek(st);
switch (t->type) {
case END:
reportlocf(st->rep, op, "unmatched parenthesis");
return unspecific;
case CPAREN:
/* end of list */
next(st);
set_cdr(tail, null_obj);
return head;
case DOT:
next(st);
goto read_last;
default: {
obj_t cell = cons(parse_atom(st), unspecific);
set_cdr(tail, cell);
tail = cell;
goto read_tail;
}
}
read_last:
t = peek(st);
switch (t->type) {
case END:
reportlocf(st->rep, op, "unmatched parenthesis");
return unspecific;
case CPAREN:
reportlocf(st->rep, t->loc, "missing datum after dot");
next(st);
return unspecific;
case DOT:
reportlocf(st->rep, t->loc, "missing datum after dot");
goto read_close;
default:
set_cdr(tail, parse_atom(st));
goto read_close;
}
read_close:
t = peek(st);
switch (t->type) {
case END:
reportlocf(st->rep, op, "unmatched parenthesis");
return unspecific;
case CPAREN:
next(st);
return head;
case DOT:
reportlocf(st->rep, t->loc, "multiple dost in list");
next(st);
goto read_close;
default:
reportlocf(st->rep, t->loc, "extra datum after dot");
parse_atom(st);
goto read_close;
}
}
int charmm_parse_topo_defs(topo_defs *defs, FILE *file, void *v,
void (*print_msg)(void *,const char *)) {
char *tok[TOKLEN];
char sbuf[BUFLEN];
char msgbuf[BUFLEN];
int ntok;
int itok;
int first;
int skip;
int skipall;
int stream;
char *s1, *s2, *s3, *s4;
int i1, i2, i3, i4;
int j1, j2, j3, j4;
unsigned int utmp;
first = 1;
skip = 0;
skipall = 0;
stream = 0;
if ( ! defs ) return -1;
if ( ! file ) return -2;
if ( print_msg == 0 ) print_msg = null_print_msg;
while ( (ntok = charmm_get_tokens(tok,TOKLEN,sbuf,BUFLEN,file)) ) {
if ( ! tok[0][0] ) {
print_msg(v,tok[1]);
continue;
}
if ( skipall ) {
print_msg (v, "skipping statements at end of file due to end or return statement");
break;
}
if ( first ) {
first = 0;
if ( ! strncmp("READ",tok[0],4) && ! strncmp("RTF",tok[1],4) ) {
print_msg (v, "reading topology from stream file");
first = 1;
stream = 1;
continue;
} else if ( ! strncmp("READ",tok[0],4) && ! strncmp("PARA",tok[1],4) ) {
print_msg (v, "skipping parameters in stream file");
skip = 1;
continue;
} else if ( ! strncmp("READ",tok[0],4) ) {
print_msg (v, "skipping unknown section in stream file");
skip = 1;
continue;
} else if ( ntok == 2 && sscanf(tok[0],"%u",&utmp) == 1
&& sscanf(tok[1],"%u",&utmp) == 1 ) {
sprintf(msgbuf,"Created by CHARMM version %s %s",tok[0],tok[1]);
print_msg(v,msgbuf);
continue;
}
}
if ( skip ) {
if ( ! strncmp("END",tok[0],4) ) {
debug_msg("Recognized file end statement in skipped section.");
skip = 0;
first = 1;
}
}
else if ( ! strncmp("END",tok[0],4) ) {
debug_msg("Recognized file end statement.");
if ( stream ) {
stream = 0;
first = 1;
} else {
skipall = 1;
}
}
else if ( ! strncmp("RETURN",tok[0],4) ) {
debug_msg("Recognized return statement.");
skipall = 1;
}
else if ( ! strncmp("ACCE",tok[0],4) ) {
debug_msg("Recognized acceptor statement.");
}
else if ( ! strncmp("DONO",tok[0],4) ) {
debug_msg("Recognized donor statement.");
}
else if ( ! strncmp("BOND",tok[0],4) ||
! strncmp("DOUB",tok[0],4) ||
! strncmp("TRIP",tok[0],4) ) {
debug_msg("Recognized bond statement.");
if ( ntok < 3 || (ntok-1)%2 ) {
print_msg(v,"ERROR! Failed to parse bond statement.");
} else {
for ( itok = 1; itok < ntok; itok += 2 ) {
s1 = parse_atom(tok[itok],&i1,&j1);
s2 = parse_atom(tok[itok+1],&i2,&j2);
if ( topo_defs_bond(defs,0,0,s1,i1,j1,s2,i2,j2) )
print_msg(v,"ERROR! Failed to parse bond statement.");
}
}
}
else if ( ! strncmp("ANGL",tok[0],4) ||
! strncmp("THET",tok[0],4) ) {
debug_msg("Recognized angle statement.");
if ( ntok < 4 || (ntok-1)%3 ) {
print_msg(v,"ERROR! Failed to parse angle statement.");
} else {
for ( itok = 1; itok < ntok; itok += 3 ) {
s1 = parse_atom(tok[itok],&i1,&j1);
s2 = parse_atom(tok[itok+1],&i2,&j2);
s3 = parse_atom(tok[itok+2],&i3,&j3);
if ( topo_defs_angle(defs,0,0,s1,i1,j1,s2,i2,j2,s3,i3,j3) )
print_msg(v,"ERROR! Failed to parse angle statement.");
}
}
}
else if ( ! strncmp("DIHE",tok[0],4) ) {
debug_msg("Recognized dihedral statement.");
if ( ntok < 5 || (ntok-1)%4 ) {
print_msg(v,"ERROR! Failed to parse dihedral statement.");
} else {
for ( itok = 1; itok < ntok; itok += 4 ) {
s1 = parse_atom(tok[itok],&i1,&j1);
s2 = parse_atom(tok[itok+1],&i2,&j2);
s3 = parse_atom(tok[itok+2],&i3,&j3);
s4 = parse_atom(tok[itok+3],&i4,&j4);
if (topo_defs_dihedral(defs,0,0,s1,i1,j1,s2,i2,j2,s3,i3,j3,s4,i4,j4))
print_msg(v,"ERROR! Failed to parse dihedral statement.");
}
}
}
else if ( ! strncmp("IMPH",tok[0],4) ||
! strncmp("IMPR",tok[0],4) ) {
debug_msg("Recognized improper statement.");
if ( ntok < 5 || (ntok-1)%4 ) {
print_msg(v,"ERROR! Failed to parse improper statement.");
} else {
for ( itok = 1; itok < ntok; itok += 4 ) {
s1 = parse_atom(tok[itok],&i1,&j1);
s2 = parse_atom(tok[itok+1],&i2,&j2);
s3 = parse_atom(tok[itok+2],&i3,&j3);
s4 = parse_atom(tok[itok+3],&i4,&j4);
if (topo_defs_improper(defs,0,0,s1,i1,j1,s2,i2,j2,s3,i3,j3,s4,i4,j4))
print_msg(v,"ERROR! Failed to parse improper statement.");
}
}
}
else if ( ! strncmp("CMAP",tok[0],4) ) {
debug_msg("Recognized CMAP statement.");
if ( ntok != 9 ) {
print_msg(v,"ERROR! Failed to parse CMAP statement.");
} else {
const char* s[8]; int i[8], j[8];
for ( itok = 0; itok < 8; ++itok ) {
s[itok] = parse_atom(tok[itok+1],&i[itok],&j[itok]);
}
if (topo_defs_cmap(defs,0,0,s,i,j))
print_msg(v,"ERROR! Failed to parse CMAP statement.");
}
}
else if ( ! strncmp("DECL",tok[0],4) ) {
debug_msg("Recognized atom declaration statement.");
}
else if ( ! strncmp("ATOM",tok[0],4) ) {
debug_msg("Recognized atom statement.");
if ( ntok < 4 ) {
print_msg(v,"ERROR! Failed to parse atom statement.");
} else if ( ntok > 4 ) {
print_msg(v,"ERROR! Explicit exclusions or fluctuating charges not supported, atom ignored.");
} else {
s1 = parse_atom(tok[1],&i1,&j1);
if ( topo_defs_atom(defs,0,0, s1,i1,j1,tok[2],atof(tok[3])) ) {
print_msg(v,"ERROR! Failed to parse atom statement.");
}
}
}
else if ( ! strncmp("MASS",tok[0],4) ) {
debug_msg("Recognized mass statement.");
if ( ntok < 4 || topo_defs_type(defs,tok[2],(ntok>4?tok[4]:""),atof(tok[3]),atoi(tok[1])) ) {
print_msg(v,"ERROR! Failed to parse mass statement.");
}
}
else if ( ! strncmp("AUTO",tok[0],4) ) {
debug_msg("Recognized autogenerate statement.");
for ( itok = 1; itok < ntok; itok += 1 ) {
if ( ! strncmp("ANGL",tok[itok],4) ) {
topo_defs_auto_angles(defs,1);
} else if ( ! strncmp("DIHE",tok[itok],4) ) {
topo_defs_auto_dihedrals(defs,1);
} else {
print_msg(v,"ERROR! Failed to parse autogenerate statement.");
}
}
}
else if ( ! strncmp("DEFA",tok[0],4) ) {
debug_msg("Recognized default patch statement.");
if ( ntok < 3 || (ntok-1)%2 ) {
print_msg(v,"ERROR! Failed to parse default patching statement.");
} else {
i1 = i2 = 0;
for ( itok = 1; itok < ntok; itok += 2 ) {
if ( ! strncmp("FIRS",tok[itok],4) ) {
i1 = topo_defs_default_patching_first(defs,tok[itok+1]);
} else if ( ! strncmp("LAST",tok[itok],4) ) {
i2 = topo_defs_default_patching_last(defs,tok[itok+1]);
} else {
print_msg(v,"ERROR! Failed to parse default patching statement.");
}
}
if ( i1 || i2 )
print_msg(v,"ERROR! Failed to parse default patching statement.");
}
}
else if ( ! strncmp("BILD",tok[0],4) ||
! strncmp("IC",tok[0],4) ) {
debug_msg("Recognized internal coordinate statement.");
if ( ntok < 10 ) {
print_msg(v,"ERROR! Failed to parse internal coordinate statement.");
} else {
s1 = parse_atom(tok[1],&i1,&j1);
s2 = parse_atom(tok[2],&i2,&j2);
s3 = tok[3] + ( tok[3][0] == '*' ? 1 : 0 );
s3 = parse_atom(s3,&i3,&j3);
s4 = parse_atom(tok[4],&i4,&j4);
if ( topo_defs_conformation(defs,0,0,
s1,i1,j1,s2,i2,j2,s3,i3,j3,s4,i4,j4,
atof(tok[5]),atof(tok[6]),atof(tok[7]),
(tok[3][0]=='*'?1:0),atof(tok[8]),atof(tok[9])) )
print_msg(v,"ERROR! Failed to parse internal coordinate statement.");
}
}
else if ( ! strncmp("DELE",tok[0],4) ) {
debug_msg("Recognized delete statement.");
if ( ntok < 2 ) {
print_msg(v,"ERROR! Failed to parse delete statement.");
} else {
if ( ! strncmp("ATOM",tok[1],4) ) {
if ( ntok < 3 ) {
print_msg(v,"ERROR! Failed to parse delete atom statement.");
} else {
s1 = parse_atom(tok[2],&i1,&j1);
if ( topo_defs_atom(defs,0,1, s1,i1,j1,"DEL",0.0) ) {
print_msg(v,"ERROR! Failed to parse delete atom statement.");
}
}
} else if ( ! strncmp("ACCE",tok[1],4) ) {
;
} else if ( ! strncmp("DONO",tok[1],4) ) {
;
} else if ( ! strncmp("BOND",tok[1],4) ||
! strncmp("DOUB",tok[1],4) ||
! strncmp("TRIP",tok[1],4) ) {
if ( ntok < 4 || (ntok-2)%2 ) {
print_msg(v,"ERROR! Failed to parse delete bond statement.");
} else {
for ( itok = 2; itok < ntok; itok += 2 ) {
s1 = parse_atom(tok[itok],&i1,&j1);
s2 = parse_atom(tok[itok+1],&i2,&j2);
if ( topo_defs_bond(defs,0,1,s1,i1,j1,s2,i2,j2) )
print_msg(v,"ERROR! Failed to parse delete bond statement.");
}
}
} else if ( ! strncmp("ANGL",tok[1],4) ||
! strncmp("THET",tok[1],4) ) {
if ( ntok < 5 || (ntok-2)%3 ) {
print_msg(v,"ERROR! Failed to parse delete angle statement.");
} else {
for ( itok = 2; itok < ntok; itok += 3 ) {
s1 = parse_atom(tok[itok],&i1,&j1);
s2 = parse_atom(tok[itok+1],&i2,&j2);
s3 = parse_atom(tok[itok+2],&i3,&j3);
if ( topo_defs_angle(defs,0,1,s1,i1,j1,s2,i2,j2,s3,i3,j3) )
print_msg(v,"ERROR! Failed to parse delete angle statement.");
}
}
} else if ( ! strncmp("DIHE",tok[1],4) ) {
if ( ntok < 6 || (ntok-2)%4 ) {
print_msg(v,"ERROR! Failed to parse delete dihedral statement.");
} else {
for ( itok = 2; itok < ntok; itok += 4 ) {
s1 = parse_atom(tok[itok],&i1,&j1);
s2 = parse_atom(tok[itok+1],&i2,&j2);
s3 = parse_atom(tok[itok+2],&i3,&j3);
s4 = parse_atom(tok[itok+3],&i4,&j4);
if (topo_defs_dihedral(defs,0,1,s1,i1,j1,s2,i2,j2,s3,i3,j3,s4,i4,j4))
print_msg(v,"ERROR! Failed to parse delete dihedral statement.");
}
}
} else if ( ! strncmp("IMPH",tok[1],4) ||
! strncmp("IMPR",tok[1],4) ) {
if ( ntok < 6 || (ntok-2)%4 ) {
print_msg(v,"ERROR! Failed to parse delete improper statement.");
} else {
for ( itok = 2; itok < ntok; itok += 4 ) {
s1 = parse_atom(tok[itok],&i1,&j1);
s2 = parse_atom(tok[itok+1],&i2,&j2);
s3 = parse_atom(tok[itok+2],&i3,&j3);
s4 = parse_atom(tok[itok+3],&i4,&j4);
if (topo_defs_improper(defs,0,1,s1,i1,j1,s2,i2,j2,s3,i3,j3,s4,i4,j4))
print_msg(v,"ERROR! Failed to parse delete improper statement.");
}
}
} else if ( ! strncmp("BILD",tok[1],4) ||
! strncmp("IC",tok[1],4) ) {
if ( ntok < 6 ) {
print_msg(v,"ERROR! Failed to parse delete internal coordinate statement.");
} else {
s1 = parse_atom(tok[2],&i1,&j1);
s2 = parse_atom(tok[3],&i2,&j2);
s3 = tok[4] + ( tok[4][0] == '*' ? 1 : 0 );
s3 = parse_atom(s3,&i3,&j3);
s4 = parse_atom(tok[5],&i4,&j4);
if ( topo_defs_conformation(defs,0,1,
s1,i1,j1,s2,i2,j2,s3,i3,j3,s4,i4,j4,
0,0,0,(tok[4][0]=='*'?1:0),0,0) )
print_msg(v,"ERROR! Failed to parse delete internal coordinate statement.");
}
} else {
print_msg(v,"ERROR! Failed to parse delete statement.");
}
}
}
else if ( ! strncmp("GROU",tok[0],4) ) {
debug_msg("Recognized group statement.");
}
else if ( ! strncmp("PATC",tok[0],4) ) {
debug_msg("Recognized patching statement.");
if ( ntok < 3 || (ntok-1)%2 ) {
print_msg(v,"ERROR! Failed to parse patching statement.");
} else {
i1 = i2 = 0;
for ( itok = 1; itok < ntok; itok += 2 ) {
if ( ! strncmp("FIRS",tok[itok],4) ) {
i1 = topo_defs_patching_first(defs,0,tok[itok+1]);
} else if ( ! strncmp("LAST",tok[itok],4) ) {
i2 = topo_defs_patching_last(defs,0,tok[itok+1]);
} else {
print_msg(v,"ERROR! Failed to parse patching statement.");
}
}
if ( i1 || i2 )
print_msg(v,"ERROR! Failed to parse patching statement.");
}
}
else if ( ! strncmp("RESI",tok[0],4) ) {
debug_msg("Recognized residue statement.");
if ( ntok < 2 || topo_defs_residue(defs,tok[1],0) ) {
print_msg(v,"ERROR! Failed to parse residue statement.");
}
}
else if ( ! strncmp("PRES",tok[0],4) ) {
debug_msg("Recognized patch residue statement.");
if ( ntok < 2 || topo_defs_residue(defs,tok[1],1) ) {
print_msg(v,"ERROR! Failed to parse patch residue statement.");
}
}
else {
sprintf(msgbuf,"ERROR! FAILED TO RECOGNIZE %s",tok[0]);
print_msg(v,msgbuf);
}
}
topo_defs_end(defs);
return 0;
}
/* Read a single sexp from the reader. */
object_t *read_sexp (reader_t * r)
{
/* Check for a shebang line. */
if (r->shebang == -1)
{
char str[2];
str[0] = reader_getc (r);
str[1] = reader_getc (r);
if (str[0] == '#' && str[1] == '!')
{
/* Looks like a she-bang line. */
r->shebang = 1;
consume_line (r);
}
else
{
r->shebang = 0;
reader_putc (r, str[1]);
reader_putc (r, str[0]);
}
}
r->done = 0;
r->error = 0;
push (r);
print_prompt (r);
while (!r->eof && !r->error && (list_empty (r) || stack_height (r) > 1))
{
int nc, c = reader_getc (r);
switch (c)
{
case EOF:
r->eof = 1;
break;
/* Comments */
case ';':
consume_line (r);
break;
/* Dotted pair */
case '.':
nc = reader_getc (r);
if (strchr (" \t\r\n()", nc) != NULL)
{
if (r->state->dotpair_mode > 0)
read_error (r, "invalid dotted pair syntax");
else if (r->state->vector_mode > 0)
read_error (r, "dotted pair not allowed in vector");
else
{
r->state->dotpair_mode = 1;
reader_putc (r, nc);
}
}
else
{
/* Turn it into a decimal point. */
reader_putc (r, nc);
reader_putc (r, '.');
reader_putc (r, '0');
}
break;
/* Whitespace */
case '\n':
r->linecnt++;
print_prompt (r);
case ' ':
case '\t':
case '\r':
break;
/* Parenthesis */
case '(':
push (r);
break;
case ')':
if (r->state->quote_mode)
read_error (r, "unbalanced parenthesis");
else if (r->state->vector_mode)
read_error (r, "unbalanced brackets");
else
addpop (r);
break;
/* Vectors */
case '[':
push (r);
r->state->vector_mode = 1;
break;
case ']':
if (r->state->quote_mode)
read_error (r, "unbalanced parenthesis");
else if (!r->state->vector_mode)
read_error (r, "unbalanced brackets");
else
addpop (r);
break;
/* Quoting */
case '\'':
push (r);
add (r, quote);
if (!r->error)
r->state->quote_mode = 1;
break;
/* strings */
case '"':
buf_read (r, "\"");
add (r, parse_str (r));
reader_getc (r); /* Throw away other quote. */
break;
/* numbers and symbols */
default:
buf_append (r, c);
buf_read (r, " \t\r\n()[];");
object_t *o = parse_atom (r);
if (!r->error)
add (r, o);
break;
}
}
if (!r->eof && !r->error)
consume_whitespace (r);
if (r->error)
return err_symbol;
/* Check state */
r->done = 1;
if (stack_height (r) > 1 || r->state->quote_mode
|| r->state->dotpair_mode == 1)
{
read_error (r, "premature end of file");
return err_symbol;
}
if (list_empty (r))
{
obj_destroy (pop (r));
return NIL;
}
object_t *wrap = pop (r);
object_t *sexp = UPREF (CAR (wrap));
obj_destroy (wrap);
return sexp;
}
