/* $Id: socdvr.c,v 1.2 1999/01/03 02:07:33 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ static char *id = "$Id: socdvr.c,v 1.2 1999/01/03 02:07:33 sybalsky Exp $ Copyright (C) Venue"; /************************************************************************/ /* */ /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ /* Manufactured in the United States of America. */ /* */ /************************************************************************/ #include "version.h" #include #include #include #include #include #include "lispemul.h" #include "arith.h" #include "adr68k.h" #include "lsptypes.h" #include "lispmap.h" #define min(x, y) (((x) > (y)) ? (y) : (x)) /***********************************************************/ /* L S t r i n g T o C S t r i n g */ /* */ /* Convert a lisp string to a C string up to MaxLen long. */ /***********************************************************/ #define LStringToCString(Lisp, C, MaxLen, Len) \ { \ OneDArray *arrayp; \ char *base; \ short *sbase; \ int i; \ \ arrayp = (OneDArray *)(Addr68k_from_LADDR((unsigned int)Lisp)); \ Len = min(MaxLen, arrayp->fillpointer); \ \ switch (arrayp->typenumber) { \ case THIN_CHAR_TYPENUMBER: \ base = \ ((char *)(Addr68k_from_LADDR((unsigned int)arrayp->base))) + ((int)(arrayp->offset)); \ for (i = 0; i < Len; i++) C[i] = base[i]; \ C[Len] = '\0'; \ break; \ \ case FAT_CHAR_TYPENUMBER: \ sbase = \ ((short *)(Addr68k_from_LADDR((unsigned int)arrayp->base))) + ((int)(arrayp->offset)); \ base = (char *)sbase; \ for (i = 0; i < Len * 2; i++) C[i] = base[i]; \ C[Len * 2] = '\0'; \ break; \ \ default: error("LStringToCString can not handle\n"); \ } \ } #define FGetNum(ptr, place) \ { \ if (((ptr)&SEGMASK) == S_POSITIVE) { \ (place) = ((ptr)&0xffff); \ } else if (((ptr)&SEGMASK) == S_NEGATIVE) { \ (place) = (int)((ptr) | 0xffff0000); \ } else { \ return (NIL); \ } \ } #define MAX_NAME_LEN 256 static char XServer_Name[MAX_NAME_LEN]; /* Name of host with X server */ static int XPort_Number = 0; /* Display # to ask for on it */ int XServer_Fd = -1; /* The socket for the X server */ extern DLword *Lisp_world; /************************************************************************/ /* */ /* O p e n _ S o c k e t */ /* */ /* Open a connection to an X server, by calling the CLX routine */ /* "connect_to_server". Returns T if successful, and NIL if not. */ /* The socket's fd is left in XServer_Fd, a global, so only one */ /* server connection can be open at one time (FIX THIS). */ /* */ /* args[0] - The lisp string name of the host the server is on */ /* args[1] - The SMALLP server-number we're connecting to. */ /* */ /************************************************************************/ LispPTR Open_Socket(LispPTR *args) { #ifdef TRACE printf("TRACE: Open_Socket()\n"); #endif int length; LStringToCString(args[0], XServer_Name, MAX_NAME_LEN, length); FGetNum(args[1], XPort_Number); XPort_Number -= X_TCP_PORT; if (XServer_Fd == -1) { XServer_Fd = connect_to_server(XServer_Name, XPort_Number); if (XServer_Fd < 0) /* error in connect. */ { perror("connecting to X server"); return (NIL); } { /* Make it non-blocking I/O */ int res; res = fcntl(XServer_Fd, F_GETFL); res |= FNDELAY; res = fcntl(XServer_Fd, F_SETFL, res); } } /* end if(XServer_Fd) */ return (ATOM_T); } /************************************************************************/ /* */ /* C l o s e _ S o c k e t */ /* */ /* Close the socket connection to the X server. */ /* */ /************************************************************************/ LispPTR Close_Socket() { int stat; #ifdef TRACE printf("TRACE: Close_Socket()\n"); #endif if ((stat = close(XServer_Fd)) == -1) { /* close failed; return NIL, but squash the old fd anyhow */ XServer_Fd = -1; perror("Close_socket"); return (NIL); } else { /* close succeeded; return T. */ XServer_Fd = -1; return (ATOM_T); } } /* end Close_Socket */ /************************************************************************/ /* */ /* R e a d _ S o c k e t */ /* */ /* Read up to 1 packet's worth from the X-server socket. */ /* */ /************************************************************************/ typedef struct { /* Format for an X-server packet */ DLword nil[22]; /* Packet header */ DLword length; /* Request byte length */ char data[592]; /* Data body */ } PACKET; #define PACKET_DEFOFFSET 46 #define PACKET_MAXSIZE 638 LispPTR Read_Socket(LispPTR *args) { PACKET *packet; char *buffer; int length, actlen; #ifdef TRACE printf("TRACE: Read_Socket()\n"); #endif if (XServer_Fd >= 0) { packet = (PACKET *)Addr68k_from_LADDR(args[0]); if ((length = (int)(packet->length) - PACKET_DEFOFFSET) > 0) { buffer = &(packet->data[0]); if ((actlen = read(XServer_Fd, buffer, length)) > 0) { packet->length = (DLword)(actlen + PACKET_DEFOFFSET); return (ATOM_T); } /* end if(actlen) */ if (actlen < 0) /* error !*/ { if ((errno != EWOULDBLOCK) & (errno != EINTR)) perror("reading X connection"); return (NIL); } } /* end if(length) */ } /* end if( fd ) */ return (NIL); } /* end Read_Socket */ /************************************************************************/ /* */ /* W r i t e _ S o c k e t */ /* */ /* Write a packet of information to the X server's socket. */ /* */ /************************************************************************/ LispPTR Write_Socket(LispPTR *args) { PACKET *packet; char *buffer; int length, actlen; #ifdef TRACE printf("TRACE: Write_Socket()\n"); #endif if (XServer_Fd >= 0) { packet = (PACKET *)Addr68k_from_LADDR(args[0]); if ((length = (int)(packet->length) - PACKET_DEFOFFSET) > 0) { buffer = &(packet->data[0]); if ((actlen = write(XServer_Fd, buffer, length)) > 0) { packet->length = (DLword)(actlen + PACKET_DEFOFFSET); return (ATOM_T); } /* end if( actlen ) */ if (actlen < 0) /* error !*/ { if (errno != EINTR) perror("writing X connection"); return (NIL); } } /* end if(length) */ } /* end if( fd ) */ packet->length = 0; return (NIL); } /* end Write_Socket */ /************************************************************************/ /* */ /* K b d _ T r a n s i t i o n */ /* */ /* Stuff a key transition into the C-level buffer from Lisp. */ /* */ /* args[0] - the key number (in lisps terms? Not sure) */ /* args[1] - upflg -- is it an up or down-transition? */ /* */ /************************************************************************/ extern int KBDEventFlg; void Kbd_Transition(LispPTR *args) /* args[0] is key-number */ /* args[1] is up-flg */ { DLword key_number; key_number = (DLword)(args[0] & 0xffff); if (args[1]) kb_trans(key_number, 1); else kb_trans(key_number, 0); DoRing(); /* If there's something for lisp to do, ask for an interrupt: */ if ((KBDEventFlg += 1) > 0) Irq_Stk_End = Irq_Stk_Check = 0; } /* end Kbd_Transition */