Weird Local-to-global Bug

[hughes@aristotle.ils.nwu.edu (Lucian Hughes)]

#|MACL 1.3.2 Local-to-global does not handle views on color windows.
Accordingly we rewrote it to call the standard local-to-global
trap call.
  At first blush it seems to work fine. However, if a call to
local-to-global is embedded within (for instance) a view-draw-contents
call it returns incorrect values!!! There is no apparent reason
for this strange behavior. Anyone have any ideas?????
  Here is some very straight forward sample code that illustrates
the point.

|#
 

;First your definition, but attached to *view* instead of
*color-window-mixin*
; be sure you aren't loading your old version {*color-mixin*}

(defobfun (LOCAL-TO-GLOBAL *VIEW*) (h &optional v)
    (declare (object-variable wptr))
    (let ((where (make-point h v)))
      (%stack-block ((old-port-ptr 4)
                     (point-ptr 4))
        (_GetPort :ptr old-port-ptr)
        (if (and wptr (pointerp wptr))
          (_SetPort :ptr wptr)
          (error "Wptr ~S is NIL or non-ptr.~%" wptr))       
        (%put-long point-ptr where)
        (_LocalToGlobal :ptr point-ptr)
        (_SetPort :ptr (%get-ptr old-port-ptr))
        (%get-long point-ptr)
        ) ))
;This works fine unless embedded in a function call like view-draw-contents

(defobject *TEST-VIEW* *view*)

(defobfun (VIEW-DRAW-CONTENTS *TEST-VIEW*)()
  (with-focused-view (self)  ;this doesn't make any diff, can be left out
    (SETF FOO
          (point-string (local-to-global (view-position)))))
  (PRINT-DB FOO 
            (POINT-STRING (VIEW-POSITION))
            (POINT-STRING (LOCAL-TO-GLOBAL (VIEW-POSITION)))
            )
  (usual-view-draw-contents))
; Fn will print-db out bad values. I did the set foo first in case printing
; was screwing up the current port. Both foo and print-db call of
local-to-global
;return #@(70 70) when should return #@(60 60)

(defobject *COLOR-WINDOW* *color-window-mixin* *window*)

(setf w  (oneof *color-window* :window-position #@(50 50)))
(setf test-v (oneof *test-view*
                   :view-position #@(10 10)))
(ask test-v (set-view-container w))  ;this line reveals bug, execute it!

;BUG!!!!! Note that foo is #@(70 70) But should be #@(60 60)!!!

;in fact if I ask at the listener I get the right value of #@(60 60)!!!

;So I tried a slight diff definition using with-focused-view
; this fails to work even at the listener!
(defobfun (LOCAL-TO-GLOBAL *VIEW*)(h &optional v)
    (with-focused-view (self)
      (let ((where (make-point h v)))
        (%stack-block ((point-ptr 4)
                       )
          (%put-long point-ptr where)
          (_LocalToGlobal :ptr point-ptr)
          (%get-long point-ptr)
          ))))

; What I CAN get to work is:
(defobfun (LOCAL-TO-GLOBAL *VIEW*)(h &optional v)
      (if (and wptr (pointerp wptr))
      (add-points (view-position)
                  (ask (view-window (self))
                    (window-position)))
      (error "Wptr ~S is NIL or non-ptr.~%" wptr)))
 

So while I have the above work around, I'm pretty curious as to
why a "proper" trap call doesn't work!