# Diverse Funktionen für CLISP
# Bruno Haible 12.12.1994

#include "lispbibl.c"
#include "arilev0.c"  # für high16, low16 in %%TIME,
                      # für divu in GET-UNIVERSAL-TIME,
                      # für mulu32 in GET-INTERNAL-RUN-TIME, GET-INTERNAL-REAL-TIME


# Eigenwissen:

LISPFUNN(lisp_implementation_type,0)
# (LISP-IMPLEMENTATION-TYPE), CLTL S. 447
  { value1 = O(lisp_implementation_type_string); mv_count=1; }

LISPFUNN(lisp_implementation_version,0)
# (LISP-IMPLEMENTATION-VERSION), CLTL S. 447
  { value1 = OL(lisp_implementation_version_string); mv_count=1; }

LISPFUN(version,0,1,norest,nokey,0,NIL)
# (SYSTEM::VERSION) liefert die Version des Runtime-Systems,
# (SYSTEM::VERSION version) überprüft (am Anfang eines FAS-Files),
# ob die Versionen des Runtime-Systems übereinstimmen.
  { var reg1 object arg = popSTACK();
    if (eq(arg,unbound))
      { value1 = O(version); mv_count=1; }
      else
      { if (equal(arg,O(version)))
          { value1 = NIL; mv_count=0; }
          else
          { fehler(error,
                   DEUTSCH ? "Dieses File stammt von einer anderen Lisp-Version, muß neu compiliert werden." :
                   ENGLISH ? "This file was produced by another lisp version, must be recompiled." :
                   FRANCAIS ? "Ce fichier provient d'une autre version de LISP et doit être recompilé." :
                   ""
                  );
  }   }   }

#ifdef MACHINE_KNOWN

LISPFUNN(machinetype,0)
# (MACHINE-TYPE), CLTL S. 447
  { var reg1 object erg = O(machine_type_string);
    if (nullp(erg)) # noch unbekannt?
      { # ja -> holen
        #ifdef HAVE_SYS_UTSNAME_H
        var struct utsname utsname;
        begin_system_call();
        if ( uname(&utsname) <0) { OS_error(); }
        end_system_call();
        pushSTACK(asciz_to_string(&!utsname.machine));
        funcall(L(nstring_upcase),1); # in Großbuchstaben umwandeln
        erg = value1;
        #else
        # Betriebssystem-Kommando 'arch' ausführen und dessen Output
        # in einen String umleiten:
        # (string-upcase
        #   (with-open-stream (stream (make-pipe-input-stream "/bin/arch"))
        #     (read-line stream nil nil)
        # ) )
        pushSTACK(asciz_to_string("/bin/arch"));
        funcall(L(make_pipe_input_stream),1); # (MAKE-PIPE-INPUT-STREAM "/bin/arch")
        pushSTACK(value1); # Stream retten
        pushSTACK(value1); pushSTACK(NIL); pushSTACK(NIL);
        funcall(L(read_line),3); # (READ-LINE stream NIL NIL)
        pushSTACK(value1); # Ergebnis (kann auch NIL sein) retten
        stream_close(&STACK_1); # Stream schließen
        if (!nullp(STACK_0))
          { erg = string_upcase(STACK_0); } # in Großbuchstaben umwandeln
          else
          { erg = NIL; }
        skipSTACK(2);
        #endif
        # Das Ergebnis merken wir uns für's nächste Mal:
        O(machine_type_string) = erg;
      }
    value1 = erg; mv_count=1;
  }

