Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Path: utzoo!mnetor!uunet!seismo!sundc!pitstop!sun!decwrl!decvax!ucbvax!ATHENA.MIT.EDU!roman From: roman@ATHENA.MIT.EDU (Roman J. Budzianowski) Newsgroups: comp.windows.x Subject: CLX under KCL (long) Message-ID: <8711021833.AA26397@JAREK.MIT.EDU> Date: Mon, 2-Nov-87 13:33:44 EST Article-I.D.: JAREK.8711021833.AA26397 Posted: Mon Nov 2 13:33:44 1987 Date-Received: Fri, 6-Nov-87 03:43:59 EST Sender: daemon@ucbvax.BERKELEY.EDU Organization: The ARPA Internet Lines: 490 Because of many inquiries I am posting some info here : Below is the code for the interface to tcp, files : kcltcp.c socket.c, kclx.lisp, inity.lisp and a part of dependent.lisp. You can ftp to jarek.mit.edu (18.72.0.204) login:clx , password:lisp between 10a.m-5p.m to get modified clx library and the demos. Here are some hints what to change to get clx to compile under kcl(I don't have diffs): buffer.lisp:131: :initial-element 0))) ;R-mod : needed by kcl buffer.lisp:154: :initial-element 0))) ;R-mod : needed by kcl fonts.lisp:63: (name) (type) ;R-mod input.lisp:111: (eofp)) ;R-mod ,because of kcl : eofp -> (eofp) input.lisp:802: (event-key) ;R-mod input.lisp:803: (temp)) ;R-mod macros.lisp:456: (result)) ;R-mod macros.lisp:473: (result)) ;R-mod requests.lisp:290: (len)) ;R-mod plus you have to move all calls to export to the beginning of the respective files. Roman. p.s. I don't distribute clx (it comes with X11 tape) and to get kcl you have to contact University of Texas, I believe. HERE COME THE CODE : *****kcltcp.c /* stream interface to tcp for kcl under BSD4.3*/ /* Roman Budzianowski - Project Athena/MIT */ /** * compile with * * cc -c kcltcp.c -DVAX -DMAXPAGE=16384 -DVSSIZE=8152 -I../h * * where h is the include directory in the kcl distribution **/ #include "include.h" #define kclgetc(FP) getc(FP) #define kclungetc(C, FP) ungetc(C, FP) #define kclfeof(FP) feof(FP) #define kclputc(C, FP) putc(C, FP) #ifdef BSD #include #endif #ifdef ATT #include #include #endif #ifdef E15 #include #define exec bhdr #define a_text tsize #define a_data dsize #define a_bss bsize #define a_syms ssize #define a_trsize rtsize #define a_drsize rdsize #endif object open_tcp_stream(host,port) object host; /* host name */ object port; /* port number */ { object streamTcp; int fd; /* file descriptor */ int i; char hname[BUFSIZ]; int portnumber; FILE *fout, *fin; object streamIn, streamOut, make_stream(); if (type_of(host) != t_string) FEerror("~S is wrong type for host (should be string).",1,host); if(type_of(port) != t_fixnum) FEerror("~S is wrong type for port (should be integer).",1,port); if (host->st.st_fillp > BUFSIZ - 1) too_long_file_name(host); for (i = 0; i < host->st.st_fillp; i++) hname[i] = host->st.st_self[i]; hname[i] = '\0'; portnumber = (int) fix(port); fd = connect_to_server(hname,portnumber); if(fd == 0) return Cnil; streamIn = make_stream(host,fd,smm_input); streamOut = make_stream(host,fd,smm_output); streamTcp = make_two_way_stream(streamIn,streamOut); return(streamTcp); } object make_stream(host,fd,smm) object host; /* not really used */ int fd; /* file descriptor */ enum smmode smm; /* lisp mode */ { object stream; char *mode; /* file open mode */ FILE *fp; /* file pointer */ vs_mark; switch(smm){ case smm_input: mode = "r"; break; case smm_output: mode = "w"; break; default: FEerror("make_stream : wrong mode"); } fp = fdopen(fd,mode); stream = alloc_object(t_stream); stream->sm.sm_mode = (short)smm; stream->sm.sm_fp = fp; fp->_base = BASEFF; stream->sm.sm_object0 = Sstring_char; stream->sm.sm_object1 = host; stream->sm.sm_int0 = stream->sm.sm_int1 = 0; vs_push(stream); setbuf(fp, alloc_contblock(BUFSIZ)); vs_reset; return(stream); } ***********socket.c /* * THIS IS AN OS DEPENDENT FILE! It should work on 4.2BSD derived * systems. VMS and System V should plan to have their own version. */ /*-liz This code was cribbed from X11 beta connection code in XLIB. * Compile using * % cc -c socket.c */ #include #include /*-liz*/ #include /*-liz*/ #include #include #include #include #include #include #ifdef UNIXCONN #include #define X_UNIX_PATH "/tmp/.X11-unix/X" #endif /* UNIXCONN */ void bcopy(); extern int errno; /* * Attempts to connect to server, given host and display. Returns file * descriptor (network socket) or 0 if connection fails. */ int connect_to_server (host, display) char *host; int display; { struct sockaddr_in inaddr; /* INET socket address. */ #ifdef UNIXCONN struct sockaddr_un unaddr; /* UNIX socket address. */ #endif struct sockaddr *addr; /* address to connect to */ struct hostent *host_ptr; int addrlen; /* length of address */ extern char *getenv(); extern struct hostent *gethostbyname(); int fd; /* Network socket */ { #ifdef UNIXCONN if ((host[0] == '\0') || (strcmp("unix", host) == 0)) { /* Connect locally using Unix domain. */ unaddr.sun_family = AF_UNIX; (void) strcpy(unaddr.sun_path, X_UNIX_PATH); strcat(unaddr.sun_path, display_ptr); addr = (struct sockaddr *) &unaddr; addrlen = strlen(unaddr.sun_path) + 2; /* * Open the network connection. */ if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0) return(0); /* errno set by system call. */ } else #endif { /* Get the statistics on the specified host. */ if ((inaddr.sin_addr.s_addr = inet_addr(host)) == -1) { if ((host_ptr = gethostbyname(host)) == NULL) { /* No such host! */ errno = EINVAL; return(0); } /* Check the address type for an internet host. */ if (host_ptr->h_addrtype != AF_INET) { /* Not an Internet host! */ errno = EPROTOTYPE; return(0); } /* Set up the socket data. */ inaddr.sin_family = host_ptr->h_addrtype; bcopy((char *)host_ptr->h_addr, (char *)&inaddr.sin_addr, sizeof(inaddr.sin_addr)); } else { inaddr.sin_family = AF_INET; } addr = (struct sockaddr *) &inaddr; addrlen = sizeof (struct sockaddr_in); inaddr.sin_port = display; inaddr.sin_port = htons(inaddr.sin_port); /* * Open the network connection. */ if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0){ return(0); /* errno set by system call. */} /* make sure to turn off TCP coalescence */ #ifdef TCP_NODELAY { int mi; setsockopt (fd, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof (int)); } #endif } if (connect(fd, addr, addrlen) == -1) { (void) close (fd); return(0); /* errno set by system call. */ } } /* * Return the id if the connection succeeded. */ return(fd); } ************kclx.lisp ;; ;; kcl lisp interface to the socket code ;; this file has to be compiled ;; (in-package 'tcp) (export 'open-tcp-stream) (defentry open-tcp-stream (object object) (object open_tcp_stream)) ;; *********init.lisp ;; (si:faslink "kclx.o" "kcltcp.o socket.o -lc") ;; ********dependent.lisp ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*- ;; This file contains some of the system dependent code for CLX ;;; ;;; TEXAS INSTRUMENTS INCORPORATED ;;; P.O. BOX 2909 ;;; AUSTIN, TEXAS 78769 ;;; ;;; Copyright (C) 1987 Texas Instruments Incorporated. ;;; ;;; Permission is granted to any individual or institution to use, copy, modify, ;;; and distribute this software, provided that this complete copyright and ;;; permission notice is maintained, intact, in all copies and supporting ;;; documentation. ;;; ;;; Texas Instruments Incorporated provides this software "as is" without ;;; express or implied warranty. ;;; (in-package "XLIB" :use '("LISP")) (export 'define-condition) (export 'default-error-handler) ;;; ;;; ;;; this is only part of the dependent.lisp ;;; ;;; ;;; ;;;----------------------------------------------------------------------------- ;;; System dependent IO primitives ;;; Functions for opening, reading writing forcing-output and closing ;;; the stream to the server. ;;;----------------------------------------------------------------------------- ;;; open-x-stream - create a stream for communicating to the appropriate X ;;; server #-(or explorer symbolics-3600 lucid kcl) (defun open-x-stream (host display protocol) host display protocol ;; unused (error "OPEN-X-STREAM not implemented yet.")) #+symbolics-3600 (defun open-x-stream (host display protocol) protocol ;; unused (tcp:open-tcp-stream host (+ *x-tcp-port* display) nil :direction :io :characters nil :ascii-translation nil)) #+explorer (defun open-x-stream (host display protocol) protocol ;; unused (ip:open-stream host :remote-port (+ *x-tcp-port* display) :direction :bidirectional :characters t :timeout-after-open nil)) #+lucid (defun open-x-stream (host display protocol) protocol ;; unused (let ((fd (connect-to-server host (+ *x-tcp-port* display)))) (when (minusp fd) (error "Failed to connect to server: ~A ~D" host display)) (user::make-lisp-stream :input-handle fd :output-handle fd :element-type 'unsigned-byte :stream-type :ephemeral))) ;; ;; here is the code for kcl ;; #+kcl (defun open-x-stream (host display protocol) protocol ;; unused (let ((stream (tcp:open-tcp-stream host (+ *x-tcp-port* display)))) (if (streamp stream) stream (error "Cannot connect to server: ~A:~D" host display)))) ;;; buffer-read-default - read data from the X stream #+(or symbolics-3600 explorer) (defun buffer-read-default (display vector start end timeout) ;; returns non-NIL if EOF encountered ;; Returns :TIMEOUT when timeout exceeded (declare (type display display) (type buffer-bytes vector) (type array-index start end) (type (or null number) timeout)) (declare-buffun) (let ((stream (display-input-stream display)) (eofp nil)) (when timeout (unless (sys:process-wait-with-timeout "X Server" (round (* timeout 60.)) stream :listen) (setq eofp :timeout))) (unless eofp (multiple-value-setq (nil eofp) (funcall stream :string-in nil vector start end))) eofp)) #+debug (defun buffer-read-default (display vector start end timeout) (declare (type display display) (type buffer-bytes vector) (type array-index start end) (type (or null number) timeout)) (declare-buffun) (declare (ignore timeout)) (terpri) ;debug (format t "READ : from ~D to ~D ~A" start end #\newline) (do* ((stream (display-input-stream display)) (i start (index+ i 1)) (c nil)) ((index>= i end) nil) (declare (type array-index i) (type stream stream) (type (or null card8) c)) (setq c (read-byte stream nil nil)) ;; debug (if c (format t "~A " c)) ;; (if c (setf (aref vector i) c) (return t)))) #-(or symbolics-3600 explorer debug) (defun buffer-read-default (display vector start end timeout) (declare (type display display) (type buffer-bytes vector) (type array-index start end) (type (or null number) timeout)) (declare-buffun) (declare (ignore timeout)) (do* ((stream (display-input-stream display)) (i start (index+ i 1)) (c nil)) ((index>= i end) nil) (declare (type array-index i) (type stream stream) (type (or null card8) c)) (setq c (read-byte stream nil nil)) (if c (setf (aref vector i) c) (return t)))) ;;; buffer-write--default - write data to the X stream #+(or symbolics-3600 explorer) (defun buffer-write-default (vector display start end) ;; The default buffer write function for use with common-lisp streams (declare (type buffer-bytes vector) (type display display) (type array-index start end)) (declare-buffun) (write-string vector (display-output-stream display) :start start :end end)) #+debug (defun buffer-write-default (vector display start end) ;; The default buffer write function for use with common-lisp streams (declare (type buffer-bytes vector) (type display display) (type array-index start end)) (declare-buffun) (terpri) ;debug (format t "WRITE : from ~D to ~D ~A" start end #\newline) (with-vector (vector buffer-bytes) (do ((stream (display-output-stream display)) (index start (index+ index 1))) ((index>= index end)) (declare (type stream stream) (type array-index index)) ;; (format t "~A " (aref vector index)) ;; (write-byte (aref vector index) stream)))) #-(or symbolics-3600 explorer debug) (defun buffer-write-default (vector display start end) ;; The default buffer write function for use with common-lisp streams (declare (type buffer-bytes vector) (type display display) (type array-index start end)) (declare-buffun) (with-vector (vector buffer-bytes) (do ((stream (display-output-stream display)) (index start (index+ index 1))) ((index>= index end)) (declare (type stream stream) (type array-index index)) (write-byte (aref vector index) stream)))) ;;; buffer-force-output-default - force output to the X stream (defun buffer-force-output-default (display) ;; The default buffer force-output function for use with common-lisp streams (declare (type display display)) (force-output (display-output-stream display))) ;;; buffer-close-default - close the X stream (defun buffer-close-default (display &key abort) ;; The default buffer close function for use with common-lisp streams (declare (type display display)) (declare-buffun) (close (display-output-stream display) :abort abort)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;