static rsexp read_bytevector (Reader* reader)
{
rsexp bytes;
rsexp datum;
rsexp res = R_FAILURE;
if (!match (reader, TKN_HASH_U8_LP))
goto exit;
bytes = R_NULL;
while (lookahead (reader)->_id != TKN_RP) {
datum = read_datum (reader);
if (!r_byte_p (datum)) {
syntax_error (reader, "value out of range");
goto exit;
}
ensure_or_goto (bytes = r_cons (reader->r, datum, bytes), exit);
}
if (!match (reader, TKN_RP))
goto exit;
res = r_list_to_bytevector (reader->r,
r_reverse_x (reader->r, bytes));
exit:
return res;
}
static rsexp read_datum (Reader* reader)
{
rsexp datum;
if (match (reader, TKN_HASH_SEMICOLON))
if (r_failure_p (read_datum (reader)))
return R_FAILURE;
datum = read_simple_datum (reader);
return r_failure_p (datum) ? read_compound_datum (reader) : datum;
}
static rsexp read_abbreviation (Reader* reader)
{
RState* r;
rsexp prefix;
rsexp datum;
rsexp res;
r = reader->r;
res = R_FAILURE;
switch (lookahead (reader)->_id) {
case TKN_QUOTE:
prefix = R_QUOTE;
break;
case TKN_BACKTICK:
prefix = R_QUASIQUOTE;
break;
case TKN_COMMA:
prefix = R_UNQUOTE;
break;
case TKN_COMMA_AT:
prefix = R_UNQUOTE_SPLICING;
break;
default:
goto exit;
}
consume (reader);
datum = read_datum (reader);
if (r_failure_p (datum)) {
syntax_error (reader, "bad syntax");
goto exit;
}
res = r_list (r, 2, prefix, datum);
exit:
return res;
}
static rsexp read_vector (Reader* reader)
{
rsexp datum;
rsexp list;
rsexp res;
res = R_FAILURE;
if (!match (reader, TKN_HASH_LP))
goto exit;
r_gc_scope_open (reader->r);
for (list = R_NULL; lookahead (reader)->_id != TKN_RP; ) {
datum = read_datum (reader);
if (r_eof_object_p (datum)) {
syntax_error (reader, "the vector is not closed");
res = R_FAILURE;
goto clean;
}
if (r_failure_p (datum)) {
syntax_error (reader, "expecting a vector element");
res = R_FAILURE;
goto clean;
}
ensure_or_goto (list = r_cons (reader->r, datum, list), clean);
}
consume (reader);
res = r_list_to_vector (reader->r, r_reverse_x (reader->r, list));
clean:
r_gc_scope_close_and_protect (reader->r, res);
exit:
return res;
}
int
main(int argc, char **argv)
{
typedef enum {
YOW, FETCH, STORE, DELETE, SCAN, REGEXP
} commands;
char opt;
int flags;
int giveusage = 0;
int verbose = 0;
commands what = YOW;
char *comarg[3];
int st_flag = DBM_INSERT;
int argn;
DBM *db;
datum key;
datum content;
flags = O_RDWR;
argn = 0;
while ((opt = getopt(argc, argv, "acdfFm:rstvx")) != ':') {
switch (opt) {
case 'a':
what = SCAN;
break;
case 'c':
flags |= O_CREAT;
break;
case 'd':
what = DELETE;
break;
case 'f':
what = FETCH;
break;
case 'F':
what = REGEXP;
break;
case 'm':
flags &= ~(000007);
if (strcmp(optarg, "r") == 0)
flags |= O_RDONLY;
else if (strcmp(optarg, "w") == 0)
flags |= O_WRONLY;
else if (strcmp(optarg, "rw") == 0)
flags |= O_RDWR;
else {
fprintf(stderr, "Invalid mode: \"%s\"\n", optarg);
giveusage = 1;
}
break;
case 'r':
st_flag = DBM_REPLACE;
break;
case 's':
what = STORE;
break;
case 't':
flags |= O_TRUNC;
break;
case 'v':
verbose = 1;
break;
case 'x':
flags |= O_EXCL;
break;
case '!':
giveusage = 1;
break;
case '?':
if (argn < 3)
comarg[argn++] = optarg;
else {
fprintf(stderr, "Too many arguments.\n");
giveusage = 1;
}
break;
}
}
if (giveusage || what == YOW || argn < 1) {
fprintf(stderr, "Usage: %s database [-m r|w|rw] [-crtx] -a|-d|-f|-F|-s [key [content]]\n", argv[0]);
exit(-1);
}
if ((db = dbm_open(comarg[0], flags, 0777)) == NULL) {
fprintf(stderr, "Error opening database \"%s\"\n", comarg[0]);
exit(-1);
}
if (argn > 1)
key = read_datum(comarg[1]);
if (argn > 2)
content = read_datum(comarg[2]);
switch (what) {
case SCAN:
key = dbm_firstkey(db);
if (dbm_error(db)) {
fprintf(stderr, "Error when fetching first key\n");
goto db_exit;
}
while (key.dptr != NULL) {
content = dbm_fetch(db, key);
if (dbm_error(db)) {
fprintf(stderr, "Error when fetching ");
print_datum(key);
printf("\n");
goto db_exit;
}
print_datum(key);
printf(": ");
print_datum(content);
printf("\n");
if (dbm_error(db)) {
fprintf(stderr, "Error when fetching next key\n");
goto db_exit;
}
key = dbm_nextkey(db);
}
break;
case REGEXP:
if (argn < 2) {
fprintf(stderr, "Missing regular expression.\n");
goto db_exit;
}
if (re_comp(comarg[1])) {
fprintf(stderr, "Invalid regular expression\n");
goto db_exit;
}
key = dbm_firstkey(db);
if (dbm_error(db)) {
fprintf(stderr, "Error when fetching first key\n");
goto db_exit;
}
while (key.dptr != NULL) {
if (re_exec(key2s(key))) {
content = dbm_fetch(db, key);
if (dbm_error(db)) {
fprintf(stderr, "Error when fetching ");
print_datum(key);
printf("\n");
goto db_exit;
}
print_datum(key);
printf(": ");
print_datum(content);
printf("\n");
if (dbm_error(db)) {
fprintf(stderr, "Error when fetching next key\n");
goto db_exit;
}
}
key = dbm_nextkey(db);
}
break;
case FETCH:
if (argn < 2) {
fprintf(stderr, "Missing fetch key.\n");
goto db_exit;
}
content = dbm_fetch(db, key);
if (dbm_error(db)) {
fprintf(stderr, "Error when fetching ");
print_datum(key);
printf("\n");
goto db_exit;
}
if (content.dptr == NULL) {
fprintf(stderr, "Cannot find ");
print_datum(key);
printf("\n");
goto db_exit;
}
print_datum(key);
printf(": ");
print_datum(content);
printf("\n");
break;
case DELETE:
if (argn < 2) {
fprintf(stderr, "Missing delete key.\n");
goto db_exit;
}
if (dbm_delete(db, key) || dbm_error(db)) {
fprintf(stderr, "Error when deleting ");
print_datum(key);
printf("\n");
goto db_exit;
}
if (verbose) {
print_datum(key);
printf(": DELETED\n");
}
break;
case STORE:
if (argn < 3) {
fprintf(stderr, "Missing key and/or content.\n");
goto db_exit;
}
if (dbm_store(db, key, content, st_flag) || dbm_error(db)) {
fprintf(stderr, "Error when storing ");
print_datum(key);
printf("\n");
goto db_exit;
}
if (verbose) {
print_datum(key);
printf(": ");
print_datum(content);
printf(" STORED\n");
}
break;
}
db_exit:
dbm_clearerr(db);
dbm_close(db);
if (dbm_error(db)) {
fprintf(stderr, "Error closing database \"%s\"\n", comarg[0]);
exit(-1);
}
}
void actuarial_table::parse_table()
{
LMI_ASSERT(-1 == table_type_ );
LMI_ASSERT(-1 == min_age_ );
LMI_ASSERT(-1 == max_age_ );
LMI_ASSERT(-1 == select_period_ );
LMI_ASSERT(-1 == max_select_age_);
fs::path data_path(filename_);
data_path = fs::change_extension(data_path, ".dat");
fs::ifstream data_ifs(data_path, ios_in_binary());
if(!data_ifs)
{
fatal_error()
<< "File '"
<< data_path
<< "' is required but could not be found. Try reinstalling."
<< LMI_FLUSH
;
}
data_ifs.seekg(table_offset_, std::ios::beg);
LMI_ASSERT(table_offset_ == data_ifs.tellg());
while(data_ifs)
{
boost::int16_t record_type;
read_datum(data_ifs, record_type, sizeof(boost::int16_t));
soa_table_length_type nominal_length;
read_datum(data_ifs, nominal_length, sizeof(boost::int16_t));
switch(record_type)
{
case 2: // 4-byte integer: Table number.
{
boost::int32_t z;
read_datum(data_ifs, z, nominal_length);
LMI_ASSERT(z == table_number_);
}
break;
case 3: // [unsigned] char: Table type.
{
// Meaning: {A, D, S} --> {age, duration, select}.
// SOA apparently permits upper or lower case.
LMI_ASSERT(-1 == table_type_);
unsigned char z;
read_datum(data_ifs, z, nominal_length);
z = static_cast<unsigned char>(std::toupper(z));
LMI_ASSERT('A' == z || 'D' == z || 'S' == z);
table_type_ = z;
}
break;
case 12: // 2-byte integer: Minimum age.
{
LMI_ASSERT(-1 == min_age_);
boost::int16_t z;
read_datum(data_ifs, z, nominal_length);
LMI_ASSERT(0 <= z && z <= methuselah);
min_age_ = z;
}
break;
case 13: // 2-byte integer: Maximum age.
{
LMI_ASSERT(-1 == max_age_);
boost::int16_t z;
read_datum(data_ifs, z, nominal_length);
LMI_ASSERT(0 <= z && z <= methuselah);
max_age_ = z;
}
break;
case 14: // 2-byte integer: Select period.
{
LMI_ASSERT(-1 == select_period_);
boost::int16_t z;
read_datum(data_ifs, z, nominal_length);
LMI_ASSERT(0 <= z && z <= methuselah);
select_period_ = z;
}
break;
case 15: // 2-byte integer: Maximum select age.
{
LMI_ASSERT(-1 == max_select_age_);
boost::int16_t z;
read_datum(data_ifs, z, nominal_length);
LMI_ASSERT(0 <= z && z <= methuselah);
max_select_age_ = z;
}
break;
case 17: // 8-byte doubles: Table values.
{
read_values(data_ifs, nominal_length);
}
break;
case 9999: // End of table.
{
goto done;
}
default:
{
char skipped[65536];
data_ifs.read(skipped, nominal_length);
}
}
}
done:
LMI_ASSERT(-1 != table_type_ );
LMI_ASSERT(-1 != min_age_ );
LMI_ASSERT(-1 != max_age_ );
LMI_ASSERT(-1 != select_period_ );
LMI_ASSERT(-1 != max_select_age_);
}
static rsexp read_full_list (Reader* reader)
{
rsexp res;
rsexp datum;
res = R_FAILURE;
if (!match (reader, TKN_LP))
goto exit;
if (match (reader, TKN_RP)) {
res = R_NULL;
goto exit;
}
datum = read_datum (reader);
if (r_failure_p (datum)) {
syntax_error (reader, "bad syntax");
goto exit;
}
r_gc_scope_open (reader->r);
ensure_or_goto (res = r_cons (reader->r, datum, R_NULL), clean);
while (TRUE) {
rtokenid id = lookahead (reader)->_id;
if (id == TKN_DOT || id == TKN_RP)
break;
datum = read_datum (reader);
if (r_failure_p (datum)) {
syntax_error (reader, "bad syntax");
res = R_FAILURE;
goto clean;
}
ensure_or_goto (res = r_cons (reader->r, datum, res), clean);
}
res = r_reverse_x (reader->r, res);
if (match (reader, TKN_DOT)) {
datum = read_datum (reader);
if (r_failure_p (datum)) {
syntax_error (reader, "datum expected");
res = R_FAILURE;
goto clean;
}
res = r_append_x (reader->r, res, datum);
}
if (!match (reader, TKN_RP)) {
syntax_error (reader, "missing close parenthesis");
res = R_FAILURE;
}
clean:
r_gc_scope_close_and_protect (reader->r, res);
exit:
return res;
}