LISPFUNN(machine_version,0)
# (MACHINE-VERSION), CLTL S. 447
  { var reg1 object erg = O(machine_version_string);
    if (nullp(erg)) # noch unbekannt?
      { # ja -> holen
        #ifdef HAVE_SYS_UTSNAME_H
        var struct utsname utsname;
        begin_system_call();
        if ( uname(&utsname) <0) { OS_error(); }
        end_system_call();
        pushSTACK(asciz_to_string(&!utsname.machine));
        funcall(L(nstring_upcase),1); # in Großbuchstaben umwandeln
        erg = value1;
        #else
        # Betriebssystem-Kommando 'arch -k' ausführen und dessen Output
        # in einen String umleiten:
        # (string-upcase
        #   (with-open-stream (stream (make-pipe-input-stream "/bin/arch -k"))
        #     (read-line stream nil nil)
        # ) )
        pushSTACK(asciz_to_string("/bin/arch -k"));
        funcall(L(make_pipe_input_stream),1); # (MAKE-PIPE-INPUT-STREAM "/bin/arch -k")
        pushSTACK(value1); # Stream retten
        pushSTACK(value1); pushSTACK(NIL); pushSTACK(NIL);
        funcall(L(read_line),3); # (READ-LINE stream NIL NIL)
        pushSTACK(value1); # Ergebnis (kann auch NIL sein) retten
        stream_close(&STACK_1); # Stream schließen
        funcall(L(string_upcase),1); skipSTACK(1); # in Großbuchstaben umwandeln
        #endif
        # Das Ergebnis merken wir uns für's nächste Mal:
        O(machine_version_string) = erg = value1;
      }
    value1 = erg; mv_count=1;
  }

LISPFUNN(machine_instance,0)
# (MACHINE-INSTANCE), CLTL S. 447
  { var reg1 object erg = O(machine_instance_string);
    if (nullp(erg)) # noch unbekannt?
      { # ja -> Hostname abfragen und dessen Internet-Adresse holen:
        # (let* ((hostname (unix:gethostname))
        #        (address (unix:gethostbyname hostname)))
        #   (if (or (null address) (zerop (length address)))
        #     hostname
        #     (apply #'string-concat hostname " ["
        #       (let ((l nil))
        #         (dotimes (i (length address))
        #           (push (sys::decimal-string (aref address i)) l)
        #           (push "." l)
        #         )
        #         (setf (car l) "]") ; statt (pop l) (push "]" l)
        #         (nreverse l)
        # ) ) ) )
        #if defined(HAVE_GETHOSTNAME)
        var char hostname[MAXHOSTNAMELEN+1];
        # Hostname holen:
        begin_system_call();
        if ( gethostname(&!hostname,MAXHOSTNAMELEN) <0) { OS_error(); }
        end_system_call();
        hostname[MAXHOSTNAMELEN] = '\0'; # und durch ein Nullbyte abschließen
        #elif defined(HAVE_SYS_UTSNAME_H)
        # Hostname u.a. holen:
        var struct utsname utsname;
        begin_system_call();
        if ( uname(&utsname) <0) { OS_error(); }
        end_system_call();
        #define hostname utsname.nodename
        #else
        ??
        #endif
        erg = asciz_to_string(&!hostname); # Hostname als Ergebnis
        #ifdef HAVE_GETHOSTBYNAME
        pushSTACK(erg); # Hostname als 1. String
        { var reg5 uintC stringcount = 1;
          # Internet-Information holen:
          var reg4 struct hostent * h = gethostbyname(&!hostname);
          if ((!(h == (struct hostent *)NULL)) && (!(h->h_addr == (char*)NULL))
              && (h->h_length > 0)
             )
            { pushSTACK(asciz_to_string(" ["));
             {var reg2 uintB* ptr = (uintB*)h->h_addr;
              var reg3 uintC count;
              dotimesC(count,h->h_length,
                pushSTACK(fixnum(*ptr++));
                funcall(L(decimal_string),1); # nächstes Byte in dezimal
                pushSTACK(value1);
                pushSTACK(asciz_to_string(".")); # und ein Punkt als Trennung
                );
              STACK_0 = asciz_to_string("]"); # kein Punkt am Schluß
              stringcount += (2*h->h_length + 1);
            }}
          # Strings zusammenhängen:
          erg = string_concat(stringcount);
        }
        #endif
        #undef hostname
        # Das Ergebnis merken wir uns für's nächste Mal:
        O(machine_instance_string) = erg;
      }
    value1 = erg; mv_count=1;
  }

#endif # MACHINE_KNOWN

#ifdef HAVE_ENVIRONMENT

