;;; ;;; Copyright 1990 by Digital Equipment AB, Sweden ;;; ;;; and ;;; ;;; Hakan Huss and Johan Ihren ;;; ;;; All Rights Reserved ;;; ;;; Permission to use, copy, modify, and distribute this software and ;;; its documentation for any purpose and without fee is hereby ;;; granted, provided that the above copyright notice appear in all ;;; copies and that both that copyright notice and this permis- ;;; sion notice appear in supporting documentation, and that the ;;; names of the copyright holders not be used in advertising in ;;; publicity pertaining to distribution of the software without ;;; specific, written prior permission. The copyright holders make no ;;; representations about the suitability of this software for any ;;; purpose. It is provided "as is" without express or implied warranty. ;;; ;;; THE COPYRIGHT HOLDERS DISCLAIM ALL WARRANTIES WITH REGARD TO ;;; THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANT- ;;; ABILITY AND FITNESS, IN NO EVENT SHALL THE COPYRIGHT HOLDERS ;;; BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ;;; ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR ;;; PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER ;;; TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE ;;; OR PERFORMANCE OF THIS SOFTWARE. ;;; ;;; Authors: Hakan Huss, KTH and Johan Ihren, KTH ;;; ;;; $Header: /deneb/src0/johani/scix-0.96/src/RCS/lowlevel.sc,v 1.4 90/04/01 13:50:28 johani Exp $ ;;; lowlevel.sc -- the lowest level of the Scheme side of the communication ;;; with the X server. The C routines are used by these ;;; functions (writetoserver, readfromserver and ;;; readmorefromserver) and by the display object that uses ;;; writesock directly. ;;; (module lowlevel (top-level)) (include "../include/util.sch") (define-c-external (scix-connectdisplay pointer) int "scix_connectdisplay") (define-c-external (scix-closedisplay pointer) int "scix_closedisplay") (define-c-external (Xwritesock int pointer int) int "writesock") (define-c-external (Xreadsock int) pointer "readsock") (define-c-external (Xreadmoresock int int int) pointer "getmoredata") (define (connectdisplay ptr) (scix-connectdisplay ptr) ) (define (disconnectdisplay fd) (scix-closedisplay fd) #f) (define (writesock i ptr nbytes) (Xwritesock i ptr nbytes)) (define (readsock fd) (Xreadsock fd)) (define (readmoresock fd pos nbytes) (Xreadmoresock fd pos nbytes)) ;;; writetoserver -- sends the chars in the list l to the server associated ;;; with dpy. The length of the list should be a multiple of ;;; four bytes long. Currently the list contains integers, ;;; this should probably change to characters to improve ;;; efficiency. (define (writetoserver dpy l) (let ((nbytes (length l)) (str (list->string (map integer->char l)))) (writesock (dpy 'scix-socket) str nbytes) )) ;;; readfromserver -- reads chars from the server and returns them as a ;;; "length-tagged-string". readsock returns a pointer to a ;;; buffer with length-info in the first four bytes and data ;;; in the rest. If there was no data to read, readsock will ;;; indicate this with -1 as legth-info. (define (readfromserver dpy) (let* ((str (readsock (dpy 'scix-socket))) (len (c-int-ref str 0))) (if (not (negative? len)) (convert-length-tagged-string str) '() ))) ;;; readmorefromserver -- reads more data from the server while preserving ;;; unprocessed data that remains in the buffer. The ;;; c function readmoresock moves the unprocessed data ;;; first in the buffer and appends the new data from ;;; the server after it. (define (readmorefromserver dpy str) (let* ((nbytesleft (- (c-input-string-length str) (c-input-string-pos str))) (str (readmoresock (dpy 'scix-socket) (c-input-string-pos str) nbytesleft)) ) (convert-length-tagged-string str) )) ;;; Stuff used by the dpy-object. (define-c-external (xstring-append! pointer pointer int int) int "strapp") (define-c-external (xzero-buffer-position) void "zero_buffer_position") (define-c-external (xcurrent-buffer-position) int "current_buffer_position") (define (string-append! s1 s2 len1 len2) (xstring-append! s1 s2 len1 len2) ) (define (zero-buffer-position) (xzero-buffer-position) #t) (define (current-buffer-position) (xcurrent-buffer-position) ) ;;; Stuff needed by the message-handler. (define-c-external (Xselect int int) int "Xselect") (define-c-external (Xblocking-io int) int "XblockingIO") (define-c-external (Xnon-blocking-io int) int "XnonblockingIO") (define (select nfds mask) (Xselect nfds mask) ) (define (blocking-io fd) (Xblocking-io fd) ) (define (non-blocking-io fd) (Xnon-blocking-io fd) ) ;;; Type stuff. (define-c-external (a-pad int pointer) int "a_pad") ;;; pad4 -- writes (pad n) nulls to the string str. Note that it is a-card8 ;;; that is responsible for keeping track of the position in the string. (define (pad4 n str) (a-pad n str) ) (define-c-external (xa-int8 int pointer) int "a_int8") (define-c-external (xa-int16 int pointer) int "a_int16") (define-c-external (xa-int32 int pointer) int "a_int32") (define-c-external (xa-card8 int pointer) int "a_card8") (define-c-external (xa-card16 int pointer) int "a_card16") (define-c-external (xa-card32 int pointer) int "a_card32") (define-c-external (a-string8x pointer int pointer) int "a_string8x") (define-c-external (a-strx pointer int pointer) int "a_strx") (define (a-int8 n buffer) (xa-int8 n buffer) ) (define (a-int16 n buffer) (xa-int16 n buffer) ) (define (a-int32 n buffer) (xa-int32 n buffer) ) (define (a-card8 n buffer) (xa-card8 n buffer) ) (define (a-card16 n buffer) (xa-card16 n buffer) ) (define (a-card32 n buffer) (xa-card32 n buffer) ) (define (a-string8 string buffer) (pad4 (a-string8x string (string-length string) buffer) buffer) ) (define (a-str string buffer) (a-strx string (string-length string) buffer) )