home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / clisp / src / archive / clisp.src.lha / src / time.d < prev    next >
Text File  |  1996-04-15  |  39KB  |  1,026 lines
  1. # Zeitmessungsfunktionen für CLISP
  2. # Bruno Haible 22.3.1995
  3.  
  4. #include "lispbibl.c"
  5. #include "arilev0.c"  # für high16, low16 in %%TIME,
  6.                       # für divu in GET-UNIVERSAL-TIME,
  7.                       # für mulu32 in GET-INTERNAL-RUN-TIME, GET-INTERNAL-REAL-TIME
  8.  
  9. # ------------------------------------------------------------------------------
  10. #                          Zeitmessung
  11.  
  12. # Variablen für Zeitmessung:
  13. #ifdef TIME_AMIGAOS
  14.   # (Grundeinheit ist 1/50 sec, ein 32-Bit-Zähler reicht also
  15.   # für 994d 4h 55m 45.92s, und keine LISP-Session dauert 2.7 Jahre.)
  16. #endif
  17. #ifdef TIME_MSDOS
  18.   # (Grundeinheit ist 1/100 sec, ein 32-Bit-Zähler reicht also
  19.   # für 497d 2h 27m 52.96s, und keine LISP-Session dauert 1.3 Jahre.)
  20. #endif
  21. #if defined(TIME_UNIX_TIMES) || defined(TIME_RISCOS)
  22.   # (Grundeinheit ist etwa 1/60 sec oder 1/100 sec, ein 32-Bit-Zähler reicht
  23.   # also eine ganze Weile.)
  24. #endif
  25. #if defined(TIME_UNIX) || defined(TIME_WIN32)
  26.   # Grundeinheit ist 1 µsec.
  27.   # (Egal, ob der Systemtakt nun - abhängig vom lokalen Stromnetz - 60 Hz
  28.   # oder 50 Hz beträgt oder eine genauere Uhr eingebaut ist.)
  29. #endif
  30.   # Zeit, die abläuft:
  31.     local internal_time realstart_time;  # Real-Time beim LISP-Start
  32. #ifndef HAVE_RUN_TIME
  33.   # Zeit, die das LISP insgesamt verbraucht:
  34.     local uintL run_time = 0;       # Runtime bisher insgesamt
  35.     local uintL runstop_time;       # bei laufender Run-Time-Stoppuhr:
  36.                                     # Zeitpunkt des letzten Run/Stop-Wechsels
  37.     local boolean run_flag = FALSE; # /= 0 wenn die Run-Time-Stoppuhr läuft
  38. #endif
  39.  
  40. #ifdef TIME_RELATIVE
  41.  
  42. # UP: greift die aktuelle Zeit ab
  43. # get_time()
  44.  #ifdef TIME_AMIGAOS
  45. # < uintL ergebnis : aktueller Stand des 50Hz-Zählers
  46.   global uintL get_time(void);
  47.   global uintL get_time()
  48.     { var struct DateStamp datestamp;
  49.       begin_system_call();
  50.       DateStamp(&datestamp); # aktuelle Uhrzeit holen
  51.       end_system_call();
  52.       # und in Ticks ab 1.1.1978 00:00:00 umrechnen:
  53.       return ((uintL)(datestamp.ds_Days)*24*60 + (uintL)(datestamp.ds_Minute))
  54.              *60*ticks_per_second + (uintL)(datestamp.ds_Tick);
  55.     }
  56.  #endif
  57.  #ifdef TIME_MSDOS
  58. # < uintL ergebnis : aktueller Stand des 100Hz-Zählers
  59.   global uintL get_time(void);
  60.   #if defined(DJUNIX) && 0 # Vorsicht: das geht eine Stunde nach!!
  61.     global uintL get_time()
  62.       { var struct timeval real_time;
  63.         gettimeofday(&real_time,NULL);
  64.         return (uintL)(real_time.tv_sec) * 100
  65.                + (uintL)((uintW)((uintL)(real_time.tv_usec) / 16) / 625); # tv_usec/10000
  66.       }
  67.   #endif
  68.   #if defined(DJUNIX) || defined(WATCOM) || defined(EMUNIX_OLD_8d) || defined(WINDOWS)
  69.     typedef struct { uintW year;  # Jahr (1980..2099)
  70.                      uintB month; # Monat (1..12)
  71.                      uintB day;   # Tag (1..31)
  72.                      uintB hour;  # Stunde (0..23)
  73.                      uintB min;   # Minute (0..59)
  74.                      uintB sec;   # Sekunde (0..59)
  75.                      uintB hsec;  # Hundertstel Sekunde (0..59)
  76.                    }
  77.             internal_decoded_time;
  78.     local void get_decoded_time (internal_decoded_time* timepoint);
  79.     local void get_decoded_time(timepoint)
  80.       var reg1 internal_decoded_time* timepoint;
  81.       #if defined(DJUNIX) || defined(WATCOM) || (defined(EMUNIX) && defined(WINDOWS))
  82.       { var union REGS in;
  83.         var union REGS out;
  84.         begin_system_call();
  85.         loop
  86.           { # Datum-Teil holen:
  87.             in.regB.ah = 0x2A; # DOS Get Date
  88.             intdos(&in,&out);
  89.             timepoint->year = out.regW.cx;
  90.             timepoint->month = out.regB.dh;
  91.             timepoint->day = out.regB.dl;
  92.             # Uhrzeit-Teil holen:
  93.             in.regB.ah = 0x2C; # DOS Get Time
  94.             intdos(&in,&out);
  95.             timepoint->hour = out.regB.ch;
  96.             timepoint->min = out.regB.cl;
  97.             timepoint->sec = out.regB.dh;
  98.             timepoint->hsec = out.regB.dl;
  99.             # und auf Tageswechsel überprüfen:
  100.             if (!(timepoint->sec == 0)) break;
  101.             if (!(timepoint->min == 0)) break;
  102.             if (!(timepoint->hour == 0)) break;
  103.             in.regB.ah = 0x2A; # DOS Get Date
  104.             intdos(&in,&out);
  105.             if (timepoint->day == out.regB.dl) break;
  106.             # Datum hat sich zwischenzeitlich verändert -> wiederholen
  107.           }
  108.         end_system_call();
  109.       }
  110.       #endif
  111.       #if defined(EMUNIX) && !defined(WINDOWS)
  112.       # [ältere Version für EMX 0.8c, noch ohne ftime(): siehe emx08c-1.d]
  113.       { var struct _dtd datetime;
  114.         # Uhrzeit holen:
  115.         begin_system_call();
  116.         __ftime(&datetime);
  117.         end_system_call();
  118.         # und nach *timepoint umfüllen:
  119.         timepoint->year  = datetime.year;
  120.         timepoint->month = datetime.month;
  121.         timepoint->day   = datetime.day;
  122.         timepoint->hour  = datetime.hour;
  123.         timepoint->min   = datetime.min;
  124.         timepoint->sec   = datetime.sec;
  125.         timepoint->hsec  = datetime.hsec;
  126.       }
  127.       #endif
  128.     global uintL get_time()
  129.       { var internal_decoded_time timepoint;
  130.         get_decoded_time(&timepoint);
  131.        {local var uintW monthoffsets[12] = { # Jahrtag ab dem letzten 1. März
  132.           # Monat  1   2   3  4  5  6  7   8   9   10  11  12
  133.                   306,337, 0,31,61,92,122,153,184,214,245,275,
  134.           };
  135.         var reg1 uintL UTTag;
  136.         timepoint.year -= 1980;
  137.         if (timepoint.month >= 3) { timepoint.year += 1; }
  138.         UTTag = (uintL)timepoint.year * 365 + (uintL)ceiling(timepoint.year,4)
  139.                 + (uintL)monthoffsets[timepoint.month-1] + (uintL)timepoint.day + 3345;
  140.         # Zeitzone mitberücksichtigen??
  141.         return (((UTTag * 24 + (uintL)timepoint.hour)
  142.                         * 60 + (uintL)timepoint.min)
  143.                         * 60 + (uintL)timepoint.sec)
  144.                         * 100 + (uintL)timepoint.hsec;
  145.       }}
  146.   #endif
  147.   #if defined(EMUNIX_NEW_8e) && !defined(WINDOWS)
  148.     global uintL get_time()
  149.       { var struct timeb real_time;
  150.         begin_system_call();
  151.         __ftime(&real_time);
  152.         end_system_call();
  153.         return (uintL)(real_time.time) * ticks_per_second
  154.                + (uintL)((uintW)(real_time.millitm) / (1000/ticks_per_second));
  155.       }
  156.   #endif
  157.  #endif
  158.  #ifdef TIME_UNIX_TIMES
  159. # < uintL ergebnis : aktueller Stand des CLK_TCK Hz - Zählers
  160.   local uintL get_time(void);
  161.   local uintL get_time()
  162.     { var struct tms buffer;
  163.       return (uintL)times(&buffer);
  164.     }
  165.  #endif
  166.  #ifdef TIME_RISCOS
  167. # < uintL ergebnis : aktueller Stand des CLK_TCK Hz - Zählers
  168.   global uintL get_time(void);
  169.   #include <sys/os.h>
  170.   global uintL get_time()
  171.     { var int regs[10];
  172.       var os_error * err;
  173.       begin_system_call();
  174.       err = os_swi(0x42,regs);
  175.       if (err) { __seterr(err); OS_error(); }
  176.       end_system_call();
  177.       return (uintL)(regs[0]);
  178.     }
  179.  #endif
  180.  
  181. #ifndef HAVE_RUN_TIME
  182.  
  183. # UP: Hält die Run-Time-Stoppuhr an
  184. # run_time_stop();
  185.   global void run_time_stop (void);
  186.   global void run_time_stop()
  187.     { if (!run_flag) return; # Run-Time-Stoppuhr ist schon angehalten -> OK
  188.       # zuletzt verbrauchte Run-Time zur bisherigen Run-Time addieren:
  189.       run_time += get_time()-runstop_time;
  190.       run_flag = FALSE; # Run-Time-Stoppuhr steht
  191.     }
  192.  
  193. # UP: Läßt die Run-Time-Stoppuhr weiterlaufen
  194. # run_time_restart();
  195.   global void run_time_restart (void);
  196.   global void run_time_restart()
  197.     { if (run_flag) return; # Run-Time-Stoppuhr läuft schon -> OK
  198.       runstop_time = get_time(); # aktuelle Zeit abspeichern
  199.       run_flag = TRUE; # Run-Time-Stoppuhr läuft
  200.     }
  201.  
  202. #endif
  203.  
  204. # UP: Liefert die Real-Time
  205. # get_real_time()
  206. # < uintL ergebnis: Zeit seit LISP-System-Start (in 1/200 sec bzw. in 1/50 sec bzw. in 1/100 sec bzw. in 1/CLK_TCK sec)
  207.   global uintL get_real_time (void);
  208.   global uintL get_real_time()
  209.     { return get_time()-realstart_time; }
  210.  
  211. #endif
  212.  
  213. #ifdef TIME_UNIX_TIMES
  214.  
  215. # UP: Liefert die Run-Time
  216. # get_run_time(&runtime);
  217. # < internal_time runtime: Run-Time seit LISP-System-Start (in Ticks)
  218. # < uintL ergebnis: wie get_time()
  219.   global uintL get_run_time (internal_time* runtime);
  220.   global uintL get_run_time(runtime)
  221.     var reg1 internal_time* runtime;
  222.     { var struct tms tms;
  223.       var reg2 uintL now_time;
  224.       begin_system_call();
  225.       now_time = times(&tms);
  226.       end_system_call();
  227.       *runtime = tms.tms_utime + tms.tms_stime; # User time + System time
  228.       return now_time; # vgl. get_time()
  229.     }
  230.  
  231. #endif
  232.  
  233. #ifdef TIME_UNIX
  234.  
  235. # UP: Liefert die Real-Time
  236. # get_real_time()
  237. # < internal_time* ergebnis: absolute Zeit
  238.   global internal_time* get_real_time (void);
  239.   global internal_time* get_real_time()
  240.     {
  241.      #ifdef HAVE_GETTIMEOFDAY
  242.       static union { struct timeval tv; internal_time it; } real_time;
  243.       begin_system_call();
  244.       if (!( gettimeofday(&real_time.tv,NULL) ==0)) { OS_error(); }
  245.       end_system_call();
  246.       return &real_time.it;
  247.      #elif defined(HAVE_FTIME)
  248.       static internal_time it;
  249.       var struct timeb timebuf;
  250.       begin_system_call();
  251.       ftime(&timebuf);
  252.       end_system_call();
  253.       it.tv_sec = timebuf.time;
  254.       it.tv_usec = (uintL)(timebuf.millitm) * (ticks_per_second/1000);
  255.       return ⁢
  256.      #endif
  257.     }
  258.  
  259. # UP: Liefert die Run-Time
  260. # get_run_time(&runtime);
  261. # < internal_time runtime: Run-Time seit LISP-System-Start (in Ticks)
  262.   global void get_run_time (internal_time* runtime);
  263.   global void get_run_time(runtime)
  264.     var reg1 internal_time* runtime;
  265.     {
  266.       #if defined(HAVE_GETRUSAGE)
  267.       var struct rusage rusage;
  268.       begin_system_call();
  269.       if (!( getrusage(RUSAGE_SELF,&rusage) ==0)) { OS_error(); }
  270.       end_system_call();
  271.       # runtime = rusage.ru_utime + rusage.ru_stime; # User time + System time
  272.       add_internal_time(rusage.ru_utime,rusage.ru_stime, *runtime);
  273.       #elif defined(HAVE_SYS_TIMES_H)
  274.       var reg2 uintL used_time; # verbrauchte Zeit, gemessen in 1/HZ Sekunden
  275.       var struct tms tms;
  276.       begin_system_call();
  277.       if (times(&tms) == (CLOCK_T)(-1))
  278.         { used_time = 0; } # times scheitert -> used_time unbekannt
  279.         else
  280.         { used_time = tms.tms_utime + tms.tms_stime; } # User time + System time
  281.       end_system_call();
  282.       # in Sekunden und Mikrosekunden umwandeln: # verwende HZ oder CLK_TCK ??
  283.       runtime->tv_sec = floor(used_time,HZ);
  284.       runtime->tv_usec = (used_time % HZ) * floor(2*1000000+HZ,2*HZ);
  285.       #endif
  286.     }
  287.  
  288. #endif
  289.  
  290. #ifdef TIME_WIN32
  291. # UP: Liefert die Run-Time
  292. # get_run_time(&runtime);
  293. # < internal_time runtime: Run-Time seit LISP-System-Start (in Ticks)
  294.   global void get_run_time (internal_time* runtime);
  295.   global void get_run_time(
  296.     var reg1 internal_time* runtime)
  297.     {
  298.       var FILETIME creationft, exitft, kernelft, userft;
  299.       CLISP_LONGLONG total;
  300.       #ifdef ANSI
  301.       var clock_t clocks; # in seconds*CLOCKS_PER_SEC
  302.       #endif
  303.       begin_system_call();
  304.       if (GetProcessTimes(GetCurrentProcess(), &creationft, &exitft,
  305.                                                   &kernelft, &userft))
  306.         { CLISP_LONGLONG user,system;
  307.           end_system_call();
  308.           user = ((CLISP_LONGLONG)userft.dwHighDateTime << 32) + (userft.dwLowDateTime);
  309.           system = ((CLISP_LONGLONG)kernelft.dwHighDateTime << 32) + (kernelft.dwLowDateTime);
  310.           # DIV: milliseconds from 100-nanosecond intervals
  311.           total = (user + system) / 10; 
  312.           }
  313.       # Otherwise, we seem to be running under Windows'95
  314.       #ifdef ANSI   
  315.       # DIV! Microsoft posses ANSI clock()
  316.       else if( (clocks = clock()) != (clock_t)-1 )  # clocks available
  317.         { end_system_call();
  318.           total = (CLISP_LONGLONG)clocks * (1000000/CLOCKS_PER_SEC);
  319.         }
  320.       #endif
  321.       else
  322.         { end_system_call();
  323.           total = 0;
  324.         }
  325.       runtime->tv_sec = (uintL)floor(total,1000000);
  326.       runtime->tv_usec = (uintL)(total % 1000000);
  327.     }
  328.  
  329. # UP: Liefert die Real-Time
  330. # get_real_time()
  331. # < internal_time* ergebnis: absolute Zeit
  332.   global internal_time* get_real_time (void);
  333.   global internal_time* get_real_time()
  334.     {
  335.       static internal_time it;
  336.       SYSTEMTIME st;
  337.       FILETIME ft;
  338.       GetSystemTime(&st);
  339.       SystemTimeToFileTime(&st,&ft);
  340.       { unsigned long long usecs;
  341.         usecs = (unsigned long long)ft.dwHighDateTime << 32;
  342.         usecs |= ft.dwLowDateTime;
  343.         usecs /= 10;   
  344.         it.tv_sec = usecs / 1000000;
  345.         it.tv_usec = usecs % 1000000;
  346.         return ⁢
  347.       }
  348.     }
  349. #endif
  350.  
  351. # UP: Liefert die Run-Time
  352. # get_running_times(×core);
  353. # < timescore.runtime:  Run-Time seit LISP-System-Start (in Ticks)
  354. # < timescore.realtime: Real-Time seit LISP-System-Start (in Ticks)
  355. # < timescore.gctime:   GC-Time seit LISP-System-Start (in Ticks)
  356. # < timescore.gccount:  Anzahl der GC's seit LISP-System-Start
  357. # < timescore.gcfreed:  Größe des von den GC's bisher wiederbeschafften Platzes
  358.   global void get_running_times (timescore*);
  359.   global void get_running_times (tm)
  360.     var reg1 timescore* tm;
  361.     {
  362.      #ifndef HAVE_RUN_TIME
  363.       var reg2 uintL time = get_time();
  364.       tm->realtime = time - realstart_time;
  365.       tm->runtime = (run_flag ?
  366.                       time - runstop_time + run_time : # Run-Time-Stoppuhr läuft noch
  367.                       run_time # Run-Time-Stoppuhr steht
  368.                     );
  369.      #endif
  370.      #if defined(TIME_UNIX) || defined(TIME_WIN32)
  371.       # Real-Time holen:
  372.       var reg2 internal_time* real_time = get_real_time();
  373.       tm->realtime.tv_sec = real_time->tv_sec - realstart_time.tv_sec;
  374.       tm->realtime.tv_usec = real_time->tv_usec;
  375.       # Run-Time holen:
  376.       get_run_time(&tm->runtime);
  377.      #endif
  378.      #ifdef TIME_UNIX_TIMES
  379.       # Run-Time und Real-Time auf einmal holen:
  380.       tm->realtime = get_run_time(&tm->runtime) - realstart_time; # vgl. get_real_time()
  381.      #endif
  382.       tm->gctime = gc_time;
  383.       tm->gccount = gc_count;
  384.       tm->gcfreed = gc_space;
  385.     }
  386.  
  387. #if defined(MSDOS)
  388. # UP: Wandelt das in Decoded-Time um.
  389. # convert_timedate(time,date,&timepoint)
  390. # > uintW time: Uhrzeit
  391. #         Als Word: Bits 15..11: Stunde in {0,...,23},
  392. #                   Bits 10..5:  Minute in {0,...,59},
  393. #                   Bits 4..0:   Sekunde/2 in {0,...,29}.
  394. # > uintW date: Datum
  395. #         Als Word: Bits 15..9: Jahr-1980 in {0,...,119},
  396. #                   Bits 8..5:  Monat in {1,...,12},
  397. #                   Bits 4..0:  Tag in {1,...,31}.
  398. # < timepoint.Sekunden, timepoint.Minuten, timepoint.Stunden,
  399. #   timepoint.Tag, timepoint.Monat, timepoint.Jahr, jeweils als Fixnums
  400.   global void convert_timedate (uintW time, uintW date, decoded_time* timepoint);
  401.   global void convert_timedate(time,date, timepoint)
  402.     var reg2 uintW time;
  403.     var reg2 uintW date;
  404.     var reg1 decoded_time* timepoint;
  405.     { timepoint->Sekunden = fixnum( (time & (bit(5) - 1)) << 1 );
  406.       time = time>>5;
  407.       timepoint->Minuten = fixnum( time & (bit(6) - 1));
  408.       time = time>>6;
  409.       timepoint->Stunden = fixnum( time);
  410.       timepoint->Tag = fixnum( date & (bit(5) - 1));
  411.       date = date>>5;
  412.       timepoint->Monat = fixnum( date & (bit(4) - 1));
  413.       date = date>>4;
  414.       timepoint->Jahr = fixnum( date+1980);
  415.     }
  416. #endif
  417. #ifdef AMIGAOS
  418. # UP: Wandelt das Amiga-Zeitformat in Decoded-Time um.
  419. # convert_time(&datestamp,&timepoint);
  420. # > struct DateStamp datestamp: Uhrzeit
  421. #          datestamp.ds_Days   : Anzahl Tage seit 1.1.1978
  422. #          datestamp.ds_Minute : Anzahl Minuten seit 00:00 des Tages
  423. #          datestamp.ds_Tick   : Anzahl Ticks seit Beginn der Minute
  424. # < timepoint.Sekunden, timepoint.Minuten, timepoint.Stunden,
  425. #   timepoint.Tag, timepoint.Monat, timepoint.Jahr, jeweils als Fixnums
  426.   # include "arilev0.c"  # für Division
  427.   global void convert_time (struct DateStamp * datestamp, decoded_time* timepoint);
  428.   global void convert_time(datestamp,timepoint)
  429.     var reg2 struct DateStamp * datestamp;
  430.     var reg1 decoded_time* timepoint;
  431.     { # Methode:
  432.       # ds_Tick durch ticks_per_second dividieren, liefert Sekunden.
  433.       # ds_Minute durch 60 dividierem liefert Stunden und (als Rest) Minuten.
  434.       # ds_Days in Tag, Monat, Jahr umrechnen:
  435.       #   d := ds_Days - 790; # Tage seit 1.3.1980 (Schaltjahr)
  436.       #   y := floor((4*d+3)/1461); # März-Jahre ab 1.3.1980
  437.       #   d := d - floor(y*1461/4); # Tage ab letztem März-Jahres-Anfang
  438.       #   (Diese Rechnung geht gut, solange jedes vierte Jahr ein Schaltjahr
  439.       #    ist, d.h. bis zum Jahr 2099.)
  440.       #   m := floor((5*d+2)/153); # Monat ab letztem März
  441.       #   d := d - floor((153*m+2)/5); # Tag ab letztem Monatsanfang
  442.       #   m := m+2; if (m>=12) then { m:=m-12; y:=y+1; } # auf Jahre umrechnen
  443.       #   Tag d+1, Monat m+1, Jahr 1980+y.
  444.       {var reg3 uintL sec;
  445.        divu_3216_1616(datestamp->ds_Tick,ticks_per_second,sec=,_EMA_);
  446.        timepoint->Sekunden = fixnum(sec);
  447.       }
  448.       {var reg3 uintL std;
  449.        var reg4 uintL min;
  450.        divu_3216_1616(datestamp->ds_Minute,60,std=,min=);
  451.        timepoint->Minuten = fixnum(min);
  452.        timepoint->Stunden = fixnum(std);
  453.       }
  454.       {var reg5 uintL y;
  455.        var reg4 uintW m;
  456.        var reg3 uintW d;
  457.        divu_3216_1616(4*(datestamp->ds_Days - 424),1461,y=,d=); # y = März-Jahre ab 1.1.1979
  458.        d = floor(d,4); # Tage ab dem letzten März-Jahres-Anfang
  459.        divu_1616_1616(5*d+2,153,m=,d=); # m = Monat ab letztem März
  460.        d = floor(d,5); # Tag ab letztem Monatsanfang
  461.        # m=0..9 -> Monat März..Dezember des Jahres 1979+y,
  462.        # m=10..11 -> Monat Januar..Februar des Jahres 1980+y.
  463.        if (m<10) { m += 12; y -= 1; } # auf Jahre umrechnen
  464.        timepoint->Tag = fixnum(1+(uintL)d);
  465.        timepoint->Monat = fixnum(-9+(uintL)m);
  466.        timepoint->Jahr = fixnum(1980+y);
  467.     } }
  468. #endif
  469. #if defined(UNIX) || defined(MSDOS) || defined(RISCOS) || defined(WIN32_UNIX) || defined(WIN32_DOS)
  470. # UP: Wandelt das System-Zeitformat in Decoded-Time um.
  471. # convert_time(&time,&timepoint);
  472. # > time_t time: Zeit im System-Zeitformat
  473. # < timepoint.Sekunden, timepoint.Minuten, timepoint.Stunden,
  474. #   timepoint.Tag, timepoint.Monat, timepoint.Jahr, jeweils als Fixnums
  475.   global void convert_time (time_t* time, decoded_time* timepoint);
  476.   global void convert_time(time,timepoint)
  477.     var reg3 time_t* time;
  478.     var reg1 decoded_time* timepoint;
  479.     { begin_system_call();
  480.      {var reg2 struct tm * tm = localtime(time); # decodieren
  481.       # (Das Zeitformat des Systems muß auch das System auseinandernehmen.)
  482.       end_system_call();
  483.       if (!(tm==NULL))
  484.         # localtime war erfolgreich
  485.         { timepoint->Sekunden = fixnum(tm->tm_sec);
  486.           timepoint->Minuten  = fixnum(tm->tm_min);
  487.           timepoint->Stunden  = fixnum(tm->tm_hour);
  488.           timepoint->Tag      = fixnum(tm->tm_mday);
  489.           timepoint->Monat    = fixnum(1+tm->tm_mon);
  490.           timepoint->Jahr     = fixnum(1900+tm->tm_year);
  491.         }
  492.         else
  493.         # gescheitert -> verwende 1.1.1900, 00:00:00 als Default
  494.         { timepoint->Sekunden = Fixnum_0;
  495.           timepoint->Minuten  = Fixnum_0;
  496.           timepoint->Stunden  = Fixnum_0;
  497.           timepoint->Tag      = Fixnum_1;
  498.           timepoint->Monat    = Fixnum_1;
  499.           timepoint->Jahr     = fixnum(1900);
  500.         }
  501.     }}
  502. #endif
  503.  
  504. # UP: Initialisiert die Zeitvariablen beim LISP-System-Start.
  505. # init_time();
  506.   global void init_time (void);
  507.   global void init_time()
  508.     {
  509.       # Es ist noch keine GC dagewesen -> hat auch noch keine Zeit verbraucht.
  510.       # gc_count=0;
  511.       # gc_time=0;
  512.       # gc_space=0;
  513.       #ifdef TIME_RELATIVE
  514.       realstart_time = get_time(); # Zeitzähler jetzt, beim Systemstart
  515.       #endif
  516.       #ifndef HAVE_RUN_TIME
  517.       # run_time = 0; # Noch keine Run-Time verbraucht,
  518.       # run_flag = FALSE; # denn System läuft noch nicht.
  519.       run_time_restart(); # Run-Time-Stoppuhr loslaufen lassen
  520.       #endif
  521.       #if defined(TIME_UNIX) || defined(TIME_WIN32)
  522.       realstart_time = *(get_real_time()); # Zeitzähler jetzt, beim Systemstart
  523.       #endif
  524.       #ifdef TIME_RELATIVE
  525.       # Start-Zeit holen und merken:
  526.       { var decoded_time timepoint;
  527.         #ifdef AMIGAOS
  528.         { var struct DateStamp datestamp; # aktuelle Uhrzeit
  529.           DateStamp(&datestamp);
  530.           convert_time(&datestamp,&timepoint); # in Decoded-Time umwandeln
  531.         }
  532.         #endif
  533.         #if defined(DJUNIX) && 0 # das geht eine Stunde nach!!
  534.         { var struct timeval real_time;
  535.           gettimeofday(&real_time,NULL); # aktuelle Uhrzeit
  536.           convert_time(&real_time.tv_sec,&timepoint); # in Decoded-Time umwandeln
  537.         }
  538.         #endif
  539.         #if defined(DJUNIX) || defined(WATCOM) || defined(EMUNIX_OLD_8d) || defined(WINDOWS)
  540.         { var internal_decoded_time idt;
  541.           get_decoded_time(&idt);
  542.           timepoint.Sekunden = fixnum(idt.sec);
  543.           timepoint.Minuten  = fixnum(idt.min);
  544.           timepoint.Stunden  = fixnum(idt.hour);
  545.           timepoint.Tag      = fixnum(idt.day);
  546.           timepoint.Monat    = fixnum(idt.month);
  547.           timepoint.Jahr     = fixnum(idt.year);
  548.         }
  549.         #endif
  550.         #if defined(EMUNIX_NEW_8e) && !defined(WINDOWS)
  551.         { var struct timeb real_time;
  552.           begin_system_call();
  553.           __ftime(&real_time); # aktuelle Uhrzeit
  554.           end_system_call();
  555.           convert_time(&real_time.time,&timepoint); # in Decoded-Time umwandeln
  556.         }
  557.         #endif
  558.         #if defined(UNIX) || defined(RISCOS) # TIME_UNIX_TIMES || TIME_RISCOS
  559.         { var time_t real_time;
  560.           begin_system_call();
  561.           time(&real_time); # aktuelle Uhrzeit
  562.           end_system_call();
  563.           convert_time(&real_time,&timepoint); # in Decoded-Time umwandeln
  564.         }
  565.         #endif
  566.         set_start_time(&timepoint); # Start-Zeit merken
  567.       }
  568.       #endif
  569.     }
  570.  
  571. # ------------------------------------------------------------------------------
  572. #                            Zeitfunktionen
  573.  
  574. #ifdef TIME_AMIGAOS
  575.   # Ein kleineres Bug:
  576.   # - Wrap-Around der Uhrzeit nach 2.7 Jahren.
  577.   # Decoded Time =
  578.   #   Sekunde, Minute, Stunde, Tag, Monat, Jahr, Wochentag, Sommerzeit, Zeitzone
  579.   # Universal Time =
  580.   #   Sekunden seit 1.1.1900
  581.   # Internal Time =
  582.   #   50stel Sekunden seit LISP-System-Start
  583. #endif
  584. #ifdef TIME_MSDOS
  585.   # Ein kleineres Bug:
  586.   # - Wrap-Around der Uhrzeit nach 1.36 Jahren.
  587.   # Decoded Time =
  588.   #   Sekunde, Minute, Stunde, Tag, Monat, Jahr, Wochentag, Sommerzeit, Zeitzone
  589.   # Universal Time =
  590.   #   Sekunden seit 1.1.1900
  591.   # Internal Time =
  592.   #   100stel Sekunden seit LISP-System-Start
  593. #endif
  594. #if defined(TIME_UNIX_TIMES) || defined(TIME_RISCOS)
  595.   # Zwei kleinere Bugs:
  596.   # - Wrap-Around der Uhrzeit nach vielen Tagen,
  597.   # - LISP-Uhr geht um max. 1 Sekunde nach gegenüber der wahren Uhr.
  598.   # Decoded Time =
  599.   #   Sekunde, Minute, Stunde, Tag, Monat, Jahr, Wochentag, Sommerzeit, Zeitzone
  600.   # Universal Time =
  601.   #   Sekunden seit 1.1.1900
  602.   # Internal Time =
  603.   #   CLK_TCK-stel Sekunden seit LISP-System-Start
  604. #endif
  605. #if defined(TIME_UNIX) || defined(TIME_WIN32)
  606.   # Ein kleineres Bug:
  607.   # - %%TIME funktioniert nur für Zeitdifferenzen <= 194 Tagen.
  608.   # Decoded Time =
  609.   #   Sekunde, Minute, Stunde, Tag, Monat, Jahr, Wochentag, Sommerzeit, Zeitzone
  610.   # Universal Time =
  611.   #   Sekunden seit 1.1.1900
  612.   # Internal Time =
  613.   #   Mikrosekunden seit LISP-System-Start
  614. #endif
  615.  
  616. #ifdef TIME_RELATIVE
  617.  
  618. # Uhrzeit und Datum beim LISP-Start:
  619.   local decoded_time realstart_datetime;
  620.  
  621. # UP: Berechnet die Uhrzeit beim LISP-System-Start als Universal Time.
  622. # calc_start_UT(&timepoint)
  623. # > decoded_time timepoint: Zeit beim LISP-System-Start
  624. # < ergebnis: Universal Time
  625. # kann GC auslösen
  626.   local object calc_start_UT (decoded_time* timepoint);
  627.   local object calc_start_UT(timepoint)
  628.     var reg1 decoded_time* timepoint;
  629.     { # (ENCODE-UNIVERSAL-TIME Sekunden Minuten Stunden Tag Monat Jahr) ausführen:
  630.       pushSTACK(timepoint->Sekunden);
  631.       pushSTACK(timepoint->Minuten);
  632.       pushSTACK(timepoint->Stunden);
  633.       pushSTACK(timepoint->Tag);
  634.       pushSTACK(timepoint->Monat);
  635.       pushSTACK(timepoint->Jahr);
  636.       funcall(S(encode_universal_time),6);
  637.       # als Start-Universal-Time abspeichern:
  638.       return O(start_UT) = value1;
  639.     }
  640.  
  641. # UP: Merkt sich die Uhrzeit beim LISP-System-Start.
  642. # set_start_time(&timepoint);
  643. # > timepoint: Zeit beim LISP-System-Start
  644. # >   timepoint.Sekunden in {0,...,59},
  645. # >   timepoint.Minuten in {0,...,59},
  646. # >   timepoint.Stunden in {0,...,23},
  647. # >   timepoint.Tag in {1,...,31},
  648. # >   timepoint.Monat in {1,...,12},
  649. # >   timepoint.Jahr in {1980,...,2999},
  650. # >   jeweils als Fixnums.
  651. # kann GC auslösen
  652.   global void set_start_time (decoded_time* timepoint);
  653.   global void set_start_time(timepoint)
  654.     var reg1 decoded_time* timepoint;
  655.     { # Start-Zeit merken:
  656.       realstart_datetime = *timepoint;
  657.       # und, wenn möglich, gleich in Universal Time umwandeln:
  658.       if (!eq(Symbol_function(S(encode_universal_time)),unbound))
  659.         # Ist ENCODE-UNIVERSAL-TIME definiert -> sofort in UT umwandeln:
  660.         { calc_start_UT(timepoint); }
  661.     }
  662.  
  663. #endif
  664.  
  665. # Liefert die Uhrzeit in Sekunden (seit Systemstart bzw. 1.1.1900) als uintL.
  666.   local uintL real_time_sec (void);
  667.   local uintL real_time_sec()
  668.     {
  669.      #ifdef TIME_1
  670.       var reg2 uintL real_time = get_real_time();
  671.       # real_time := floor(real_time,ticks_per_second) :
  672.       #if (ticks_per_second == 1000000UL)
  673.         divu_3216_3216(real_time>>6,ticks_per_second>>6,real_time=,_EMA_);
  674.       #elif (ticks_per_second < bit(16))
  675.         divu_3216_3216(real_time,ticks_per_second,real_time=,_EMA_);
  676.       #else
  677.         divu_3232_3232(real_time,ticks_per_second,real_time=,_EMA_);
  678.       #endif
  679.      #endif
  680.      #ifdef TIME_2
  681.       var reg2 uintL real_time = (get_real_time())->tv_sec; # Sekunden
  682.       #if defined(TIME_UNIX) || defined(TIME_WIN32)
  683.       # real_time sind Sekunden seit 1.1.1970
  684.       real_time = 2208988800UL+real_time; # 25567*24*60*60 Sekunden zwischen 1.1.1900 und 1.1.1970
  685.       #endif
  686.      #endif
  687.      return real_time;
  688.     }
  689.  
  690. LISPFUNN(get_universal_time,0)
  691. # (get-universal-time), CLTL S. 445
  692. #ifdef TIME_RELATIVE
  693.   # (defun get-universal-time ()
  694.   #   (+ (sys::get-start-time)
  695.   #      (floor (get-internal-real-time) internal-time-units-per-second)
  696.   # ) )
  697.   { var reg1 object start_time = O(start_UT);
  698.     if (nullp(start_time)) # Start-Universal-Time noch NIL ?
  699.       # nein -> schon berechnet.
  700.       # ja -> jetzt erst berechnen:
  701.       { start_time = calc_start_UT(&realstart_datetime); }
  702.     # start_time = die Uhrzeit des LISP-System-Starts in Universal Time.
  703.     pushSTACK(start_time);
  704.     pushSTACK(UL_to_I(real_time_sec())); # Sekunden seit Systemstart
  705.     funcall(L(plus),2); # addieren
  706.   }
  707. #endif
  708. #ifdef TIME_ABSOLUTE
  709.   { value1 = UL_to_I(real_time_sec()); mv_count=1; }
  710. #endif
  711.  
  712. #if defined(UNIX) || defined(WIN32_UNIX)
  713. LISPFUN(default_time_zone,0,1,norest,nokey,0,NIL)
  714. # (sys::default-time-zone) liefert die aktuelle Zeitzone.
  715. # (sys::default-time-zone UTstunde) liefert die aktuelle Zeitzone zu einem
  716. # bestimmten Zeitpunkt.
  717. # 1. Wert: Zeitzone mit Sommerzeit-Berücksichtigung.
  718. # 2. Wert: Sommerzeit-p.
  719.   { # Da die Zeitzone oft per TZ-Environment-Variable einstellbar ist, wird
  720.     # sie häufig außerhalb des Kernels verwaltet. Man hat nur per localtime()
  721.     # und gmtime() Zugriff auf sie.
  722.     # Methode:
  723.     #   Zeitzone = (gmtime(t) - localtime(t))/3600.
  724.     #   Sommerzeit-p wird dem Ergebnis von localtime(t) entnommen.
  725.     var reg4 object arg = popSTACK();
  726.     var time_t now;
  727.     if (posfixnump(arg)
  728.         && (posfixnum_to_L(arg) > 613608) # arg > 1.1.1970
  729.         && (posfixnum_to_L(arg) < 1314888) # arg < 1.1.2050
  730.        )
  731.       # bestimmter Zeitpunkt
  732.       # Annahme: time_t ist die Anzahl der Sekunden seit 1.1.1970. ??
  733.       { now = (posfixnum_to_L(arg) - 613608) * 3600; }
  734.       else
  735.       # jetzt
  736.       { begin_system_call(); time(&now); end_system_call(); }
  737.     { var struct tm now_local;
  738.       var struct tm now_gm;
  739.       begin_system_call();
  740.       now_local = *(localtime(&now));
  741.       now_gm = *(gmtime(&now));
  742.       end_system_call();
  743.       # secondswest = mktime(now_gm) - mktime(now_local); wäre schön.
  744.       # mktime() ist allerdings nicht weit verbreitet. Unter SunOS4 müßte man
  745.       # timegm() nehmen. Daher tun wir's selber:
  746.      {var reg5 sintL dayswest = # Tage-Differenz, kann als 0,1,-1 angenommen werden
  747.         (now_gm.tm_year < now_local.tm_year ? -1 :
  748.          now_gm.tm_year > now_local.tm_year ? 1 :
  749.          (now_gm.tm_mon < now_local.tm_mon ? -1 :
  750.           now_gm.tm_mon > now_local.tm_mon ? 1 :
  751.           (now_gm.tm_mday < now_local.tm_mday ? -1 :
  752.            now_gm.tm_mday > now_local.tm_mday ? 1 :
  753.            0
  754.         )));
  755.       var reg3 sintL hourswest = 24*dayswest + (sintL)(now_gm.tm_hour - now_local.tm_hour);
  756.       var reg2 sintL minuteswest = 60*hourswest + (sintL)(now_gm.tm_min - now_local.tm_min);
  757.       var reg1 sintL secondswest = 60*minuteswest + (sintL)(now_gm.tm_sec - now_local.tm_sec);
  758.       # Zeitzone in Stunden = (Zeitzone in Sekunden / 3600) :
  759.       pushSTACK(L_to_I(secondswest));
  760.       pushSTACK(fixnum(3600));
  761.       funcall(L(durch),2);
  762.       # Sommerzeit-p entnehmen:
  763.       # tm_isdst < 0 bedeutet "unbekannt"; wir nehmen an, keine Sommerzeit.
  764.       value2 = (now_local.tm_isdst > 0 ? T : NIL);
  765.       mv_count=2;
  766.   } }}
  767. #endif
  768.  
  769. LISPFUNN(get_internal_run_time,0)
  770. # (GET-INTERNAL-RUN-TIME), CLTL S. 446
  771.   { var timescore tm;
  772.     get_running_times(&tm); # Run-Time seit LISP-System-Start abfragen
  773.    #ifdef TIME_1
  774.     value1 = UL_to_I(tm.runtime); mv_count=1; # in Integer umwandeln
  775.    #endif
  776.    #ifdef TIME_2
  777.     { var reg1 internal_time* tp = &tm.runtime; # Run-Time
  778.       # in Mikrosekunden umwandeln: tp->tv_sec * ticks_per_second + tp->tv_usec
  779.       #ifdef intQsize
  780.       value1 = UQ_to_I((uintQ)(tp->tv_sec) * ticks_per_second + (uintQ)(tp->tv_usec));
  781.       #else
  782.       {var reg3 uintL run_time_hi;
  783.        var reg2 uintL run_time_lo;
  784.        mulu32(tp->tv_sec,ticks_per_second, run_time_hi=,run_time_lo=);
  785.        if ((run_time_lo += tp->tv_usec) < tp->tv_usec) { run_time_hi += 1; }
  786.        value1 = L2_to_I(run_time_hi,run_time_lo);
  787.       }
  788.       #endif
  789.       mv_count=1;
  790.     }
  791.    #endif
  792.   }
  793.  
  794. LISPFUNN(get_internal_real_time,0)
  795. # (GET-INTERNAL-REAL-TIME), CLTL S. 446
  796. #ifdef TIME_1
  797.   { value1 = UL_to_I(get_real_time()); # Real-Time seit LISP-System-Start, als Integer
  798.     mv_count=1;
  799.   }
  800. #endif
  801. #ifdef TIME_2
  802.   { var reg1 internal_time* tp = get_real_time(); # Real-Time absolut
  803.     # in Mikrosekunden umwandeln: tp->tv_sec * ticks_per_second + tp->tv_usec
  804.     #ifdef intQsize
  805.     value1 = UQ_to_I((uintQ)(tp->tv_sec) * ticks_per_second + (uintQ)(tp->tv_usec));
  806.     #else
  807.     {var reg3 uintL real_time_hi;
  808.      var reg2 uintL real_time_lo;
  809.      mulu32(tp->tv_sec,ticks_per_second, real_time_hi=,real_time_lo=);
  810.      if ((real_time_lo += tp->tv_usec) < tp->tv_usec) { real_time_hi += 1; }
  811.      value1 = L2_to_I(real_time_hi,real_time_lo);
  812.     }
  813.     #endif
  814.     mv_count=1;
  815.   }
  816. #endif
  817.  
  818. #ifdef SLEEP_1
  819. LISPFUNN(sleep,1)
  820. #if defined(TIME_MSDOS) || defined(RISCOS)
  821. # (SYSTEM::%SLEEP delay) wartet delay/200 bzw. delay/100 Sekunden.
  822. # Argument delay muß ein Integer >=0, <2^32 (TIME_MSDOS: sogar <2^31) sein.
  823.   { var reg2 uintL delay = I_to_UL(popSTACK()); # Pausenlänge
  824.     #ifdef EMUNIX_PORTABEL
  825.     #ifdef EMUNIX_OLD_8e
  826.     if (!(_osmode == DOS_MODE))
  827.     #else
  828.     if (TRUE)
  829.     #endif
  830.       # Unter OS/2 (Multitasking!) nicht CPU-Zeit verbraten!
  831.       # select erlaubt eine wunderschöne Implementation von usleep():
  832.       { loop
  833.           { var reg4 uintL start_time = get_real_time();
  834.             { var struct timeval timeout; # Zeitintervall
  835.               divu_3216_3216(delay,ticks_per_second, timeout.tv_sec =, timeout.tv_usec = 1000000/ticks_per_second * (uintL) );
  836.               begin_system_call();
  837.              {var reg1 int ergebnis = select(FD_SETSIZE,NULL,NULL,NULL,&timeout);
  838.               end_system_call();
  839.               if ((ergebnis<0) && !(errno==EINTR)) { OS_error(); }
  840.             }}
  841.             interruptp( { pushSTACK(S(sleep)); tast_break(); } ); # evtl. Break-Schleife aufrufen
  842.            {var reg3 uintL end_time = get_real_time();
  843.             var reg1 uintL slept = end_time - start_time; # so lang haben wir geschlafen
  844.             # Haben wir genug geschlafen?
  845.             if (slept >= delay) break;
  846.             # Wie lange müssen wir noch schlafen?
  847.             delay -= slept;
  848.           }}
  849.       }
  850.       else
  851.     #endif
  852.     { var reg1 uintL endtime = get_real_time() + delay; # zur momentanen Real-Time addieren,
  853.       # ergibt Zeit, bis zu der zu warten ist.
  854.       # warten, bis die Real-Time bei endtime angelangt ist:
  855.       # (Attention: the MSDOS clock always advances 5 or 6 ticks at a time!)
  856.       do {} until ((sintL)(get_real_time()-endtime) >= 0);
  857.     }
  858.     value1 = NIL; mv_count=1; # 1 Wert NIL
  859.   }
  860. #endif
  861. #ifdef TIME_AMIGAOS
  862. # (SYSTEM::%SLEEP delay) wartet delay/50 Sekunden.
  863. # Argument delay muß ein Integer >=0, <2^32 sein.
  864.   { var reg2 uintL delay = I_to_UL(popSTACK()); # Pausenlänge
  865.     if (delay>0) { begin_system_call(); Delay(delay); end_system_call(); }
  866.     value1 = NIL; mv_count=1; # 1 Wert NIL
  867.   }
  868. #endif
  869. #endif
  870. #ifdef SLEEP_2
  871. #ifdef TIME_UNIX_TIMES
  872. # Ein sehr unvollkommener Ersatz für die gettimeofday-Funktion.
  873. # Taugt nur für die Messung von Zeitdifferenzen!
  874.   local int gettimeofday (struct timeval * tp, void* tzp);
  875.   local int gettimeofday(tp,tzp)
  876.     var reg2 struct timeval * tp;
  877.     var void* tzp;
  878.     { if (!(tp==NULL))
  879.         { var reg1 uintL realtime = get_real_time();
  880.           # in Sekunden und Mikrosekunden umwandeln:
  881.           tp->tv_sec = floor(realtime,ticks_per_second);
  882.           tp->tv_usec = (realtime % ticks_per_second) * floor(2*1000000+ticks_per_second,2*ticks_per_second);
  883.         }
  884.       return 0;
  885.     }
  886. #endif
  887. LISPFUNN(sleep,2)
  888. #if defined(TIME_UNIX) || defined(TIME_UNIX_TIMES)
  889. # (SYSTEM::%SLEEP delay-seconds delay-useconds) wartet
  890. # delay-seconds Sekunden und delay-useconds Mikrosekunden.
  891. # Argument delay-seconds muß ein Fixnum >=0, <=16700000 sein,
  892. # Argument delay-useconds muß ein Fixnum >=0, <=1000000 sein.
  893.   { var reg3 uintL useconds = posfixnum_to_L(popSTACK());
  894.     var reg2 uintL seconds = posfixnum_to_L(popSTACK());
  895.     begin_system_call();
  896.     loop
  897.       { var struct timeval start_time;
  898.         var struct timeval end_time;
  899.         if (!( gettimeofday(&start_time,NULL) ==0)) { OS_error(); }
  900.         #ifdef HAVE_SELECT
  901.           # select erlaubt eine wunderschöne Implementation von usleep():
  902.           { var struct timeval timeout; # Zeitintervall
  903.             timeout.tv_sec = seconds; timeout.tv_usec = useconds;
  904.            {var reg1 int ergebnis;
  905.             ergebnis = select(FD_SETSIZE,NULL,NULL,NULL,&timeout);
  906.             if ((ergebnis<0) && !(errno==EINTR)) { OS_error(); }
  907.           }}
  908.         #else
  909.           if (seconds>0) { sleep(seconds); }
  910.           #ifdef HAVE_USLEEP
  911.           if (useconds>0) { usleep(useconds); }
  912.           #endif
  913.         #endif
  914.         interruptp(
  915.           { end_system_call();
  916.             pushSTACK(S(sleep)); tast_break(); # evtl. Break-Schleife aufrufen
  917.             begin_system_call();
  918.           });
  919.         if (!( gettimeofday(&end_time,NULL) ==0)) { OS_error(); }
  920.        {# Überprüfen, ob wir genügend lang geschlafen haben, oder ob
  921.         # wir wegen eines Signals zu früh aufgeweckt wurden:
  922.         var struct timeval slept; # so lang haben wir geschlafen
  923.         # sozusagen sub_internal_time(end_time,start_time, slept);
  924.         slept.tv_sec = end_time.tv_sec - start_time.tv_sec;
  925.         if (end_time.tv_usec < start_time.tv_usec)
  926.           { end_time.tv_usec += 1000000; slept.tv_sec -= 1; }
  927.         slept.tv_usec = end_time.tv_usec - start_time.tv_usec;
  928.         # Haben wir genug geschlafen?
  929.         if ((slept.tv_sec > seconds)
  930.             || ((slept.tv_sec == seconds) && (slept.tv_usec >= useconds))
  931.            )
  932.           break;
  933.         # Wie lange müssen wir noch schlafen?
  934.         seconds -= slept.tv_sec;
  935.         if (useconds < slept.tv_usec) { seconds -= 1; useconds += 1000000; }
  936.         useconds -= slept.tv_usec;
  937.         #if !defined(HAVE_SELECT) && !defined(HAVE_USLEEP)
  938.         if (seconds==0) break; # CPU-Zeit fressende Warteschleife vermeiden
  939.         #endif
  940.       }}
  941.     end_system_call();
  942.     value1 = NIL; mv_count=1; # 1 Wert NIL
  943.   }
  944. #elif defined(TIME_WIN32)
  945.   { var reg3 uintL useconds = posfixnum_to_L(popSTACK());
  946.     var reg2 uintL seconds = posfixnum_to_L(popSTACK());
  947.     begin_system_call();
  948.     Sleep(seconds*1000+useconds/1000);
  949.     end_system_call();
  950.     value1 = NIL; mv_count=1;
  951.   }
  952. #endif
  953. #endif
  954.  
  955. LISPFUNN(time,0)
  956. # (SYSTEM::%%TIME) liefert den bisherigen Time/Space-Verbrauch, ohne selbst
  957. # Platz anzufordern (und damit eventuell selbst eine GC zu verursachen).
  958. # 9 Werte:
  959. #   Real-Time (Zeit seit Systemstart) in 2 Werten,
  960. #   Run-Time (verbrauchte Zeit seit Systemstart) in 2 Werten,
  961. #   GC-Time (durch GC verbrauchte Zeit seit Systemstart) in 2 Werten,
  962. #   #ifdef TIME_AMIGAOS
  963. #     jeweils in 50stel Sekunden,
  964. #     jeweils (ldb (byte 16 16) time) und (ldb (byte 16 0) time).
  965. #   #endif
  966. #   #ifdef TIME_MSDOS
  967. #     jeweils in 100stel Sekunden,
  968. #     jeweils (ldb (byte 16 16) time) und (ldb (byte 16 0) time).
  969. #   #endif
  970. #   #if defined(TIME_UNIX_TIMES) || defined(TIME_RISCOS)
  971. #     jeweils in CLK_TCK-stel Sekunden,
  972. #     jeweils (ldb (byte 16 16) time) und (ldb (byte 16 0) time).
  973. #   #endif
  974. #   #ifdef TIME_UNIX
  975. #     jeweils in Mikrosekunden, jeweils ganze Sekunden und Mikrosekunden.
  976. #   #endif
  977. #   #ifdef TIME_WIN32
  978. #     jeweils in Mikrosekunden, jeweils ganze Sekunden und Mikrosekunden.
  979. #   #endif
  980. #   Space (seit Systemstart verbrauchter Platz, in Bytes)
  981. #     in 2 Werten: (ldb (byte 24 24) Space), (ldb (byte 24 0) Space).
  982. #   GC-Count (Anzahl der durchgeführten Garbage Collections).
  983.   { var timescore tm;
  984.     get_running_times(&tm); # Run-Time abfragen
  985.     #ifdef TIME_1
  986.       #define as_2_values(time)  \
  987.         pushSTACK(fixnum(high16(time))); \
  988.         pushSTACK(fixnum(low16(time)));
  989.     #endif
  990.     #ifdef TIME_2
  991.       #define as_2_values(time)  \
  992.         pushSTACK(fixnum(time.tv_sec)); \
  993.         pushSTACK(fixnum(time.tv_usec));
  994.     #endif
  995.     as_2_values(tm.realtime); # erste zwei Werte: Real-Time
  996.     as_2_values(tm.runtime); # nächste zwei Werte: Run-Time
  997.     as_2_values(tm.gctime); # nächste zwei Werte: GC-Time
  998.     # nächste zwei Werte: Space
  999.     # tm.gcfreed = von der GC bisher wieder verfügbar gemachter Platz
  1000.     {var reg1 uintL used = used_space(); # momentan belegter Platz
  1001.      # beides addieren:
  1002.      #ifdef intQsize
  1003.      tm.gcfreed += used;
  1004.      #else
  1005.      if ((tm.gcfreed.lo += used) < used) { tm.gcfreed.hi += 1; }
  1006.      #endif
  1007.     }
  1008.     # Jetzt ist tm.gcfreed = bisher insgesamt verbrauchter Platz
  1009.     #if (oint_data_len<24)
  1010.       #error "Funktion SYS::%%TIME anpassen!"
  1011.     #endif
  1012.     # In 24-Bit-Stücke zerhacken:
  1013.     #ifdef intQsize
  1014.     pushSTACK(fixnum( (tm.gcfreed>>24) & (bit(24)-1) ));
  1015.     pushSTACK(fixnum( tm.gcfreed & (bit(24)-1) ));
  1016.     #else
  1017.     pushSTACK(fixnum( ((tm.gcfreed.hi << 8) + (tm.gcfreed.lo >> 24)) & (bit(24)-1) ));
  1018.     pushSTACK(fixnum( tm.gcfreed.lo & (bit(24)-1) ));
  1019.     #endif
  1020.     # letzter Wert: GC-Count
  1021.     pushSTACK(fixnum(tm.gccount));
  1022.     funcall(L(values),9); # 9 Werte produzieren
  1023.   }
  1024.  
  1025.  
  1026.