LISPFUNN(get_env,1)
# (SYSTEM::GETENV string) liefert den zu string im Betriebssystem-Environment
# assoziierten String oder NIL.
  { var reg2 object arg = popSTACK();
    if (stringp(arg))
      { var reg1 const char* found;
        begin_system_call();
        found = getenv(TheAsciz(string_to_asciz(arg)));
        end_system_call();
        if (!(found==NULL))
          { value1 = asciz_to_string(found); } # gefunden -> String als Wert
          else
          { value1 = NIL; } # nicht gefunden -> Wert NIL
      }
      else
      { value1 = NIL; } # Kein String -> Wert NIL
    mv_count=1;
  }

#endif

LISPFUNN(software_type,0)
# (SOFTWARE-TYPE), CLTL S. 448
  { value1 = OL(software_type_string); mv_count=1; }

LISPFUNN(software_version,0)
# (SOFTWARE-VERSION), CLTL S. 448
  { value1 = OL(software_version_string); mv_count=1; }

LISPFUNN(language,3)
# (SYS::LANGUAGE english deutsch francais) liefert je nach der aktuellen
# Sprache das entsprechende Argument.
  { value1 = (ENGLISH ? STACK_2 :
              DEUTSCH ? STACK_1 :
              FRANCAIS ? STACK_0 :
              NIL
              );
    mv_count=1;
    skipSTACK(3);
  }

LISPFUNN(identity,1)
# (IDENTITY object), CLTL S. 448
  { value1 = popSTACK(); mv_count=1; }

LISPFUNN(address_of,1)
# (SYS::ADDRESS-OF object) liefert die Adresse von object
  { var reg1 object arg = popSTACK();
    #if defined(WIDE_HARD)
      value1 = UQ_to_I(untype(arg));
    #elif defined(WIDE_SOFT)
      value1 = UL_to_I(untype(arg));
    #else
      value1 = UL_to_I(as_oint(arg));
    #endif
    mv_count=1;
  }


# Zeitfunktionen:

#ifdef TIME_ATARI
  # Zwei kleinere Bugs:
  # - Wrap-Around der Uhrzeit nach 248 Tagen,
  # - LISP-Uhr geht um +/- 1 Sekunde falsch gegenüber der Atari-Uhr
  #   (weil die beim LISP-System-Start abgefragte Atari-Uhr 0 bis 2 Sekunden
  #    nachgeht).
  # Decoded Time =
  #   Sekunde, Minute, Stunde, Tag, Monat, Jahr, Wochentag, Sommerzeit, Zeitzone
  # Universal Time =
  #   Sekunden seit 1.1.1900
  # Internal Time =
  #   200stel Sekunden seit LISP-System-Start
#endif
#ifdef TIME_AMIGAOS
  # Ein kleineres Bug:
  # - Wrap-Around der Uhrzeit nach 2.7 Jahren.
  # Decoded Time =
  #   Sekunde, Minute, Stunde, Tag, Monat, Jahr, Wochentag, Sommerzeit, Zeitzone
  # Universal Time =
  #   Sekunden seit 1.1.1900
  # Internal Time =
  #   50stel Sekunden seit LISP-System-Start
#endif
#ifdef TIME_MSDOS
  # Ein kleineres Bug:
  # - Wrap-Around der Uhrzeit nach 1.36 Jahren.
  # Decoded Time =
  #   Sekunde, Minute, Stunde, Tag, Monat, Jahr, Wochentag, Sommerzeit, Zeitzone
  # Universal Time =
  #   Sekunden seit 1.1.1900
  # Internal Time =
  #   100stel Sekunden seit LISP-System-Start
#endif
#if defined(TIME_UNIX_TIMES) || defined(TIME_RISCOS)
  # Zwei kleinere Bugs:
  # - Wrap-Around der Uhrzeit nach vielen Tagen,
  # - LISP-Uhr geht um max. 1 Sekunde nach gegenüber der wahren Uhr.
  # Decoded Time =
  #   Sekunde, Minute, Stunde, Tag, Monat, Jahr, Wochentag, Sommerzeit, Zeitzone
  # Universal Time =
  #   Sekunden seit 1.1.1900
  # Internal Time =
  #   CLK_TCK-stel Sekunden seit LISP-System-Start
