Re: How to sleep?

From: Berry Kercheval <kerch_at_parc.xerox.com>
Date: Thu, 29 Sep 1994 10:30:24 PDT

The obvious thing (to me, at least) is to define a C extension to add sleep()
to stk.
Here is such a thing I coded in about ten minutes, along with a simple test
program.
All you do is put

        (sleep nnn)

when you want to sleep.

  --berry

(P.S. Extending this to call usleep or select for sub-second waits is left as
an exercise.)



#include <stk.h>


/*
 * write a byte to a port. Use the low 8 bits of the integer i
 */
static PRIMITIVE stk_sleep(SCM n)
{
  if (NINTEGERP(n)) err("sleep: not an integer", n);
  sleep(INTEGER(n));
  return UNDEFINED;
}

void init_sleep(void)
{
    add_new_primitive("sleep", tc_subr_1, stk_sleep);
}

#
# A makefile for extensions files on Sun (with gcc)
#
# Copyright (C) 1993, 1994 Erick Gallesio - I3S - CNRS / UNSA <eg_at_unice.fr>
#
#
# Permission to use, copy, and/or distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that both the above copyright notice and this permission notice appear in
# all copies and derived works. Fees for distribution or use of this
# software or derived works may only be charged with express written
# permission of the copyright holder.
# This software is provided ``as is'' without express or implied warranty.
#
# Author: Erick Gallesio [eg_at_kaolin.unice.fr]
# Creation date: 6-Mar-1994 15:49
# Last file update: 6-Mar-1994 15:57
#
# Fixed for sleep() extension...

TOP=/import/stk/src
#include ${TOP}/config.make

#define here how to obtain Position Independant Code (pic) with your compiler
PIC = -fpic


# Define here the extension you want to be defined
#EXT = hash.so time.so
EXT= sleep.so

CC=gcc
CFLAGS= $(PIC) $(STKCFLAGS) -I/import/X11R4/include -DUSE_TK -I${TOP}/Tk
-I${TOP}/Tcl -I${TOP}/Src $(XINCLUDES)

##############################################################################
.SUFFIXES: .so .o .c

.c.so:
        $(CC) -c $(CFLAGS) -o $*.o $<
        ld -assert pure-text -o $*.so $*.o

.o.so:
        ld -assert pure-text -o $*.so $<
##############################################################################
all: $(EXT)

install:
        $(INSTALL) $(EXT) $(libdir)

clean:
        _at_/bin/rm -f *.o *.so core *~f

#!/import/stk/sol1/bin/stk -f

(load "foredriver/stk/sleep.so")
(load "logical.scm")

(define seconds 5)

(define do-sleep
  (lambda ()
    (format #t "Sleeping for ~A seconds...~%" seconds)
    (sleep seconds)
    (format #t "Waking up!~%")
        ))

(button ".quit"
        :text "Quit"
        :command '(begin
                    (display "Quitting sleep test\n")
                    (destroy "."))
        :foreground 'red)

(button ".sleep"
        :text "Do Sleep"
        :command 'do-sleep)

(pack 'append "." .quit "top fillx")
(pack 'append "." .sleep "top fillx")

(frame ".secframe" :bd 2 :relief 'raised)
(pack 'append "." .secframe "top fillx")

(pack [label ".secframe.label"
             :text "Seconds to sleep: "
             :width 15
             :anchor 'e]
      :side "left")
(pack [scale ".secframe.scale"
             :orient 'hor
             :from 1 :to 60
             :font "fixed"
             :command "set! seconds"]
      :side "right" :expand #t :fill "x")

(.secframe.scale 'set seconds)




(wm 'title '. "Sleep Test")
Received on Thu Sep 29 1994 - 18:34:00 CET

This archive was generated by hypermail 2.3.0 : Mon Jul 21 2014 - 19:38:59 CEST