Re: [Chicken-users] 4.7.3 development snapshot

[Jörg F . Wittenberger]

Hi all,

I feel some comments might be worth to be written up.
On Aug 18 2011, Felix wrote:

> A new development snapshot is available:
>
>  http://code.call-cc.org/dev-snapshots/2011/08/17/chicken-4.7.3.tar.gz
>
> Note: the banner shows "(no branch)", which is incorrect (and
> fixed in trunk), so just ignore this.

As it happened to me, compiling will not run straight as soon as you
need to tweak something (*and* try to work that out in an insulated
area).  My solution was eventually to touch "identify.sh".  So far it
would check for the ".git" directory and don't do anything if not found.
I'd propose to something sensible instead like this:


if test -d "$1/.git"; then
   rev=`GIT_DIR="$1/.git" git rev-parse --short HEAD 2>/dev/null`
   branchname=`GIT_DIR="$1/.git" git branch --no-color 2> /dev/null | sed 
-e '/^[^*]/d' -e 's/* \(.*\)/\1/'`
   tag="#define C_BUILD_TAG \"compiled ${buildtime} on ${host} (${usys})\""
else
   : ${branchname:="custom"}
   tag="#define C_BUILD_TAG \"compiled ${buildtime} on ${host} (${usys})\""
fi
.... # the rest what is now inside the "if" follows untouched.

(BTW: That would even remove the compile time dependency on git.)

> - Core syntax
>  - "parameterize" now correctly omits invoking the guard procedure when
>    the old value is restored (thanks to Joo ChurlSoo)

Special thanks to the way this has been implemented!

Some might recall a discussion here long ago, when I've seeking support
for an alternative semantics for parameters (as implemented in at least one
other Scheme: shared parameters, which behave like normal ones except that
setting them like "(param-name value)" before first touched by parameterize
(which always makes them thread-local) would change the default value.
This combines in a way the advantages of top level variables (+ setter
and getter procedure) and parameters.

Since I've been routinely passing a file via -extend to csc, which
changed the parameterize syntax to... something almost equivalent.
Now I've been able to get rid of that definition.  For the curious
here an implementation of the alternative parameter semantics:

(define make-shared-parameter
 (let ((count 0)
        (defaults '#())
        (vals (make-parameter '(#f . #())))
        (undefined '(undefined)))
   (lambda (init #!optional (sane (lambda (x) x)))
     (let* ((val (sane init))
             (i count))
        (set! count (fx+ count 1))
        (when (fx>= i (vector-length defaults))
          (set! defaults (vector-resize defaults (fx+ i 1) undefined) ) )
        (vector-set! defaults i val)
        (lambda arg
          (let* ((e (vals))
                 (current (cdr e))
                 (n (vector-length current)))
            (if (pair? arg)
                (begin
                  ;;  direct call
                  (if (null? (cdr arg))
                      (if (or (fx>= i n)
                              (eq? (vector-ref current i) undefined))
                          (vector-set! defaults i (sane (car arg)))
                          (vector-set! current i (sane (car arg))))
                      ;; call from parameterize (or manual fake bypassing API)
                      (let ((newval
                             ;; Restore call as per chicken's internals. 
Therefore
                             ;; we know/"take for granted" it's local anyway.
                             (if (eq? (cadr arg) #t)
                                 (car arg)
                                 ;; set initally
                                 (sane (car arg)))))
                        (cond
                         ((fx>= i n)
                          (set! current (vector-resize current (fx+ i 1) 
undefined) )
                          (vals (cons (current-thread) current)))
                         ((not (eq? (car e) (current-thread)))
                          (set! current (vector-copy current 0 (vector-length 
current)) )
                          (vals (cons (current-thread) current))))
                        (vector-set! current i newval)))
                  (##core#undefined))
                (cond
                 ((fx>= i n) (vector-ref defaults i))
                 (else (let ((val (vector-ref current i)))
                         (if (eq? val undefined)
			     (vector-ref defaults i) 
			     val))))) ) ) ) ) ) )
------------------------------------

There is one more "strange observation":

A small snipped of code, which happend to work for several years:

(define (tcp-get-next-client tcpl)
 (##sys#check-structure tcpl 'tcp-listener)
 (let ((fd (##sys#slot tcpl 1))
        (tma (tcp-accept-timeout)))

short after the "tma" is passed to ##sys#thread-block-for-timeout!
if - any only if - tma != #f.  In practice it is #f.

Compiled with the 4.7.3 the code branch for tma != #f was suddenly 
executed. Strange however: as soon as I wraped the call 
(tcp-accept-timeout) into my usual "(debug label value)" [which sends the 
label and value to the logfile and returns the value] I saw the correct #f 
in the logfile and everything worked again.

So for the time being I settled which the following modification to the
above code, which does fix the symptom too.  Even though it should not,
or at least I can not explain why it does.

(define (tcp-get-next-client tcpl)
 (##sys#check-structure tcpl 'tcp-listener)
 (let ((fd (##sys#slot tcpl 1))
        (tma (identity (tcp-accept-timeout)))) ; Work around strange 4.7.3 
chicken? !!!

[[Sure: I recompiled it twice each way.]]


Best regards & thanks again for the new version.

/Jörg
................................