#endif
#ifdef TIME_UNIX
  # Ein kleineres Bug:
  # - %%TIME funktioniert nur für Zeitdifferenzen <= 194 Tagen.
  # Decoded Time =
  #   Sekunde, Minute, Stunde, Tag, Monat, Jahr, Wochentag, Sommerzeit, Zeitzone
  # Universal Time =
  #   Sekunden seit 1.1.1900
  # Internal Time =
  #   Mikrosekunden seit LISP-System-Start
#endif

#ifdef TIME_RELATIVE

# Uhrzeit und Datum beim LISP-Start:
  local decoded_time realstart_datetime;

# UP: Berechnet die Uhrzeit beim LISP-System-Start als Universal Time.
# calc_start_UT(&timepoint)
# > decoded_time timepoint: Zeit beim LISP-System-Start
# < ergebnis: Universal Time
# kann GC auslösen
  local object calc_start_UT (decoded_time* timepoint);
  local object calc_start_UT(timepoint)
    var reg1 decoded_time* timepoint;
    { # (ENCODE-UNIVERSAL-TIME Sekunden Minuten Stunden Tag Monat Jahr) ausführen:
      pushSTACK(timepoint->Sekunden);
      pushSTACK(timepoint->Minuten);
      pushSTACK(timepoint->Stunden);
      pushSTACK(timepoint->Tag);
      pushSTACK(timepoint->Monat);
      pushSTACK(timepoint->Jahr);
      funcall(S(encode_universal_time),6);
      # als Start-Universal-Time abspeichern:
      return O(start_UT) = value1;
    }

# UP: Merkt sich die Uhrzeit beim LISP-System-Start.
# set_start_time(&timepoint);
# > timepoint: Zeit beim LISP-System-Start
# >   timepoint.Sekunden in {0,...,59},
# >   timepoint.Minuten in {0,...,59},
# >   timepoint.Stunden in {0,...,23},
# >   timepoint.Tag in {1,...,31},
# >   timepoint.Monat in {1,...,12},
# >   timepoint.Jahr in {1980,...,2999},
# >   jeweils als Fixnums.
# kann GC auslösen
  global void set_start_time (decoded_time* timepoint);
  global void set_start_time(timepoint)
    var reg1 decoded_time* timepoint;
    { # Start-Zeit merken:
      realstart_datetime = *timepoint;
      # und, wenn möglich, gleich in Universal Time umwandeln:
      if (!eq(Symbol_function(S(encode_universal_time)),unbound))
        # Ist ENCODE-UNIVERSAL-TIME definiert -> sofort in UT umwandeln:
        { calc_start_UT(timepoint); }
    }

#endif

# Liefert die Uhrzeit in Sekunden (seit Systemstart bzw. 1.1.1900) als uintL.
  local uintL real_time_sec (void);
  local uintL real_time_sec()
    {
     #ifdef TIME_1
      var reg2 uintL real_time = get_real_time();
      # real_time := floor(real_time,ticks_per_second) :
      #if (ticks_per_second == 1000000UL)
        divu_3216_3216(real_time>>6,ticks_per_second>>6,real_time=,);
      #elif (ticks_per_second < bit(16))
        divu_3216_3216(real_time,ticks_per_second,real_time=,);
      #else
        divu_3232_3232(real_time,ticks_per_second,real_time=,);
      #endif
     #endif
     #ifdef TIME_2
      var reg2 uintL real_time = (get_real_time())->tv_sec; # Sekunden
      #ifdef TIME_UNIX
      # real_time sind Sekunden seit 1.1.1970
      real_time = 2208988800UL+real_time; # 25567*24*60*60 Sekunden zwischen 1.1.1900 und 1.1.1970
      #endif
     #endif
     return real_time;
    }

