mirror of
https://github.com/Interlisp/maiko.git
synced 2026-02-02 14:51:23 +00:00
Maiko sources matching state as of 020102 prior to initial patching for Mac OSX
This commit is contained in:
Nick Briggs
322
src/socdvr.c
Executable file
322
src/socdvr.c
Executable file
@@ -0,0 +1,322 @@
|
||||
/* $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. */
|
||||
/* */
|
||||
/* The contents of this file are proprietary information */
|
||||
/* belonging to Venue, and are provided to you under license. */
|
||||
/* They may not be further distributed or disclosed to third */
|
||||
/* parties without the specific permission of Venue. */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
#include "version.h"
|
||||
|
||||
|
||||
|
||||
#include <stdio.h>
|
||||
#include <sys/time.h>
|
||||
#include <sys/file.h>
|
||||
#include <errno.h>
|
||||
#include <X11/Xproto.h>
|
||||
|
||||
#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. */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
Open_Socket( args )
|
||||
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. */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
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
|
||||
|
||||
Read_Socket( args )
|
||||
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. */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
Write_Socket( args )
|
||||
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;
|
||||
|
||||
Kbd_Transition( args )
|
||||
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 */
|
||||
Reference in New Issue
Block a user