char* read_file(char* fname){
FILE* f;
char* buf = GC_MALLOC_ATOMIC(8192);
size_t r;
str_list_t* sl = sl_create();
f = fopen(fname, "r");
DFSCH_UNWIND {
if (!f){
dfsch_operating_system_error(dfsch_saprintf("Cannot open file %d",
fname));
}
while (!feof(f)){
r = fread(buf, 1, 8192, f);
if (r != 0){
sl_nappend(sl, buf, r);
buf = GC_MALLOC_ATOMIC(8192);
} else {
if (ferror(f)){
dfsch_operating_system_error(dfsch_saprintf("Error reading file %d",
fname));
}
}
}
} DFSCH_PROTECT {
fclose(f);
} DFSCH_PROTECT_END;
return sl_value(sl);
}
dfsch_object_t* dfsch_read_scm_fd(int f, char* name, dfsch_object_t* eval_env){
char buf[8193];
read_ctx_t ictx;
ssize_t r;
int err=0;
ictx.head = NULL;
dfsch_parser_ctx_t *parser = dfsch_parser_create();
dfsch_parser_callback(parser, read_callback, &ictx);
dfsch_parser_eval_env(parser, eval_env);
while (!err && (r = read(f, buf, 8192))>0){
buf[r]=0;
err = dfsch_parser_feed(parser,buf);
}
if (r<0){
dfsch_operating_system_error("read");
}
if (dfsch_parser_get_level(parser)!=0){
dfsch_error("Syntax error at end of input",
dfsch_make_string_cstr(name));
}
return ictx.head;
}
dfsch_object_t* dfsch_open_file_port(char* filename, char* mode){
FILE* file;
if (mode[0] != 'r' && mode[0] != 'w' && mode[0] != 'a'){ /// XXX
dfsch_error("Invalid file port mode",
dfsch_make_string_cstr(mode));
}
if (mode[1] != 0){
if (mode[1] != '+' && mode[1] != 'b'){
dfsch_error("Invalid file port mode",
dfsch_make_string_cstr(mode));
}
if (mode[2] != 0){
if ((mode[2] != '+' && mode[2] != 'b')
|| (mode[2] == mode[1])
|| (mode[3] != 0)){
dfsch_error("Invalid file port mode",
dfsch_make_string_cstr(mode));
}
}
}
file = fopen(filename, mode);
if (!file){
dfsch_operating_system_error("fopen");
}
return dfsch_make_file_port(file, 1, filename);
}
static void file_port_seek(file_port_t* port, int64_t offset, int whence){
if (!port->open){
dfsch_error("Port is already closed", (dfsch_object_t*)port);
}
if (fseek(port->file, offset, whence) != 0){
dfsch_operating_system_error("fseek");
}
}
static int64_t file_port_tell(file_port_t* port){
off_t ret;
if (!port->open){
dfsch_error("Port is already closed", (dfsch_object_t*)port);
}
ret = ftell(port->file);
if (ret == -1){
dfsch_operating_system_error("ftell");
}
return ret;
}
static void port_write_buf(process_port_t* port,
char*buf, size_t len){
size_t ret;
if (!port->open){
dfsch_error("Port is already closed", port);
}
if (len != 0){
ret = fwrite(buf, len, 1, port->file);
if (ret == 0){
dfsch_operating_system_error("Error writing to process port");
}
}
}
static void file_port_write_buf(file_port_t* port,
char*buf, size_t len){
size_t ret;
if (!port->open){
dfsch_error("Port is closed", (dfsch_object_t*)port);
}
if (len != 0){
ret = fwrite(buf, len, 1, port->file);
if (ret == 0){
dfsch_operating_system_error("fwrite");
}
}
}
void dfsch_load_dsz(dfsch_object_t* env, char* fname, int toplevel){
FILE* f;
int err=0;
int l=0;
dfsch_parser_ctx_t *parser = dfsch_parser_create();
load_thread_info_t* lti = get_load_ti();
load_operation_t this_op;
dfsch_package_t* saved_package = dfsch_get_current_package();
char* source;
f = fopen(fname, "rb");
if (!f){
dfsch_operating_system_error("fopen");
}
dfsch_load_source(env, fname, toplevel, read_dsz(f));
}
dfsch_object_t* dfsch_read_scm(char* scm_name, dfsch_object_t* eval_env){
FILE* f = fopen(scm_name,"r");
char buf[8193];
read_ctx_t ictx;
ssize_t r;
int err=0;
dfsch_object_t *obj;
if (!f){
dfsch_operating_system_error("fopen");
}
obj = dfsch_read_scm_stream(f, scm_name, eval_env);
fclose(f);
return obj;
}
static ssize_t port_read_buf(process_port_t* port,
char* buf, size_t len){
size_t ret;
if (!port->open){
dfsch_error("Port is already closed", port);
}
ret = fread(buf, 1, len, port->file);
if (ret == 0){
if (feof(port->file)){
return 0;
} else {
dfsch_operating_system_error("Error reading from process port");
}
}
return ret;
}
static ssize_t file_port_read_buf(file_port_t* port,
char* buf, size_t len){
size_t ret;
if (!port->open){
dfsch_error("Port is closed", (dfsch_object_t*)port);
}
ret = fread(buf, 1, len, port->file);
if (ret == 0){
if (feof(port->file)){
return 0;
} else {
dfsch_operating_system_error("fread");
}
}
return ret;
}
static int file_port_batch_read(file_port_t* port){
int ch;
if (!port->open){
dfsch_error("Port is already closed", (dfsch_object_t*)port);
}
ch = getc_unlocked(port->file);
if (ch == EOF){
if (feof(port->file)){
return EOF;
} else {
dfsch_operating_system_error("getc_unlocked");
}
}
return ch;
}
DFSCH_DEFINE_PRIMITIVE(encode_universal_time, NULL){
struct tm tm;
time_t t;
DFSCH_LONG_ARG(args, tm.tm_sec);
DFSCH_LONG_ARG(args, tm.tm_min);
DFSCH_LONG_ARG(args, tm.tm_hour);
DFSCH_LONG_ARG(args, tm.tm_mday);
DFSCH_LONG_ARG(args, tm.tm_mon);
DFSCH_LONG_ARG(args, tm.tm_year);
DFSCH_ARG_END(args);
tm.tm_mon -= 1;
tm.tm_year -= 1900;
tm.tm_isdst = -1;
errno = 0;
t = mktime(&tm);
if (t == -1 && errno != 0){
dfsch_operating_system_error("mktime");
}
return dfsch_make_number_from_long(t);
}
static char* read_dsz(FILE* f){
size_t len;
size_t clen;
uint32_t cksum;
unsigned char header_buf[20];
unsigned char trailer_buf[12];
unsigned char trailer_read[12];
char* cbuf;
char* payload;
if (fread(header_buf, 20, 1, f) != 1){
fclose(f);
dfsch_operating_system_error("fread");
}
if (memcmp(header_buf, "DsZ0\r\n\xff\n\0\r\x80\x7f", 12) != 0){
fclose(f);
dfsch_error("Invalid DSZ header", NULL);
}
len = (((size_t)header_buf[12]) << 24)
| (((size_t)header_buf[13]) << 16)
| (((size_t)header_buf[14]) << 8)
| (((size_t)header_buf[15]) << 0);
clen = (((size_t)header_buf[16]) << 24)
| (((size_t)header_buf[17]) << 16)
| (((size_t)header_buf[18]) << 8)
| (((size_t)header_buf[19]) << 0);
cbuf = GC_MALLOC_ATOMIC(clen);
payload = GC_MALLOC_ATOMIC(len);
if (fread(cbuf, clen, 1, f) != 1){
fclose(f);
dfsch_operating_system_error("fread");
}
if (fread(trailer_read, 12, 1, f) != 1){
fclose(f);
dfsch_operating_system_error("fread");
}
fclose(f);
if (uncompress(payload, &len, cbuf, clen) != Z_OK){
dfsch_error("Invalid DSZ payload", NULL);
}
memcpy(trailer_buf, "DsZ!", 4);
cksum = crc32(crc32(0, NULL, 0), payload, len);
trailer_buf[4] = cksum >> 24;
trailer_buf[5] = cksum >> 16;
trailer_buf[6] = cksum >> 8;
trailer_buf[7] = cksum >> 0;
cksum = crc32(crc32(0, NULL, 0), cbuf, clen);
trailer_buf[8] = cksum >> 24;
trailer_buf[9] = cksum >> 16;
trailer_buf[10] = cksum >> 8;
trailer_buf[11] = cksum >> 0;
if (memcmp(trailer_buf, trailer_read, 12) != 0){
dfsch_error("Invalid DSZ trailer", NULL);
}
return payload;
}