LISPFUNN(get_universal_time,0)
# (get-universal-time), CLTL S. 445
#ifdef TIME_RELATIVE
  # (defun get-universal-time ()
  #   (+ (sys::get-start-time)
  #      (floor (get-internal-real-time) internal-time-units-per-second)
  # ) )
  { var reg1 object start_time = O(start_UT);
    if (nullp(start_time)) # Start-Universal-Time noch NIL ?
      # nein -> schon berechnet.
      # ja -> jetzt erst berechnen:
      { start_time = calc_start_UT(&realstart_datetime); }
    # start_time = die Uhrzeit des LISP-System-Starts in Universal Time.
    pushSTACK(start_time);
    pushSTACK(UL_to_I(real_time_sec())); # Sekunden seit Systemstart
    funcall(L(plus),2); # addieren
  }
#endif
#ifdef TIME_ABSOLUTE
  { value1 = UL_to_I(real_time_sec()); mv_count=1; }
#endif

#ifdef UNIX
LISPFUN(default_time_zone,0,1,norest,nokey,0,NIL)
# (sys::default-time-zone) liefert die aktuelle Zeitzone.
# (sys::default-time-zone UTstunde) liefert die aktuelle Zeitzone zu einem
# bestimmten Zeitpunkt.
# 1. Wert: Zeitzone mit Sommerzeit-Berücksichtigung.
# 2. Wert: Sommerzeit-p.
  { # Da die Zeitzone oft per TZ-Environment-Variable einstellbar ist, wird
    # sie häufig außerhalb des Kernels verwaltet. Man hat nur per localtime()
    # und gmtime() Zugriff auf sie.
    # Methode:
    #   Zeitzone = (gmtime(t) - localtime(t))/3600.
    #   Sommerzeit-p wird dem Ergebnis von localtime(t) entnommen.
    var reg4 object arg = popSTACK();
    var time_t now;
    if (posfixnump(arg)
        && (posfixnum_to_L(arg) > 613608) # arg > 1.1.1970
        && (posfixnum_to_L(arg) < 1314888) # arg < 1.1.2050
       )
      # bestimmter Zeitpunkt
      # Annahme: time_t ist die Anzahl der Sekunden seit 1.1.1970. ??
      { now = (posfixnum_to_L(arg) - 613606) * 3600; }
      else
      # jetzt
      { begin_system_call(); time(&now); end_system_call(); }
    { var struct tm now_local;
      var struct tm now_gm;
      begin_system_call();
      now_local = *(localtime(&now));
      now_gm = *(gmtime(&now));
      end_system_call();
      # secondswest = mktime(now_gm) - mktime(now_local); wäre schön.
      # mktime() ist allerdings nicht weit verbreitet. Unter SunOS4 müßte man
      # timegm() nehmen. Daher tun wir's selber:
     {var reg5 sintL dayswest = # Tage-Differenz, kann als 0,1,-1 angenommen werden
        (now_gm.tm_year < now_local.tm_year ? -1 :
         now_gm.tm_year > now_local.tm_year ? 1 :
         (now_gm.tm_mon < now_local.tm_mon ? -1 :
          now_gm.tm_mon > now_local.tm_mon ? 1 :
          (now_gm.tm_mday < now_local.tm_mday ? -1 :
           now_gm.tm_mday > now_local.tm_mday ? 1 :
           0
        )));
      var reg3 sintL hourswest = 24*dayswest + (sintL)(now_gm.tm_hour - now_local.tm_hour);
      var reg2 sintL minuteswest = 60*hourswest + (sintL)(now_gm.tm_min - now_local.tm_min);
      var reg1 sintL secondswest = 60*minuteswest + (sintL)(now_gm.tm_sec - now_local.tm_sec);
      # Zeitzone in Stunden = (Zeitzone in Sekunden / 3600) :
      pushSTACK(L_to_I(secondswest));
      pushSTACK(fixnum(3600));
      funcall(L(durch),2);
      # Sommerzeit-p entnehmen:
      # tm_isdst < 0 bedeutet "unbekannt"; wir nehmen an, keine Sommerzeit.
      value2 = (now_local.tm_isdst > 0 ? T : NIL);
      mv_count=2;
  } }}
#endif

