home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / lisp / kcl_tar.z / kcl_tar / c / time.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-06-04  |  1.7 KB  |  100 lines
  1. /*
  2. (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
  3. */
  4.  
  5. /*
  6.     time.c
  7.     DG-SPECIFIC
  8. */
  9.  
  10. #include <include.h>
  11. #include <sysid.h>
  12.  
  13. object siVdefault_time_zone;
  14.  
  15. Lget_decoded_time()
  16. {
  17.     int sec, min, h, d, m, y, dow, work;
  18.  
  19.     check_arg(0);
  20.  
  21.     sys($GTOD, &sec,&min,&h);
  22.     sys($GDAY, &d, &m, &y);
  23.     work = d;
  24.     sys($FDAY, &work, &m, &y);
  25.     dow = (work + 6) % 7 ;
  26.     vs_push(make_fixnum(sec));
  27.     vs_push(make_fixnum(min));
  28.     vs_push(make_fixnum(h));
  29.     vs_push(make_fixnum(d));
  30.     vs_push(make_fixnum(m));
  31.     vs_push(make_fixnum(y + 1900));
  32.     vs_push(make_fixnum(dow));
  33.     vs_push(Cnil);
  34.     vs_push(symbol_value(siVdefault_time_zone));
  35. }
  36.  
  37. Lsleep()
  38. {
  39.     object z;
  40.     
  41.     check_arg(1);
  42.     check_type_or_rational_float(&vs_base[0]);
  43.     if (number_minusp(vs_base[0]) == TRUE)
  44.         FEerror("~S is not a non-negative number.", 1, vs_base[0]);
  45.     Lround();
  46.     z = vs_base[0];
  47.     if (type_of(z) == t_fixnum)
  48.         sleep(fix(z));
  49.     else
  50.         for(;;)
  51.             sleep(1000);
  52.     vs_top = vs_base;
  53.     vs_push(Cnil);
  54. }
  55.  
  56. object
  57. internal_time(flg)
  58. int flg;
  59. {
  60.     int ac0, ac1, ac2;
  61.     int pack[4];
  62.  
  63.     ac0 = -1;
  64.     ac2 = (int)pack;
  65.     sys($RUNTM, &ac0, &ac1, &ac2);
  66.     if (flg)
  67.         return(make_fixnum(pack[1]));
  68.     else
  69.         return(make_fixnum(pack[0] * 1000));
  70. }
  71.  
  72. Lget_internal_run_time()
  73. {
  74.     object z;
  75.  
  76.     check_arg(0);
  77.     z = internal_time(1);
  78.     vs_push(z);
  79. }
  80.  
  81. Lget_internal_real_time()
  82. {
  83.     object z;
  84.  
  85.     check_arg(0);
  86.     z = internal_time(0);
  87.     vs_push(z);
  88. }
  89.  
  90. init_time()
  91. {
  92.     siVdefault_time_zone
  93.     = make_si_special("*DEFAULT-TIME-ZONE*", make_fixnum(TIME_ZONE));
  94.     make_constant("INTERNAL-TIME-UNITS-PER-SECOND", make_fixnum(1000));
  95.     make_function("GET-DECODED-TIME", Lget_decoded_time);
  96.     make_function("SLEEP", Lsleep);
  97.     make_function("GET-INTERNAL-RUN-TIME", Lget_internal_run_time);
  98.     make_function("GET-INTERNAL-REAL-TIME", Lget_internal_real_time);
  99. }
  100.