home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / lisp / clx_tar.z / clx_tar / clx / debug / debug.lsp next >
Encoding:
Lisp/Scheme  |  1990-05-01  |  2.1 KB  |  78 lines
  1. ;;; -*- Mode:Lisp; Package:XLIB; Syntax:COMMON-LISP; Base:10; Lowercase:YES; Patch-file:T -*-
  2.  
  3. ;;; CLX debugging code
  4.  
  5. ;;;
  6. ;;;             TEXAS INSTRUMENTS INCORPORATED
  7. ;;;                  P.O. BOX 2909
  8. ;;;                   AUSTIN, TEXAS 78769
  9. ;;;
  10. ;;; Copyright (C) 1987 Texas Instruments Incorporated.
  11. ;;;
  12. ;;; Permission is granted to any individual or institution to use, copy, modify,
  13. ;;; and distribute this software, provided that this complete copyright and
  14. ;;; permission notice is maintained, intact, in all copies and supporting
  15. ;;; documentation.
  16. ;;;
  17. ;;; Texas Instruments Incorporated provides this software "as is" without
  18. ;;; express or implied warranty.
  19. ;;;
  20.  
  21. ;;; Created 04/09/87 14:30:41 by LaMott G. OREN
  22.  
  23. (in-package :xlib)
  24.  
  25. (export '(display-listen
  26.       readflush
  27.       check-buffer
  28.       check-finish
  29.       check-force
  30.       clear-next))
  31.  
  32. (defun display-listen (display)
  33.   (listen (display-input-stream display)))
  34.  
  35. (defun readflush (display)
  36.   ;; Flushes Display's input stream, returning what was there
  37.   (let ((stream (display-input-stream display)))
  38.     (loop while (listen stream) collect (read-byte stream))))
  39.  
  40. ;;-----------------------------------------------------------------------------
  41. ;; The following are useful display-after functions
  42.  
  43. (defun check-buffer (display)
  44.   ;; Ensure the output buffer in display is correct
  45.   (with-buffer-output (display :length :none :sizes (8 16))
  46.     (do* ((i 0 (+ i length))
  47.       request
  48.       length)
  49.      ((>= i buffer-boffset)
  50.       (unless (= i buffer-boffset)
  51.         (warn "Buffer size ~d  Requests end at ~d" buffer-boffset i)))
  52.       
  53.       (let ((buffer-boffset 0)
  54.         #+clx-overlapping-arrays
  55.         (buffer-woffset 0))
  56.     (setq request (card8-get i))
  57.     (setq length (* 4 (card16-get (+ i 2)))))
  58.       (when (zerop request)
  59.     (warn "Zero request in buffer")
  60.     (return nil))
  61.       (when (zerop length)
  62.     (warn "Zero length in buffer")
  63.     (return nil)))))
  64.  
  65. (defun check-finish (display)
  66.   (check-buffer display)
  67.   (display-finish-output display))
  68.  
  69. (defun check-force (display)
  70.   (check-buffer display)
  71.   (display-force-output display))
  72.  
  73. (defun clear-next (display)
  74.   ;; Never append requests
  75.   (setf (display-last-request display) nil))
  76.  
  77. ;; End of file
  78.