LISPFUNN(get_internal_run_time,0)
# (GET-INTERNAL-RUN-TIME), CLTL S. 446
  { var timescore tm;
    get_running_times(&tm); # Run-Time seit LISP-System-Start abfragen
   #ifdef TIME_1
    value1 = UL_to_I(tm.runtime); mv_count=1; # in Integer umwandeln
   #endif
   #ifdef TIME_2
    { var reg1 internal_time* tp = &tm.runtime; # Run-Time
      # in Mikrosekunden umwandeln: tp->tv_sec * ticks_per_second + tp->tv_usec
      #ifdef intQsize
      value1 = UQ_to_I((uintQ)(tp->tv_sec) * ticks_per_second + (uintQ)(tp->tv_usec));
      #else
      {var reg3 uintL run_time_hi;
       var reg2 uintL run_time_lo;
       mulu32(tp->tv_sec,ticks_per_second, run_time_hi=,run_time_lo=);
       if ((run_time_lo += tp->tv_usec) < tp->tv_usec) { run_time_hi += 1; }
       value1 = L2_to_I(run_time_hi,run_time_lo);
      }
      #endif
      mv_count=1;
    }
   #endif
  }

LISPFUNN(get_internal_real_time,0)
# (GET-INTERNAL-REAL-TIME), CLTL S. 446
#ifdef TIME_1
  { value1 = UL_to_I(get_real_time()); # Real-Time seit LISP-System-Start, als Integer
    mv_count=1;
  }
#endif
#ifdef TIME_2
  { var reg1 internal_time* tp = get_real_time(); # Real-Time absolut
    # in Mikrosekunden umwandeln: tp->tv_sec * ticks_per_second + tp->tv_usec
    #ifdef intQsize
    value1 = UQ_to_I((uintQ)(tp->tv_sec) * ticks_per_second + (uintQ)(tp->tv_usec));
    #else
    {var reg3 uintL real_time_hi;
     var reg2 uintL real_time_lo;
     mulu32(tp->tv_sec,ticks_per_second, real_time_hi=,real_time_lo=);
     if ((real_time_lo += tp->tv_usec) < tp->tv_usec) { real_time_hi += 1; }
     value1 = L2_to_I(real_time_hi,real_time_lo);
    }
    #endif
    mv_count=1;
  }
#endif

#ifdef SLEEP_1
LISPFUNN(sleep,1)
#if defined(TIME_ATARI) || defined(TIME_MSDOS) || defined(RISCOS)
# (SYSTEM::%SLEEP delay) wartet delay/200 bzw. delay/100 Sekunden.
# Argument delay muß ein Integer >=0, <2^32 (TIME_MSDOS: sogar <2^31) sein.
  { var reg2 uintL delay = I_to_UL(popSTACK()); # Pausenlänge
    #ifdef EMUNIX_PORTABEL
    #ifdef EMUNIX_OLD_8e
    if (!(_osmode == DOS_MODE))
    #else
    if (TRUE)
    #endif
      # Unter OS/2 (Multitasking!) nicht CPU-Zeit verbraten!
      # select erlaubt eine wunderschöne Implementation von usleep():
      { loop
          { var reg4 uintL start_time = get_real_time();
            { var struct timeval timeout; # Zeitintervall
              divu_3216_3216(delay,ticks_per_second, timeout.tv_sec =, timeout.tv_usec = 1000000/ticks_per_second * (uintL) );
              begin_system_call();
             {var reg1 int ergebnis = select(FD_SETSIZE,NULL,NULL,NULL,&timeout);
              end_system_call();
              if ((ergebnis<0) && !(errno==EINTR)) { OS_error(); }
            }}
            interruptp( { pushSTACK(S(sleep)); tast_break(); } ); # evtl. Break-Schleife aufrufen
           {var reg3 uintL end_time = get_real_time();
            var reg1 uintL slept = end_time - start_time; # so lang haben wir geschlafen
            # Haben wir genug geschlafen?
            if (slept >= delay) break;
            # Wie lange müssen wir noch schlafen?
            delay -= slept;
          }}
      }
      else
    #endif
    { var reg1 uintL endtime = get_real_time() + delay; # zur momentanen Real-Time addieren,
      # ergibt Zeit, bis zu der zu warten ist.
      # warten, bis die Real-Time bei endtime angelangt ist:
      #ifdef TIME_ATARI
      do {} until (get_real_time() == endtime);
      #else # MSDOS rückt die Uhr jedesmal um 5 oder 6 Ticks auf einmal weiter.
      do {} until ((sintL)(get_real_time()-endtime) >= 0);
      #endif
    }
    value1 = NIL; mv_count=1; # 1 Wert NIL
  }
