sexp sexp_exec (sexp ctx, sexp self, sexp_sint_t n, sexp name, sexp args) {
int i, len = sexp_unbox_fixnum(sexp_length(ctx, args));
char **argv = malloc((len+1)*sizeof(char*));
for (i=0; i<len; i++, args=sexp_cdr(args))
argv[i] = sexp_string_data(sexp_car(args));
argv[len] = NULL;
exec(sexp_string_data(name), argv);
return SEXP_VOID; /* won't really return */
}
/* Take the hash value and convert into an MPI, suitable for
passing to the low level functions. We currently support the
old style way of passing just a MPI and the modern interface which
allows to pass flags so that we can choose between raw and pkcs1
padding - may be more padding options later.
(<mpi>)
or
(data
[(flags [raw, direct, pkcs1, oaep, pss, no-blinding, rfc6979, eddsa])]
[(hash <algo> <value>)]
[(value <text>)]
[(hash-algo <algo>)]
[(label <label>)]
[(salt-length <length>)]
[(random-override <data>)]
)
Either the VALUE or the HASH element must be present for use
with signatures. VALUE is used for encryption.
HASH-ALGO is specific to OAEP and EDDSA.
LABEL is specific to OAEP.
SALT-LENGTH is for PSS.
RANDOM-OVERRIDE is used to replace random nonces for regression
testing. */
gcry_err_code_t
_gcry_pk_util_data_to_mpi (gcry_sexp_t input, gcry_mpi_t *ret_mpi,
struct pk_encoding_ctx *ctx)
{
gcry_err_code_t rc = 0;
gcry_sexp_t ldata, lhash, lvalue;
size_t n;
const char *s;
int unknown_flag = 0;
int parsed_flags = 0;
*ret_mpi = NULL;
ldata = sexp_find_token (input, "data", 0);
if (!ldata)
{ /* assume old style */
*ret_mpi = sexp_nth_mpi (input, 0, 0);
return *ret_mpi ? GPG_ERR_NO_ERROR : GPG_ERR_INV_OBJ;
}
/* See whether there is a flags list. */
{
gcry_sexp_t lflags = sexp_find_token (ldata, "flags", 0);
if (lflags)
{
if (_gcry_pk_util_parse_flaglist (lflags,
&parsed_flags, &ctx->encoding))
unknown_flag = 1;
sexp_release (lflags);
}
}
if (ctx->encoding == PUBKEY_ENC_UNKNOWN)
ctx->encoding = PUBKEY_ENC_RAW; /* default to raw */
/* Get HASH or MPI */
lhash = sexp_find_token (ldata, "hash", 0);
lvalue = lhash? NULL : sexp_find_token (ldata, "value", 0);
if (!(!lhash ^ !lvalue))
rc = GPG_ERR_INV_OBJ; /* none or both given */
else if (unknown_flag)
rc = GPG_ERR_INV_FLAG;
else if (ctx->encoding == PUBKEY_ENC_RAW
&& (parsed_flags & PUBKEY_FLAG_EDDSA))
{
/* Prepare for EdDSA. */
gcry_sexp_t list;
void *value;
size_t valuelen;
if (!lvalue)
{
rc = GPG_ERR_INV_OBJ;
goto leave;
}
/* Get HASH-ALGO. */
list = sexp_find_token (ldata, "hash-algo", 0);
if (list)
{
s = sexp_nth_data (list, 1, &n);
if (!s)
rc = GPG_ERR_NO_OBJ;
else
{
ctx->hash_algo = get_hash_algo (s, n);
if (!ctx->hash_algo)
rc = GPG_ERR_DIGEST_ALGO;
}
sexp_release (list);
}
else
rc = GPG_ERR_INV_OBJ;
if (rc)
goto leave;
/* Get VALUE. */
value = sexp_nth_buffer (lvalue, 1, &valuelen);
if (!value)
{
/* We assume that a zero length message is meant by
"(value)". This is commonly used by test vectors. Note
that S-expression do not allow zero length items. */
valuelen = 0;
value = xtrymalloc (1);
if (!value)
rc = gpg_err_code_from_syserror ();
}
else if ((valuelen * 8) < valuelen)
{
xfree (value);
rc = GPG_ERR_TOO_LARGE;
}
if (rc)
goto leave;
/* Note that mpi_set_opaque takes ownership of VALUE. */
*ret_mpi = mpi_set_opaque (NULL, value, valuelen*8);
}
else if (ctx->encoding == PUBKEY_ENC_RAW && lhash
&& ((parsed_flags & PUBKEY_FLAG_RAW_FLAG)
|| (parsed_flags & PUBKEY_FLAG_RFC6979)))
{
/* Raw encoding along with a hash element. This is commonly
used for DSA. For better backward error compatibility we
allow this only if either the rfc6979 flag has been given or
the raw flags was explicitly given. */
if (sexp_length (lhash) != 3)
rc = GPG_ERR_INV_OBJ;
else if ( !(s=sexp_nth_data (lhash, 1, &n)) || !n )
rc = GPG_ERR_INV_OBJ;
else
{
void *value;
size_t valuelen;
ctx->hash_algo = get_hash_algo (s, n);
if (!ctx->hash_algo)
rc = GPG_ERR_DIGEST_ALGO;
else if (!(value=sexp_nth_buffer (lhash, 2, &valuelen)))
rc = GPG_ERR_INV_OBJ;
else if ((valuelen * 8) < valuelen)
{
xfree (value);
rc = GPG_ERR_TOO_LARGE;
}
else
*ret_mpi = mpi_set_opaque (NULL, value, valuelen*8);
}
}
else if (ctx->encoding == PUBKEY_ENC_RAW && lvalue)
{
/* RFC6969 may only be used with the a hash value and not the
MPI based value. */
if (parsed_flags & PUBKEY_FLAG_RFC6979)
{
rc = GPG_ERR_CONFLICT;
goto leave;
}
/* Get the value */
*ret_mpi = sexp_nth_mpi (lvalue, 1, GCRYMPI_FMT_USG);
if (!*ret_mpi)
rc = GPG_ERR_INV_OBJ;
}
else if (ctx->encoding == PUBKEY_ENC_PKCS1 && lvalue
&& ctx->op == PUBKEY_OP_ENCRYPT)
{
const void * value;
size_t valuelen;
gcry_sexp_t list;
void *random_override = NULL;
size_t random_override_len = 0;
if ( !(value=sexp_nth_data (lvalue, 1, &valuelen)) || !valuelen )
rc = GPG_ERR_INV_OBJ;
else
{
/* Get optional RANDOM-OVERRIDE. */
list = sexp_find_token (ldata, "random-override", 0);
if (list)
{
s = sexp_nth_data (list, 1, &n);
if (!s)
rc = GPG_ERR_NO_OBJ;
else if (n > 0)
{
random_override = xtrymalloc (n);
if (!random_override)
rc = gpg_err_code_from_syserror ();
else
{
memcpy (random_override, s, n);
random_override_len = n;
}
}
sexp_release (list);
if (rc)
goto leave;
}
rc = _gcry_rsa_pkcs1_encode_for_enc (ret_mpi, ctx->nbits,
value, valuelen,
random_override,
random_override_len);
xfree (random_override);
}
}
else if (ctx->encoding == PUBKEY_ENC_PKCS1 && lhash
&& (ctx->op == PUBKEY_OP_SIGN || ctx->op == PUBKEY_OP_VERIFY))
{
if (sexp_length (lhash) != 3)
rc = GPG_ERR_INV_OBJ;
else if ( !(s=sexp_nth_data (lhash, 1, &n)) || !n )
rc = GPG_ERR_INV_OBJ;
else
{
const void * value;
size_t valuelen;
ctx->hash_algo = get_hash_algo (s, n);
if (!ctx->hash_algo)
rc = GPG_ERR_DIGEST_ALGO;
else if ( !(value=sexp_nth_data (lhash, 2, &valuelen))
|| !valuelen )
rc = GPG_ERR_INV_OBJ;
else
rc = _gcry_rsa_pkcs1_encode_for_sig (ret_mpi, ctx->nbits,
value, valuelen,
ctx->hash_algo);
}
}
else if (ctx->encoding == PUBKEY_ENC_OAEP && lvalue
&& ctx->op == PUBKEY_OP_ENCRYPT)
{
const void * value;
size_t valuelen;
if ( !(value=sexp_nth_data (lvalue, 1, &valuelen)) || !valuelen )
rc = GPG_ERR_INV_OBJ;
else
{
gcry_sexp_t list;
void *random_override = NULL;
size_t random_override_len = 0;
/* Get HASH-ALGO. */
list = sexp_find_token (ldata, "hash-algo", 0);
if (list)
{
s = sexp_nth_data (list, 1, &n);
if (!s)
rc = GPG_ERR_NO_OBJ;
else
{
ctx->hash_algo = get_hash_algo (s, n);
if (!ctx->hash_algo)
rc = GPG_ERR_DIGEST_ALGO;
}
sexp_release (list);
if (rc)
goto leave;
}
/* Get LABEL. */
list = sexp_find_token (ldata, "label", 0);
if (list)
{
s = sexp_nth_data (list, 1, &n);
if (!s)
rc = GPG_ERR_NO_OBJ;
else if (n > 0)
{
ctx->label = xtrymalloc (n);
if (!ctx->label)
rc = gpg_err_code_from_syserror ();
else
{
memcpy (ctx->label, s, n);
ctx->labellen = n;
}
}
sexp_release (list);
if (rc)
goto leave;
}
/* Get optional RANDOM-OVERRIDE. */
list = sexp_find_token (ldata, "random-override", 0);
if (list)
{
s = sexp_nth_data (list, 1, &n);
if (!s)
rc = GPG_ERR_NO_OBJ;
else if (n > 0)
{
random_override = xtrymalloc (n);
if (!random_override)
rc = gpg_err_code_from_syserror ();
else
{
memcpy (random_override, s, n);
random_override_len = n;
}
}
sexp_release (list);
if (rc)
goto leave;
}
rc = _gcry_rsa_oaep_encode (ret_mpi, ctx->nbits, ctx->hash_algo,
value, valuelen,
ctx->label, ctx->labellen,
random_override, random_override_len);
xfree (random_override);
}
}
else if (ctx->encoding == PUBKEY_ENC_PSS && lhash
&& ctx->op == PUBKEY_OP_SIGN)
{
if (sexp_length (lhash) != 3)
rc = GPG_ERR_INV_OBJ;
else if ( !(s=sexp_nth_data (lhash, 1, &n)) || !n )
rc = GPG_ERR_INV_OBJ;
else
{
const void * value;
size_t valuelen;
void *random_override = NULL;
size_t random_override_len = 0;
ctx->hash_algo = get_hash_algo (s, n);
if (!ctx->hash_algo)
rc = GPG_ERR_DIGEST_ALGO;
else if ( !(value=sexp_nth_data (lhash, 2, &valuelen))
|| !valuelen )
rc = GPG_ERR_INV_OBJ;
else
{
gcry_sexp_t list;
/* Get SALT-LENGTH. */
list = sexp_find_token (ldata, "salt-length", 0);
if (list)
{
s = sexp_nth_data (list, 1, &n);
if (!s)
{
rc = GPG_ERR_NO_OBJ;
goto leave;
}
ctx->saltlen = (unsigned int)strtoul (s, NULL, 10);
sexp_release (list);
}
/* Get optional RANDOM-OVERRIDE. */
list = sexp_find_token (ldata, "random-override", 0);
if (list)
{
s = sexp_nth_data (list, 1, &n);
if (!s)
rc = GPG_ERR_NO_OBJ;
else if (n > 0)
{
random_override = xtrymalloc (n);
if (!random_override)
rc = gpg_err_code_from_syserror ();
else
{
memcpy (random_override, s, n);
random_override_len = n;
}
}
sexp_release (list);
if (rc)
goto leave;
}
/* Encode the data. (NBITS-1 is due to 8.1.1, step 1.) */
rc = _gcry_rsa_pss_encode (ret_mpi, ctx->nbits - 1,
ctx->hash_algo,
value, valuelen, ctx->saltlen,
random_override, random_override_len);
xfree (random_override);
}
}
}
else if (ctx->encoding == PUBKEY_ENC_PSS && lhash
&& ctx->op == PUBKEY_OP_VERIFY)
{
if (sexp_length (lhash) != 3)
rc = GPG_ERR_INV_OBJ;
else if ( !(s=sexp_nth_data (lhash, 1, &n)) || !n )
rc = GPG_ERR_INV_OBJ;
else
{
ctx->hash_algo = get_hash_algo (s, n);
if (!ctx->hash_algo)
rc = GPG_ERR_DIGEST_ALGO;
else
{
*ret_mpi = sexp_nth_mpi (lhash, 2, GCRYMPI_FMT_USG);
if (!*ret_mpi)
rc = GPG_ERR_INV_OBJ;
ctx->verify_cmp = pss_verify_cmp;
ctx->verify_arg = *ret_mpi;
}
}
}
else
rc = GPG_ERR_CONFLICT;
leave:
sexp_release (ldata);
sexp_release (lhash);
sexp_release (lvalue);
if (!rc)
ctx->flags = parsed_flags;
else
{
xfree (ctx->label);
ctx->label = NULL;
}
return rc;
}
/* Parser for a flag list. On return the encoding is stored at
R_ENCODING and the flags are stored at R_FLAGS. If any of them is
not needed, NULL may be passed. The function returns 0 on success
or an error code. */
gpg_err_code_t
_gcry_pk_util_parse_flaglist (gcry_sexp_t list,
int *r_flags, enum pk_encoding *r_encoding)
{
gpg_err_code_t rc = 0;
const char *s;
size_t n;
int i;
int encoding = PUBKEY_ENC_UNKNOWN;
int flags = 0;
int igninvflag = 0;
for (i = list ? sexp_length (list)-1 : 0; i > 0; i--)
{
s = sexp_nth_data (list, i, &n);
if (!s)
continue; /* Not a data element. */
switch (n)
{
case 3:
if (!memcmp (s, "pss", 3) && encoding == PUBKEY_ENC_UNKNOWN)
{
encoding = PUBKEY_ENC_PSS;
flags |= PUBKEY_FLAG_FIXEDLEN;
}
else if (!memcmp (s, "raw", 3) && encoding == PUBKEY_ENC_UNKNOWN)
{
encoding = PUBKEY_ENC_RAW;
flags |= PUBKEY_FLAG_RAW_FLAG; /* Explicitly given. */
}
else if (!igninvflag)
rc = GPG_ERR_INV_FLAG;
break;
case 4:
if (!memcmp (s, "comp", 4))
flags |= PUBKEY_FLAG_COMP;
else if (!memcmp (s, "oaep", 4) && encoding == PUBKEY_ENC_UNKNOWN)
{
encoding = PUBKEY_ENC_OAEP;
flags |= PUBKEY_FLAG_FIXEDLEN;
}
else if (!memcmp (s, "gost", 4))
{
encoding = PUBKEY_ENC_RAW;
flags |= PUBKEY_FLAG_GOST;
}
else if (!igninvflag)
rc = GPG_ERR_INV_FLAG;
break;
case 5:
if (!memcmp (s, "eddsa", 5))
{
encoding = PUBKEY_ENC_RAW;
flags |= PUBKEY_FLAG_EDDSA;
}
else if (!memcmp (s, "pkcs1", 5) && encoding == PUBKEY_ENC_UNKNOWN)
{
encoding = PUBKEY_ENC_PKCS1;
flags |= PUBKEY_FLAG_FIXEDLEN;
}
else if (!memcmp (s, "param", 5))
flags |= PUBKEY_FLAG_PARAM;
else if (!igninvflag)
rc = GPG_ERR_INV_FLAG;
break;
case 6:
if (!memcmp (s, "nocomp", 6))
flags |= PUBKEY_FLAG_NOCOMP;
else if (!igninvflag)
rc = GPG_ERR_INV_FLAG;
break;
case 7:
if (!memcmp (s, "rfc6979", 7))
flags |= PUBKEY_FLAG_RFC6979;
else if (!memcmp (s, "noparam", 7))
; /* Ignore - it is the default. */
else if (!igninvflag)
rc = GPG_ERR_INV_FLAG;
break;
case 8:
if (!memcmp (s, "use-x931", 8))
flags |= PUBKEY_FLAG_USE_X931;
else if (!igninvflag)
rc = GPG_ERR_INV_FLAG;
break;
case 10:
if (!memcmp (s, "igninvflag", 10))
igninvflag = 1;
else if (!memcmp (s, "no-keytest", 10))
flags |= PUBKEY_FLAG_NO_KEYTEST;
/* In 1.7.0 we will return an INV_FLAG on error but we
do not fix that bug here in 1.6.4 */
break;
case 11:
if (!memcmp (s, "no-blinding", 11))
flags |= PUBKEY_FLAG_NO_BLINDING;
else if (!memcmp (s, "use-fips186", 11))
flags |= PUBKEY_FLAG_USE_FIPS186;
else if (!igninvflag)
rc = GPG_ERR_INV_FLAG;
break;
case 13:
if (!memcmp (s, "use-fips186-2", 13))
flags |= PUBKEY_FLAG_USE_FIPS186_2;
else if (!memcmp (s, "transient-key", 13))
flags |= PUBKEY_FLAG_TRANSIENT_KEY;
else if (!igninvflag)
rc = GPG_ERR_INV_FLAG;
break;
default:
if (!igninvflag)
rc = GPG_ERR_INV_FLAG;
break;
}
}
if (r_flags)
*r_flags = flags;
if (r_encoding)
*r_encoding = encoding;
return rc;
}
dalvik_method_t* dalvik_method_from_sexp(const sexpression_t* sexp, const char* class_path,const char* file)
{
#ifdef PARSER_COUNT
dalvik_method_count ++;
#endif
dalvik_method_t* method = NULL;
if(SEXP_NIL == sexp) return NULL;
if(NULL == class_path) class_path = "(undefined)";
if(NULL == file) file = "(undefined)";
const char* name;
sexpression_t *attrs, *arglist, *ret, *body;
/* matches (method (attribute-list) method-name (arg-list) return-type body) */
if(!sexp_match(sexp, "(L=C?L?C?_?A", DALVIK_TOKEN_METHOD, &attrs, &name, &arglist, &ret, &body))
{
LOG_ERROR("bad method defination");
return NULL;
}
/* get attributes */
int attrnum;
if((attrnum = dalvik_attrs_from_sexp(attrs)) < 0)
{
LOG_ERROR("can not parse attributes");
return NULL;
}
/* get number of arguments */
int num_args;
num_args = sexp_length(arglist);
/* Now we know the size we have to allocate for this method */
method = (dalvik_method_t*)malloc(sizeof(dalvik_method_t) + sizeof(dalvik_type_t*) * (num_args + 1));
if(NULL == method)
{
LOG_ERROR("can not allocate memory for method argument list");
return NULL;
}
memset(method->args_type, 0, sizeof(dalvik_type_t*) * (num_args + 1));
method->num_args = num_args;
method->path = class_path;
method->file = file;
method->name = name;
/* Setup the type of argument list */
int i;
for(i = 0;arglist != SEXP_NIL && i < num_args; i ++)
{
sexpression_t *this_arg;
if(!sexp_match(arglist, "(_?A", &this_arg, &arglist))
{
LOG_ERROR("invalid argument list");
goto ERR;
}
if(NULL == (method->args_type[i] = dalvik_type_from_sexp(this_arg)))
{
LOG_ERROR("invalid argument type @ #%d", i);
goto ERR;
}
}
/* Setup the return type */
if(NULL == (method->return_type = dalvik_type_from_sexp(ret)))
{
LOG_ERROR("invalid return type");
goto ERR;
}
/* Now fetch the body */
//TODO: process other parts of a method
int current_line_number = 0; /* Current Line Number */
uint32_t last = DALVIK_INSTRUCTION_INVALID;
//int last_label = -1;
int label_stack[DALVIK_METHOD_LABEL_STACK_SIZE]; /* how many label can one isntruction assign to */
int label_sp;
int from_label[DALVIK_MAX_CATCH_BLOCK]; /* NOTICE: the maximum number of catch block is limited to this constant */
int to_label [DALVIK_MAX_CATCH_BLOCK];
int label_st [DALVIK_MAX_CATCH_BLOCK]; /* 0: haven't seen any label related to the label.
* 1: seen from label before
* 2: seen from and to label
*/
label_sp = 0;
dalvik_exception_handler_t* excepthandler[DALVIK_MAX_CATCH_BLOCK] = {};
dalvik_exception_handler_set_t* current_ehset = NULL;
int number_of_exception_handler = 0;
for(;body != SEXP_NIL;)
{
sexpression_t *this_smt;
if(!sexp_match(body, "(C?A", &this_smt, &body))
{
LOG_ERROR("invalid method body");
goto ERR;
}
/* First check if the statement is a psuedo-instruction */
const char* arg;
#if LOG_LEVEL >= 6
char buf[40906];
static int counter = 0;
#endif
LOG_DEBUG("#%d current instruction : %s",(++counter) ,sexp_to_string(this_smt, buf) );
if(sexp_match(this_smt, "(L=L=L?", DALVIK_TOKEN_LIMIT, DALVIK_TOKEN_REGISTERS, &arg))
{
/* (limit-registers k) */
method->num_regs = atoi(arg);
LOG_DEBUG("uses %d registers", method->num_regs);
}
else if(sexp_match(this_smt, "(L=L?", DALVIK_TOKEN_LINE, &arg))
{
/* (line arg) */
current_line_number = atoi(arg);
}
else if(sexp_match(this_smt, "(L=L?", DALVIK_TOKEN_LABEL, &arg))
{
/* (label arg) */
int lid = dalvik_label_get_label_id(arg);
int i;
if(lid == -1)
{
LOG_ERROR("can not create label for %s", arg);
goto ERR;
}
//last_label = lid;
if(label_sp < DALVIK_METHOD_LABEL_STACK_SIZE)
label_stack[label_sp++] = lid;
else
LOG_WARNING("label stack overflow, might loss some label here");
int enbaled_count = 0;
dalvik_exception_handler_t* exceptionset[DALVIK_MAX_CATCH_BLOCK];
for(i = 0; i < number_of_exception_handler; i ++)
{
if(lid == from_label[i] && label_st[i] == 0)
label_st[i] = 1;
else if(lid == to_label[i] && label_st[i] == 1)
label_st[i] = 2;
else if(lid == from_label[i] && label_st[i] != 0)
LOG_WARNING("meet from label twice, it might be a mistake");
else if(lid == to_label[i] && label_st[i] != 1)
LOG_WARNING("to label is before from label, it might be a mistake");
if(label_st[i] == 1)
exceptionset[enbaled_count++] = excepthandler[i];
}
current_ehset = dalvik_exception_new_handler_set(enbaled_count, exceptionset);
}
else if(sexp_match(this_smt, "(L=A", DALVIK_TOKEN_ANNOTATION, &arg))
{
/* Simplely ignore */
LOG_INFO("fixme: ignored psuedo-insturction (annotation)");
}
else if(sexp_match(this_smt, "(L=L=A", DALVIK_TOKEN_DATA, DALVIK_TOKEN_ARRAY, &arg))
{
/* TODO: what is (data-array ....)statement currently ignored */
LOG_INFO("fixme: (data-array) psuedo-insturction is to be implemented");
}
else if(sexp_match(this_smt, "(L=A", DALVIK_TOKEN_CATCH, &arg) ||
sexp_match(this_smt, "(L=A", DALVIK_TOKEN_CATCHALL, &arg))
{
excepthandler[number_of_exception_handler] =
dalvik_exception_handler_from_sexp(
this_smt,
from_label + number_of_exception_handler,
to_label + number_of_exception_handler);
if(excepthandler[number_of_exception_handler] == NULL)
{
LOG_WARNING("invalid exception handler %s", sexp_to_string(this_smt, NULL));
continue;
}
LOG_DEBUG("exception %s is handlered in label #%d",
excepthandler[number_of_exception_handler]->exception,
excepthandler[number_of_exception_handler]->handler_label);
//label_st[number_of_exception_handler] = 0; /* TODO: verify this is a bug */
number_of_exception_handler ++;
}
else if(sexp_match(this_smt, "(L=A", DALVIK_TOKEN_FILL, &arg))
{
//TODO: fill-array-data psuedo-instruction
LOG_INFO("fixme: (fill-array-data) is to be implemented");
}
else
{
dalvik_instruction_t* inst = dalvik_instruction_new();
if(NULL == inst)
{
LOG_ERROR("can not create new instruction");
goto ERR;
}
if(dalvik_instruction_from_sexp(this_smt, inst, current_line_number) < 0)
{
LOG_ERROR("can not recognize instuction %s", sexp_to_string(this_smt, NULL));
goto ERR;
}
if(DALVIK_INSTRUCTION_INVALID == last)
method->entry = dalvik_instruction_get_index(inst);
else
dalvik_instruction_set_next(last, inst);
last = dalvik_instruction_get_index(inst);
inst->handler_set = current_ehset;
if(label_sp > 0)
{
int i;
for(i = 0; i < label_sp; i++)
{
LOG_DEBUG("assigned instruction@%p to label #%d", inst, label_stack[i]);
dalvik_label_jump_table[label_stack[i]] = dalvik_instruction_get_index(inst);
}
label_sp = 0;
}
}
}
return method;
ERR:
dalvik_method_free(method);
return NULL;
}
static sexp sexp_type_num_slots_op (sexp ctx, sexp self, sexp_sint_t n, sexp t) {
sexp_assert_type(ctx, sexp_typep, SEXP_TYPE, t);
return sexp_truep(sexp_type_slots(t)) ? sexp_length(ctx, sexp_type_slots(t))
: sexp_make_fixnum(sexp_type_field_eq_len_base(t));
}
static sexp simplify (sexp ctx, sexp ast, sexp init_substs, sexp lambda) {
int check;
sexp ls1, ls2, p1, p2, sv;
sexp_gc_var5(res, substs, tmp, app, ctx2);
sexp_gc_preserve5(ctx, res, substs, tmp, app, ctx2);
res = ast; /* return the ast as-is by default */
substs = init_substs;
loop:
switch (sexp_pointerp(res) ? sexp_pointer_tag(res) : 0) {
case SEXP_PAIR:
/* don't simplify the operator if it's a lambda because we
simplify that as a special case below, with the appropriate
substs list */
app = sexp_list1(ctx, sexp_lambdap(sexp_car(res)) ? sexp_car(res)
: (tmp=simplify(ctx, sexp_car(res), substs, lambda)));
sexp_pair_source(app) = sexp_pair_source(res);
for (ls1=sexp_cdr(res); sexp_pairp(ls1); ls1=sexp_cdr(ls1)) {
sexp_push(ctx, app, tmp=simplify(ctx, sexp_car(ls1), substs, lambda));
if (sexp_pairp(app)) sexp_pair_source(app) = sexp_pair_source(ls1);
}
app = sexp_nreverse(ctx, app);
/* app now holds a copy of the list, and is the default result
(res = app below) if we don't replace it with a simplification */
if (sexp_opcodep(sexp_car(app))) {
/* opcode app - right now we just constant fold arithmetic */
if (sexp_opcode_class(sexp_car(app)) == SEXP_OPC_ARITHMETIC) {
for (check=1, ls1=sexp_cdr(app); sexp_pairp(ls1); ls1=sexp_cdr(ls1)) {
if (sexp_pointerp(sexp_car(ls1)) && ! sexp_litp(sexp_car(ls1))) {
check = 0;
break;
}
}
if (check) {
ctx2 = sexp_make_eval_context(ctx, NULL, sexp_context_env(ctx), 0, 0);
sexp_generate(ctx2, 0, 0, 0, app);
res = sexp_complete_bytecode(ctx2);
if (! sexp_exceptionp(res)) {
tmp = sexp_make_vector(ctx2, 0, SEXP_VOID);
tmp = sexp_make_procedure(ctx2, SEXP_ZERO, SEXP_ZERO, res, tmp);
if (! sexp_exceptionp(tmp)) {
tmp = sexp_apply(ctx2, tmp, SEXP_NULL);
if (! sexp_exceptionp(tmp))
app = sexp_make_lit(ctx2, tmp);
}
}
}
}
} else if (lambda && sexp_lambdap(sexp_car(app))) { /* let */
p1 = NULL;
p2 = sexp_lambda_params(sexp_car(app));
ls1 = app;
ls2 = sexp_cdr(app);
sv = sexp_lambda_sv(sexp_car(app));
if (sexp_length(ctx, p2) == sexp_length(ctx, ls2)) {
for ( ; sexp_pairp(ls2); ls2=sexp_cdr(ls2), p2=sexp_cdr(p2)) {
if (sexp_not(sexp_memq(ctx, sexp_car(p2), sv))
&& (! sexp_pointerp(sexp_car(ls2)) || sexp_litp(sexp_car(ls2))
|| (sexp_refp(sexp_car(ls2))
&& sexp_lambdap(sexp_ref_loc(sexp_car(ls2)))
&& sexp_not(sexp_memq(ctx, sexp_ref_name(sexp_car(ls2)),
sexp_lambda_sv(sexp_ref_loc(sexp_car(ls2)))))))) {
tmp = sexp_cons(ctx, sexp_car(app), sexp_car(ls2));
tmp = sexp_cons(ctx, sexp_car(p2), tmp);
sexp_push(ctx, substs, tmp);
sexp_cdr(ls1) = sexp_cdr(ls2);
if (p1)
sexp_cdr(p1) = sexp_cdr(p2);
else
sexp_lambda_params(sexp_car(app)) = sexp_cdr(p2);
} else {
p1 = p2;
ls1 = ls2;
}
}
sexp_lambda_body(sexp_car(app))
= simplify(ctx, sexp_lambda_body(sexp_car(app)), substs, sexp_car(app));
if (sexp_nullp(sexp_cdr(app))
&& sexp_nullp(sexp_lambda_params(sexp_car(app)))
&& sexp_nullp(sexp_lambda_defs(sexp_car(app))))
app = sexp_lambda_body(sexp_car(app));
}
}
res = app;
break;
case SEXP_LAMBDA:
sexp_lambda_body(res) = simplify(ctx, sexp_lambda_body(res), substs, res);
break;
case SEXP_CND:
tmp = simplify(ctx, sexp_cnd_test(res), substs, lambda);
if (sexp_litp(tmp) || ! sexp_pointerp(tmp)) {
res = sexp_not((sexp_litp(tmp) ? sexp_lit_value(tmp) : tmp))
? sexp_cnd_fail(res) : sexp_cnd_pass(res);
goto loop;
} else {
sexp_cnd_test(res) = tmp;
simplify_it(sexp_cnd_pass(res));
simplify_it(sexp_cnd_fail(res));
}
break;
case SEXP_REF:
tmp = sexp_ref_name(res);
for (ls1=substs; sexp_pairp(ls1); ls1=sexp_cdr(ls1))
if ((sexp_caar(ls1) == tmp) && (sexp_cadar(ls1) == sexp_ref_loc(res))) {
res = sexp_cddar(ls1);
break;
}
break;
case SEXP_SET:
simplify_it(sexp_set_value(res));
break;
case SEXP_SEQ:
app = SEXP_NULL;
for (ls2=sexp_seq_ls(res); sexp_pairp(ls2); ls2=sexp_cdr(ls2)) {
tmp = simplify(ctx, sexp_car(ls2), substs, lambda);
if (! (sexp_pairp(sexp_cdr(ls2))
&& (sexp_litp(tmp) || ! sexp_pointerp(tmp) || sexp_refp(tmp)
|| sexp_lambdap(tmp))))
sexp_push(ctx, app, tmp);
}
if (sexp_pairp(app) && sexp_nullp(sexp_cdr(app)))
res = sexp_car(app);
else
sexp_seq_ls(res) = sexp_nreverse(ctx, app);
break;
}
sexp_gc_release5(ctx);
return res;
}
