/src/system.c
C | 269 lines | 202 code | 47 blank | 20 comment | 46 complexity | 6a630630d90c19be607d5b5bd1a1eb97 MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.1, JSON, 0BSD
- /*
- * dfsch - dfox's quick and dirty scheme implementation
- * Basic operating system services
- * Copyright (C) 2005-2008 Ales Hakl
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
- *
- */
- #include "internal.h"
- #include "util.h"
- #include <dfsch/dfsch.h>
- #include <dfsch/number.h>
- #include <time.h>
- #ifdef unix
- #include <sys/times.h>
- #endif
- #include <unistd.h>
- #include <limits.h>
- #include <errno.h>
- typedef struct decoded_time_t {
- dfsch_type_t* type;
- struct tm tm;
- } decoded_time_t;
- static int decoded_time_equal_p(decoded_time_t* a, decoded_time_t* b){
- return (a->tm.tm_sec == b->tm.tm_sec)
- && (a->tm.tm_min == b->tm.tm_min)
- && (a->tm.tm_hour == b->tm.tm_hour)
- && (a->tm.tm_mday == b->tm.tm_mday)
- && (a->tm.tm_mon == b->tm.tm_mon)
- && (a->tm.tm_year == b->tm.tm_year)
- && (a->tm.tm_wday == b->tm.tm_wday)
- && (a->tm.tm_yday == b->tm.tm_yday)
- && (a->tm.tm_isdst == b->tm.tm_isdst);
- }
- static void decoded_time_write(decoded_time_t* time,
- dfsch_writer_state_t* state){
- dfsch_write_unreadable(state, (dfsch_object_t*)time,
- "%04d-%02d-%02dT%02d:%02d:%02d",
- time->tm.tm_year+1900, time->tm.tm_mon+1,
- time->tm.tm_mday,
- time->tm.tm_hour, time->tm.tm_min, time->tm.tm_sec);
- }
- static dfsch_object_t* decoded_time_apply(decoded_time_t* time,
- dfsch_object_t* args,
- dfsch_tail_escape_t* esc){
- dfsch_object_t* selector;
- DFSCH_OBJECT_ARG(args, selector);
- DFSCH_ARG_END(args);
- if (dfsch_compare_keyword(selector, "sec")){
- return dfsch_make_number_from_long(time->tm.tm_sec);
- } else if (dfsch_compare_keyword(selector, "min")){
- return dfsch_make_number_from_long(time->tm.tm_min);
- } else if (dfsch_compare_keyword(selector, "hour")){
- return dfsch_make_number_from_long(time->tm.tm_hour);
- } else if (dfsch_compare_keyword(selector, "date")){
- return dfsch_make_number_from_long(time->tm.tm_mday);
- } else if (dfsch_compare_keyword(selector, "month")){
- return dfsch_make_number_from_long(time->tm.tm_mon + 1);
- } else if (dfsch_compare_keyword(selector, "year")){
- return dfsch_make_number_from_long(time->tm.tm_year + 1900);
- } else if (dfsch_compare_keyword(selector, "day")){
- return dfsch_make_number_from_long(time->tm.tm_wday);
- } else if (dfsch_compare_keyword(selector, "year-day")){
- return dfsch_make_number_from_long(time->tm.tm_yday + 1);
- } else if (dfsch_compare_keyword(selector, "dst?")){
- return dfsch_bool(time->tm.tm_isdst == 1);
- }
- dfsch_error("Unknown field requested", selector);
- }
- size_t decoded_time_hash(decoded_time_t* time){
- return time->tm.tm_sec ^ time->tm.tm_min ^ time->tm.tm_hour
- ^ time->tm.tm_yday ^ time->tm.tm_year;
- }
- dfsch_type_t decoded_time_type = {
- DFSCH_STANDARD_TYPE,
- NULL,
- sizeof(decoded_time_t),
- "decoded-time",
- (dfsch_type_equal_p_t)decoded_time_equal_p,
- (dfsch_type_write_t)decoded_time_write,
- (dfsch_type_apply_t)decoded_time_apply,
- (dfsch_type_hash_t)decoded_time_hash
- };
- dfsch_object_t* dfsch_make_decoded_time(){
- return dfsch_make_object(&decoded_time_type);
- }
- struct tm* dfsch_decoded_time_get_tm(dfsch_object_t* time){
- if (DFSCH_TYPE_OF(time) != &decoded_time_type){
- dfsch_error("Not a decoded time", time);
- }
- return &(((decoded_time_t*)time)->tm);
- }
- DFSCH_DEFINE_PRIMITIVE(decode_universal_time, NULL){
- time_t time;
- dfsch_object_t* utc;
- dfsch_object_t* ret;
- DFSCH_LONG_ARG(args, time);
- DFSCH_OBJECT_ARG_OPT(args, utc, NULL);
- DFSCH_ARG_END(args);
- ret = dfsch_make_decoded_time();
- if (utc){
- gmtime_r(&time, dfsch_decoded_time_get_tm(ret));
- } else {
- localtime_r(&time, dfsch_decoded_time_get_tm(ret));
- }
-
- return ret;
- }
- 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);
- }
- DFSCH_DEFINE_PRIMITIVE(get_decoded_time, NULL){
- time_t t;
- dfsch_object_t* utc;
- dfsch_object_t* ret;
- DFSCH_OBJECT_ARG_OPT(args, utc, NULL);
- DFSCH_ARG_END(args);
- ret = dfsch_make_decoded_time();
- t = time(NULL);
- if (utc){
- gmtime_r(&t, dfsch_decoded_time_get_tm(ret));
- } else {
- localtime_r(&t, dfsch_decoded_time_get_tm(ret));
- }
-
- return ret;
- }
- DFSCH_DEFINE_PRIMITIVE(get_universal_time, NULL){
- DFSCH_ARG_END(args);
- return dfsch_make_number_from_long(time(NULL));
- }
- DFSCH_DEFINE_PRIMITIVE(iso_format_time, NULL){
- char t = ' ';
- dfsch_object_t* use_t;
- dfsch_object_t* time;
- struct tm* tm;
- DFSCH_OBJECT_ARG(args, time);
- DFSCH_OBJECT_ARG_OPT(args, use_t, NULL);
- DFSCH_ARG_END(args);
- if (use_t){
- t = 'T';
- }
- tm = dfsch_decoded_time_get_tm(time);
- return dfsch_make_string_cstr(saprintf("%04d-%02d-%02d%c%02d:%02d:%02d",
- tm->tm_year+1900, tm->tm_mon+1,
- tm->tm_mday, t,
- tm->tm_hour, tm->tm_min, tm->tm_sec));
- }
- #ifdef unix
- DFSCH_DEFINE_PRIMITIVE(get_internal_real_time, NULL){
- struct tms t;
- DFSCH_ARG_END(args);
- return dfsch_make_number_from_long(times(&t) & LONG_MAX);
- }
- DFSCH_DEFINE_PRIMITIVE(get_internal_run_time, NULL){
- struct tms t;
- DFSCH_ARG_END(args);
- times(&t);
- return dfsch_make_number_from_long((t.tms_utime + t.tms_stime) & LONG_MAX);
- }
- #endif
- DFSCH_DEFINE_PRIMITIVE(sleep, NULL){
- long time;
- DFSCH_LONG_ARG(args, time);
- DFSCH_ARG_END(args);
- #ifdef __WIN32__
- Sleep(time * 1000); /* Why? :) */
- #else
- sleep(time);
- #endif
- return NULL;
- }
- void dfsch__system_register(dfsch_object_t *ctx){
- dfsch_defcanon_cstr(ctx, "<decoded-time>", &decoded_time_type);
- dfsch_defcanon_cstr(ctx, "decode-universal-time",
- DFSCH_PRIMITIVE_REF(decode_universal_time));
- dfsch_defcanon_cstr(ctx, "encode-universal-time",
- DFSCH_PRIMITIVE_REF(encode_universal_time));
- dfsch_defcanon_cstr(ctx, "get-decoded-time",
- DFSCH_PRIMITIVE_REF(get_decoded_time));
- dfsch_defcanon_cstr(ctx, "get-universal-time",
- DFSCH_PRIMITIVE_REF(get_universal_time));
- dfsch_defcanon_cstr(ctx, "iso-format-time",
- DFSCH_PRIMITIVE_REF(iso_format_time));
- #ifdef unix
- dfsch_defcanon_cstr(ctx, "get-internal-real-time",
- DFSCH_PRIMITIVE_REF(get_internal_real_time));
- dfsch_defcanon_cstr(ctx, "get-internal-run-time",
- DFSCH_PRIMITIVE_REF(get_internal_run_time));
- dfsch_defcanon_cstr(ctx, "internal-time-units-per-second",
- dfsch_make_number_from_long(sysconf(_SC_CLK_TCK)));
- #endif
- dfsch_defcanon_cstr(ctx, "sleep",
- DFSCH_PRIMITIVE_REF(sleep));
- }