#endif
#ifdef TIME_AMIGAOS
# (SYSTEM::%SLEEP delay) wartet delay/50 Sekunden.
# Argument delay muß ein Integer >=0, <2^32 sein.
  { var reg2 uintL delay = I_to_UL(popSTACK()); # Pausenlänge
    if (delay>0) { begin_system_call(); Delay(delay); end_system_call(); }
    value1 = NIL; mv_count=1; # 1 Wert NIL
  }
#endif
#endif
#ifdef SLEEP_2
#ifdef TIME_UNIX_TIMES
# Ein sehr unvollkommener Ersatz für die gettimeofday-Funktion.
# Taugt nur für die Messung von Zeitdifferenzen!
  local int gettimeofday (struct timeval * tp, void* tzp);
  local int gettimeofday(tp,tzp)
    var reg2 struct timeval * tp;
    var void* tzp;
    { if (!(tp==NULL))
        { var reg1 uintL realtime = get_real_time();
          # in Sekunden und Mikrosekunden umwandeln:
          tp->tv_sec = floor(realtime,ticks_per_second);
          tp->tv_usec = (realtime % ticks_per_second) * floor(2*1000000+ticks_per_second,2*ticks_per_second);
        }
      return 0;
    }
#endif
LISPFUNN(sleep,2)
#if defined(TIME_UNIX) || defined(TIME_UNIX_TIMES)
# (SYSTEM::%SLEEP delay-seconds delay-useconds) wartet
# delay-seconds Sekunden und delay-useconds Mikrosekunden.
# Argument delay-seconds muß ein Fixnum >=0, <=16700000 sein,
# Argument delay-useconds muß ein Fixnum >=0, <=1000000 sein.
  { var reg3 uintL useconds = posfixnum_to_L(popSTACK());
    var reg2 uintL seconds = posfixnum_to_L(popSTACK());
    begin_system_call();
    loop
      { var struct timeval start_time;
        var struct timeval end_time;
        if (!( gettimeofday(&start_time,NULL) ==0)) { OS_error(); }
        #ifdef HAVE_SELECT
          # select erlaubt eine wunderschöne Implementation von usleep():
          { var struct timeval timeout; # Zeitintervall
            timeout.tv_sec = seconds; timeout.tv_usec = useconds;
           {var reg1 int ergebnis;
            ergebnis = select(FD_SETSIZE,NULL,NULL,NULL,&timeout);
            if ((ergebnis<0) && !(errno==EINTR)) { OS_error(); }
          }}
        #else
          if (seconds>0) { sleep(seconds); }
          #ifdef HAVE_USLEEP
          if (useconds>0) { usleep(useconds); }
          #endif
        #endif
        interruptp(
          { end_system_call();
            pushSTACK(S(sleep)); tast_break(); # evtl. Break-Schleife aufrufen
            begin_system_call();
          });
        if (!( gettimeofday(&end_time,NULL) ==0)) { OS_error(); }
       {# Überprüfen, ob wir genügend lang geschlafen haben, oder ob
        # wir wegen eines Signals zu früh aufgeweckt wurden:
        var struct timeval slept; # so lang haben wir geschlafen
        # sozusagen sub_internal_time(end_time,start_time, slept);
        slept.tv_sec = end_time.tv_sec - start_time.tv_sec;
        if (end_time.tv_usec < start_time.tv_usec)
          { end_time.tv_usec += 1000000; slept.tv_sec -= 1; }
        slept.tv_usec = end_time.tv_usec - start_time.tv_usec;
        # Haben wir genug geschlafen?
        if ((slept.tv_sec > seconds)
            || ((slept.tv_sec == seconds) && (slept.tv_usec >= useconds))
           )
          break;
        # Wie lange müssen wir noch schlafen?
        seconds -= slept.tv_sec;
        if (useconds < slept.tv_usec) { seconds -= 1; useconds += 1000000; }
        useconds -= slept.tv_usec;
        #if !defined(HAVE_SELECT) && !defined(HAVE_USLEEP)
        if (seconds==0) break; # CPU-Zeit fressende Warteschleife vermeiden
        #endif
      }}
    end_system_call();
    value1 = NIL; mv_count=1; # 1 Wert NIL
  }
#endif
#endif

LISPFUNN(time,0)
# (SYSTEM::%%TIME) liefert den bisherigen Time/Space-Verbrauch, ohne selbst
# Platz anzufordern (und damit eventuell selbst eine GC zu verursachen).
# 9 Werte:
#   Real-Time (Zeit seit Systemstart) in 2 Werten,
#   Run-Time (verbrauchte Zeit seit Systemstart) in 2 Werten,
#   GC-Time (durch GC verbrauchte Zeit seit Systemstart) in 2 Werten,
#   #ifdef TIME_ATARI
#     jeweils in 200stel Sekunden,
#     jeweils (ldb (byte 16 16) time) und (ldb (byte 16 0) time).
#   #endif
#   #ifdef TIME_AMIGAOS
#     jeweils in 50stel Sekunden,
#     jeweils (ldb (byte 16 16) time) und (ldb (byte 16 0) time).
#   #endif
#   #ifdef TIME_MSDOS
#     jeweils in 100stel Sekunden,
#     jeweils (ldb (byte 16 16) time) und (ldb (byte 16 0) time).
#   #endif
#   #if defined(TIME_UNIX_TIMES) || defined(TIME_RISCOS)
#     jeweils in CLK_TCK-stel Sekunden,
#     jeweils (ldb (byte 16 16) time) und (ldb (byte 16 0) time).
#   #endif
#   #ifdef TIME_UNIX
#     jeweils in Mikrosekunden, jeweils ganze Sekunden und Mikrosekunden.
#   #endif
#   Space (seit Systemstart verbrauchter Platz, in Bytes)
#     in 2 Werten: (ldb (byte 24 24) Space), (ldb (byte 24 0) Space).
#   GC-Count (Anzahl der durchgeführten Garbage Collections).
  { var timescore tm;
    get_running_times(&tm); # Run-Time abfragen
    #ifdef TIME_1
      #define as_2_values(time)  \
        pushSTACK(fixnum(high16(time))); \
        pushSTACK(fixnum(low16(time)));
    #endif
    #ifdef TIME_2
      #define as_2_values(time)  \
        pushSTACK(fixnum(time.tv_sec)); \
        pushSTACK(fixnum(time.tv_usec));
    #endif
    as_2_values(tm.realtime); # erste zwei Werte: Real-Time
    as_2_values(tm.runtime); # nächste zwei Werte: Run-Time
    as_2_values(tm.gctime); # nächste zwei Werte: GC-Time
    # nächste zwei Werte: Space
    # tm.gcfreed = von der GC bisher wieder verfügbar gemachter Platz
    {var reg1 uintL used = used_space(); # momentan belegter Platz
     # beides addieren:
     #ifdef intQsize
     tm.gcfreed += used;
     #else
     if ((tm.gcfreed.lo += used) < used) { tm.gcfreed.hi += 1; }
     #endif
    }
    # Jetzt ist tm.gcfreed = bisher insgesamt verbrauchter Platz
    #if (oint_data_len<24)
      #error "Funktion SYS::%%TIME anpassen!"
    #endif
    # In 24-Bit-Stücke zerhacken:
    #ifdef intQsize
    pushSTACK(fixnum( (tm.gcfreed>>24) & (bit(24)-1) ));
    pushSTACK(fixnum( tm.gcfreed & (bit(24)-1) ));
    #else
    pushSTACK(fixnum( ((tm.gcfreed.hi << 8) + (tm.gcfreed.lo >> 24)) & (bit(24)-1) ));
    pushSTACK(fixnum( tm.gcfreed.lo & (bit(24)-1) ));
    #endif
    # letzter Wert: GC-Count
    pushSTACK(fixnum(tm.gccount));
    funcall(L(values),9); # 9 Werte produzieren
  }

