rsalz@bbn.com (Rich Salz) (05/18/88)
Submitted-by: libes@cme-durer.ARPA (Don Libes)
Posting-number: Volume 14, Issue 95
Archive-name: sharedmem/part02
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 2 (of 4)."
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'src/Luser.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/Luser.c'\"
else
echo shar: Extracting \"'src/Luser.c'\" \(2973 characters\)
sed "s/^X//" >'src/Luser.c' <<'END_OF_FILE'
X/*
X
XThese are the Lisp covering functions for the common memory system.
X
XThey are:
X
Xint Lcm_init(process_name,host,debug_level)
Xvoid Lcm_exit()
Xcm_variable *Lcm_declare(name,role)
Xvoid Lcm_undeclare(var)
Xint Lcm_sync(wait)
Xvoid Lcm_set_value(var,val)
Xvoid Lcm_get_value(var,val)
Xint Lcm_set_new_command_value(command_out,command_value)
Xint Lcm_new_command_pending(input_command)
Xint Lcm_get_new_command_value(input_command,cm_value)
Xint Lcm_status_equal(command_out,status_in,status_value)
Xint Lcm_status_synchronized(command_out,status_in)
Xvoid cm_set_status_value(status_out,status_value)
Xvoid Lcm_print_variable(name)
X*/
X
X#include <stdio.h>
X#include <sys/time.h>
X#include "global.h" /* comes from /usr/local/include/franz */
X#include "cm_constants.h"
X#include "cm_sd.h"
X#include "cm_var.h"
X#include "cm_interface.h"
X
X#define MAXSTRLEN 1500 /* ugh */
X
Xlispval
XLcm_init(name,host,debug_level)
Xchar *name;
Xchar *host;
Xint *debug_level;
X{
X return(inewint(cm_init(name,host,*debug_level)));
X}
X
Xvoid
XLcm_exit()
X{
X cm_exit();
X}
X
Xcm_variable *
XLcm_declare(name,role)
Xchar *name;
Xlong int *role;
X{
X cm_variable *p;
X
X p = cm_declare(name,(unsigned)*role);
X eprintf(10,"cm_declare() = %x\n",p);
X return(p);
X}
X
Xvoid
XLcm_undeclare(var)
Xint *var;
X{
X cm_undeclare(*var);
X}
X
Xint
XLcm_sync(wait)
Xlong int *wait;
X{
X return(cm_sync((int)*wait));
X}
X
Xvoid
XLcm_set_value(var,val)
Xint *var;
Xlispval val; /* was union structured_data **val; */
X{
X/*
Xprintf("entering Lcm_set_value\n"); fflush(stdout);
Xprintf("value is <%s>\n",(char *)val); fflush(stdout);
Xprintf("var is %x\n",var); fflush(stdout);
Xprintf("*var is %x\n",*var); fflush(stdout);
Xprintf("**var is %x\n",*(int *)*var); fflush(stdout);
X*/
X cm_set_value(*var,(char *)val);
X}
X
X/* note this new version will not correctly return anything but
Xstructured_data objects!!! */
Xvoid
XLcm_get_value(var,val)
Xcm_variable **var;
Xlispval val;
X{
X cm_get_value(*var,(char *)val);
X}
X
Xint
XLcm_set_new_command_value(var,val)
Xcm_variable **var;
Xunion structured_data **val;
X{
X cm_set_new_command_value(*var,*val);
X}
X
Xint
XLcm_new_command_pending(cmd)
Xcm_command_variable *cmd;
X{
X return(cm_new_command_pending(*cmd));
X}
X
Xint
XLcm_get_new_command_value(cmd,val)
Xcm_command_variable *cmd;
Xunion structured_data **val;
X{
X return(cm_get_new_command_value(*cmd,*val));
X}
X
Xint
XLcm_status_equal(cmd,status_in,status_val)
Xcm_command_variable *cmd;
Xcm_status_variable **status_in;
Xunion structured_data **status_val;
X{
X return(cm_status_equal(*cmd,*status_in,*status_val));
X}
X
Xint
XLcm_status_synchronized(command_out,status_in)
Xcm_command_variable *command_out;
Xcm_status_variable **status_in;
X{
X return(cm_status_synchronized(*command_out,*status_in));
X}
X
Xvoid
XLcm_set_status_value(command_in,status_out,status_value)
Xcm_command_variable **command_in;
Xcm_status_variable **status_out;
Xunion structured_data **status_value;
X{
X cm_set_status_value(*command_in,*status_out,*status_value);
X}
X
Xvoid
XLcm_print_variable(name)
Xchar *name;
X{
X cm_print_variable(name);
X}
END_OF_FILE
if test 2973 -ne `wc -c <'src/Luser.c'`; then
echo shar: \"'src/Luser.c'\" unpacked with wrong size!
fi
# end of 'src/Luser.c'
fi
if test -f 'src/Makefile' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/Makefile'\"
else
echo shar: Extracting \"'src/Makefile'\" \(4756 characters\)
sed "s/^X//" >'src/Makefile' <<'END_OF_FILE'
XMAN.C=man.c man_get_slot.c man_put_slot.c
XMAN.O=man.o man_get_slot.o man_put_slot.o
XCOMMON.C=put_slot.c name.c cm_time.c cm_sd.c msg.c cm_util.c
XCOMMON.O=put_slot.o name.o cm_time.o cm_sd.o msg.o cm_util.o
XUSER.C=usr_var.c usr_get_slot.c usr_put_slot.c cm_usr1.c cm_usr2.c
XUSER.O=usr_var.o usr_get_slot.o usr_put_slot.o cm_usr1.o cm_usr2.o
XLUSER.C=Luser.c
XLUSER.O=Luser.o
XLIBS=/usr/local/lib/libstream.a
XCMLIB=libcm.a
XMBLIB=/usr/local/lib/mailbox.o
XLINCLUDE=/usr/local/include
XCFLAGS=-g -I$(LINCLUDE)/inet/stream -Ifranz -DCMM_VERSION=7
XLINTFLAGS=-I$(LINCLUDE)/inet/stream -Ifranz -DCMM_VERSION=7
XHFILES=cm.h cm_bytestuff.h cm_constants.h cm_interface.h cm_man.h cm_msg.h \
X cm_sd.h cm_slot.h cm_sync.h cm_time.h cm_var.h
XLISPHFILES=config.h dfuncs.h global.h lconf.h lstructs.h ltypes.h\
X module.h public.h sigtab.h
X
X# demonstrate various cm_sync options
XEXAMPLE1=client1a client1b server1y server1z
X
X# demonstrate passing various C types (in a machine-dependent way)
XEXAMPLE2=client2 server2
X
X# demonstrate AMRF-style mailboxes in c & Lisp
X# some names are in uppercase to accomodate the outside world (nip, vax cmm)
X# non-NBS people should ignore this example
X# EXAMPLE6=client6 server6
X
X# provoke bad user behavior
X# 8a is a reader that never reads its input
X# 8b is designed to have a high probability of exiting while cmm is writing
X# to it, thereby signalling the cmm with a SIGPIPE
XEXAMPLE8=client8 server8a server8b
X
Xnormal: $(CMLIB) $(LUSER.O)
X
Xcleanup:
X rm $(MAN.O) $(COMMON.O) $(LUSER.O) $(CMLIB)
X
Xinstall: $(CMLIB) $(LUSER.O) makedirs
X cp cmm /usr/local/bin
X cp $(HFILES) /usr/local/include/cm
X sh -c 'cd franz;cp `echo *` /usr/local/include/franz'
X cp $(CMLIB) $(LUSER.O) /usr/local/lib
X cp cm.lisp /usr/local/lisp
X
Xshar:
X ls franz > shar-input
X cat shar-input | sed 's/^/franz\//' > tmp
X ls Makefile README $(HFILES) $(MAN.C) $(COMMON.C) $(USER.C) \
X server1z.c server1y.c client1a.c client1b.c \
X server2.c client2.c server8a.c server8b.c client8.c \
X $(LUSER.C) cm.lisp >> tmp
X cat tmp | sed 's/^/src\//' > shar-input
X
Xmakedirs: /usr/local/include/cm /usr/local/include/franz /usr/local/lisp
X
X/usr/local/lisp:
X mkdir /usr/local/lisp
X
X/usr/local/include/cm:
X mkdir /usr/local/include/cm
X
X/usr/local/include/franz:
X mkdir /usr/local/include/franz
X
Xvws: Lvws.o vws.o $(USER.O) $(COMMON.O) $(CMLIB)
X cc $(CFLAGS) -o vws vws.o $(MBLIB) $(CMLIB) $(LIBS)
X
Xlint: lintcmm lintuser
X
Xlintc:
X lint -Ccm $(USER.C) $(COMMON.C) -lstream
X
Xexamples: $(LUSER.O) $(EXAMPLE1) $(EXAMPLE2) $(EXAMPLE6) $(EXAMPLE8)
X
X$(CMLIB): cmm $(MAN.O) $(USER.O) $(COMMON.O)
X ar cr $(CMLIB) `lorder $(USER.O) $(COMMON.O) | tsort`
X ranlib $(CMLIB)
X
Xserver1z: server1z.o $(USER.O) $(COMMON.O) $(CMLIB)
X cc $(CFLAGS) -o server1z server1z.o $(CMLIB) $(LIBS)
X
Xserver1y: server1y.o $(USER.O) $(COMMON.O) $(CMLIB)
X cc $(CFLAGS) -o server1y server1y.o $(CMLIB) $(LIBS)
X
Xclient1a: client1a.o $(USER.O) $(COMMON.O) $(CMLIB)
X cc $(CFLAGS) -o client1a client1a.o $(CMLIB) $(LIBS)
X
Xclient1b: client1b.o $(USER.O) $(COMMON.O) $(CMLIB)
X cc $(CFLAGS) -o client1b client1b.o $(CMLIB) $(LIBS)
X
Xserver2: server2.o $(USER.O) $(COMMON.O) $(CMLIB)
X cc $(CFLAGS) -o server2 server2.o $(CMLIB) $(LIBS)
X
Xclient2: client2.o $(USER.O) $(COMMON.O) $(CMLIB)
X cc $(CFLAGS) -o client2 client2.o $(CMLIB) $(LIBS)
X
Xclient6: client6.o $(USER.O) $(COMMON.O) $(CMLIB)
X cc $(CFLAGS) -o client6 client6.o $(MBLIB) $(CMLIB) $(LIBS)
X
Xserver6: server6.o $(USER.O) $(COMMON.O) $(CMLIB)
X cc $(CFLAGS) -o server6 server6.c $(MBLIB) $(CMLIB) $(LIBS)
X
Xclient8: client8.o $(USER.O) $(COMMON.O) $(CMLIB)
X cc $(CFLAGS) -o client8 client8.c $(CMLIB) $(LIBS)
X
Xserver8a: server8a.o $(USER.O) $(COMMON.O) $(CMLIB)
X cc $(CFLAGS) -o server8a server8a.c $(CMLIB) $(LIBS)
X
Xserver8b: server8b.o $(USER.O) $(COMMON.O) $(CMLIB)
X cc $(CFLAGS) -o server8b server8b.c $(CMLIB) $(LIBS)
X
Xcmm: $(MAN.O) $(COMMON.O)
X cc $(CFLAGS) -o cmm $(MAN.O) $(COMMON.O) $(LIBS)
X
Xlintcmm:
X lint $(LINTFLAGS) $(MAN.C) $(COMMON.C) -lstream | tee cmm.lint
X
Xlintuser:
X lint -u $(LINTFLAGS) $(USER.C) $(COMMON.C) -lstream | tee user.lint
X
XLuser.o: cm_constants.h cm_sd.h cm_var.h cm_interface.h
X
Xcm_usr1.o: cm_constants.h cm_sd.h cm_interface.h cm_sync.h cm_msg.h cm_slot.h cm_time.h
X
Xcm_usr2.o: cm_constants.h cm_sd.h cm_var.h cm_interface.h
X
Xusr_put_slot.o: cm_bytestuff.h cm_msg.h cm_slot.h cm_interface.h
X
Xmsg.o: cm_constants.h cm_slot.h cm_sd.h cm_msg.h
X
Xput_slot.o: cm_constants.h cm_slot.h cm_sd.h cm_msg.h
X
Xman_get_slot.o: cm_constants.h cm_var.h cm_slot.h cm_man.h cm_sd.h cm_msg.h cm_time.h
X
Xman_put_slot.o: cm_constants.h cm_slot.h cm_sd.h
X
Xman.o: cm_constants.h cm_var.h cm_slot.h cm_time.h cm_man.h cm_sd.h cm_msg.h
X
Xcm_sd.o: cm_sd.h cm_var.h
X
Xusr_get_slot.o: cm_constants.h cm_sd.h cm_interface.h cm_slot.h
X
Xusr_var.o: cm_sd.h cm_interface.h
END_OF_FILE
if test 4756 -ne `wc -c <'src/Makefile'`; then
echo shar: \"'src/Makefile'\" unpacked with wrong size!
fi
# end of 'src/Makefile'
fi
if test -f 'src/cm_interface.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/cm_interface.h'\"
else
echo shar: Extracting \"'src/cm_interface.h'\" \(2918 characters\)
sed "s/^X//" >'src/cm_interface.h' <<'END_OF_FILE'
X/* cm_interface.h - interface to common memory
XDefinitions of types used in the handshaking package
X*/
X
X#ifndef TRUE
X#define TRUE 1
X#define FALSE 0
X#endif
X
X#define or ||
X#define and &&
X#define OR ||
X#define AND &&
X
X#ifndef BOOLEAN
X#define BOOLEAN
Xtypedef int boolean;
X#endif
X
X#define ANY_STATUS 0
X
X/* definitions for command associations */
Xtypedef int cm_command_association;
X#define cm_set_command_association(cmd,assoc) \
X cmd->command_association = (assoc)
X#define cm_get_command_association(cmd,assoc) \
X ((assoc) = cmd->command_association)
X/* was ((*(assoc)) = cmd->command_association) */
Xextern cm_command_association input_command_association;
X
X#define var_in_use(v) (v->inuse)
X
Xstruct usr_var_role {
X unsigned reader : 1;
X unsigned nonxwriter : 1;
X unsigned xwriter : 1;
X unsigned wakeup : 1;
X};
X
Xtypedef struct {
X char name[CM_VARIABLENAMELENGTH];
X cm_value data; /* actual user data */
X struct usr_var_role role;
X unsigned long old_count; /* when last read */
X unsigned long count; /* nth definition of this var */
X /* zero means "never been written" */
X
X /* the following are tags noting: */
X int old_command_association; /* when last read */
X int command_association; /* unique identifier tieing this to a
X single command and multiple
X statii */
X struct timeval timestamp; /* when this data was written */
X /* the following is not transmitted to the cmm */
X struct {
X unsigned declared : 1;
X unsigned written : 1;
X unsigned inuse : 1;
X unsigned undeclared : 1;
X } status;
X} cm_variable, cm_command_variable, cm_status_variable;
X
X/* the following definitions are correctly eaten by the C compiler */
Xcm_value *cm_get_value();
Xvoid cm_set_value();
Xboolean cm_get_new_command_value();
Xvoid cm_set_new_command_value();
Xboolean cm_new_command_pendingp();
X/* if these remain as macros, the C preprocessor no longer cares for */
X/* these lines */
X/*cm_command_association cm_get_command_association();*/
X/*cm_set_command_association cm_command_association();*/
Xboolean cm_status_equal();
Xboolean cm_status_synchronizedp();
Xvoid cm_set_status_value();
Xcm_variable *cm_declare();
Xcm_variable *next_user_variable();
X
X#define cm_command_association int
X
X/*
XFunctions used in the handshaking package
X
XThis is a list of definitions that includes arguments which the current C
Xcompilers do not care for.
X
Xcm_get_value(cm_variable,cm_value)
Xcm_set_value(cm_variable,cm_value)
Xboolean cm_get_new_command_value(cm_variable,value)
Xcm_set_new_command_value(cm_variable,value)
Xboolean cm_new_command_pending?(cm_variable)
Xcm_command_association cm_get_command_association(cm_variable,
X command_association)
Xcm_set_command_association cm_command_association(cm_variable,
X command_association)
Xboolean cm_status_equal(command_variable,status_variable,status_value)
Xboolean cm_status_synchronized(command_variable,status_variable)
Xcm_set_status_value(status_variable,cm_value)
X
X*/
X
END_OF_FILE
if test 2918 -ne `wc -c <'src/cm_interface.h'`; then
echo shar: \"'src/cm_interface.h'\" unpacked with wrong size!
fi
# end of 'src/cm_interface.h'
fi
if test -f 'src/cm_sd.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/cm_sd.c'\"
else
echo shar: Extracting \"'src/cm_sd.c'\" \(3111 characters\)
sed "s/^X//" >'src/cm_sd.c' <<'END_OF_FILE'
X/* cm_sd.c
Xstructured data functions
X
XThese functions will be used by the user when doing cm_set_value's
X
Xi.e. cm_set_value(variable,value)
X
XThese will also be used when sending/receiving values to/from the cmm.
X
Xcm_sd_to_flat(sd,flat)
Xcm_flat_to_sd(flat,sd)
Xcm_sd_copy(from,to)
Xcm_sd_clear(sd) - clear initially
Xcm_sd_free(sd) - release old storage and clear
Xcm_sd_equal(value1,value2) - returns true if value1 == value2
X
X*/
X
X#include <stdio.h>
X#include <strings.h>
X#include "cm_sd.h"
X#include "cm_var.h"
X
X#define min(x,y) (((x)<(y))?(x):(y))
X
X#define TRUE 1
X#define FALSE 0
X
Xchar *malloc();
X
Xstatic int ssresize();
X
X/* return 0 if success, negative if failure */
Xint
Xcm_sd_copy(from,to)
Xcm_value *from;
Xcm_value *to;
X{
X if (from->data == 0) {
X /* can happen if read before set */
X to->size = 0;
X return(0);
X }
X
X if (0 > ssresize(to,from->size)) return(-1);
X /* if not mallocable, it is possible to->msize < from->size */
X to->size = min(from->size,to->msize);
X
X /* if user supplied us with 0 size, then to->data may still == 0,
X /* so, don't call safebcopy which checks for zero pointers */
X if (to->data != 0) {
X safebcopy(from->data,to->data,to->size);
X } /* else to->size = 0; */
X return(0);
X}
X
X/* convert sd style data to flattened out data - ready for transmission */
X/* return size of flattened result */
Xint
Xcm_sd_to_flat(sd,f)
Xstruct cm_value *sd;
Xstruct cm_flattened_data *f;
X{
X safebcopy(sd->data,f->data,sd->size);
X f->size = sd->size;
X return(sd->size + sizeof(f->size));
X}
X
X/* convert transmitted data to sd style data - ready for local storage */
X/* return 0 if ok, negative if problems */
Xint
Xcm_flat_to_sd(f,sd)
Xstruct cm_flattened_data *f;
Xcm_value *sd;
X{
X if (0 > ssresize(sd,f->size)) return(-1);
X
X sd->size = min(f->size,sd->msize);
X
X if (sd->data != NULL) {
X /* if user supplied us with zero-size, then */
X /* sd->...size may still equal zero, so don't call */
X /* safebcopy which may check for zero pointers. */
X safebcopy(f->data,sd->data,sd->size);
X }
X
X return(0);
X}
X
X/* resize that takes short ints */
X/* return 0 if resize succeeded or not mallocable */
X/* return -1 if resize failed */
Xstatic int
Xssresize(s,newsize)
Xcm_value *s;
Xint newsize;
X{
X if (!s->mallocable) return(0);
X
X eprintf(9,"ssresize(data:%x,old:%x,new:%x) ",s->data,s->msize,newsize);
X if (s->msize >= newsize) {
X eprintf(9,"msize >= newsize\n");
X return(0);
X }
X if (s->data != NULL) {
X eprintf(9,"free(data)");
X free(s->data);
X }
X eprintf(9," malloc(%x)",newsize);
X if (NULL == (s->data = malloc((unsigned int)newsize))) {
X fprintf(stderr,"resized failed! - out of space\n");
X s->msize = s->size = 0;
X return(-1);
X } else s->msize = newsize;
X return(0);
X}
X
X/* zero the various fields in the sd structures */
Xcm_sd_clear(sd)
Xcm_value *sd;
X{
X sd->msize = 0;
X sd->size = 0;
X sd->data = NULL;
X sd->mallocable = TRUE;
X}
X
Xcm_sd_free(sd)
Xcm_value *sd;
X{
X if (!sd->mallocable) {
X fprintf(stderr,"cm_sd_free() called on nonmallocable object?\n");
X return;
X }
X
X free(sd->data);
X cm_sd_clear(sd);
X}
X
Xint
Xcm_sd_equal(x,y)
Xstruct cm_value *x, *y;
X{
X return(bcmp(x->data,y->data,x->size));
X}
END_OF_FILE
if test 3111 -ne `wc -c <'src/cm_sd.c'`; then
echo shar: \"'src/cm_sd.c'\" unpacked with wrong size!
fi
# end of 'src/cm_sd.c'
fi
if test -f 'src/cm_slot.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/cm_slot.h'\"
else
echo shar: Extracting \"'src/cm_slot.h'\" \(3894 characters\)
sed "s/^X//" >'src/cm_slot.h' <<'END_OF_FILE'
X/*
X
XThis file contains definitions relating to message passing between
Xthe CM manager and user.
X
XSlots types are
X*/
X
X#define CM_SLOT_NULL 0
X#define CM_SLOT_DECLARE 1
X#define CM_SLOT_WRITE 2
X#define CM_SLOT_READ 3
X#define CM_SLOT_READ_RESPONSE 4
X#define CM_SLOT_ERROR 6
X#define CM_SLOT_UNDECLARE 7
X
X/* slot handling errors */
X#define E_CM_SLOT_OK 0
X#define E_CM_GET_SLOT_UNKNOWN_SLOT_TYPE -1
X#define E_CM_GET_SLOT_GET_VARIABLE -2
X#define E_CM_GET_SLOT_FLAT_TO_SD -3
X#define E_CM_GET_SLOT_BAD_INUSE -4 /* we have received a
X /* declaration, declared it, and yet it ended up with
X /* no readers or writers? */
X
X/* semantic user errors */
X#define E_CM_DECLARE_CANT_GET_XWRITE_ACCESS -4
X#define E_CM_DECLARE_GET_VARIABLE_NO_SPACE -6
X
X#define E_CM_WRITE_NOT_DECLARED_YET -7
X#define E_CM_WRITE_NOT_WRITER -8
X
X#define E_CM_READ_NOT_DECLARED_YET -9
X#define E_CM_READ_NOT_READER -10
X
X#define E_CM_UNDECLARE_UNDECLARE -11
X
X/*
XThis slot is sent by the manager back to the user in response to a
XSLOT_READ.
X*/
X
Xstruct slot_read_response_hdr {
X unsigned long count;
X struct timeval timestamp;
X int command_association;
X};
X
X#define srr_count srr_hdr.count
X#define srr_timestamp srr_hdr.timestamp
X#define srr_command_association srr_hdr.command_association
X
Xstruct slot_read_response {
X struct slot_read_response_hdr srr_hdr;
X /* the following two entries are the flattened out sdata structure */
X /* and should probably be declared that way */
X struct cm_flattened_data fdata; /* flattened data */
X};
X
X/*
XThis slot is sent by the user to the manager when writing a value
X*/
X
Xstruct slot_write_hdr {
X int command_association;
X/* union flattened_data fdata;*/
X};
X
X#define sw_command_association sw_hdr.command_association
X
Xstruct slot_write {
X struct slot_write_hdr sw_hdr;
X struct cm_flattened_data fdata;
X};
X
X#if 0
X/* this slot is sent to the manager when requesting a variable value.
XCurrently, it is empty, but since the C compiler doesn't like empty
Xstructures we put in a single character (that will never be looked at)
X*/
Xstruct slot_read {
X char dummy; /* this is not used except to take up space */
X};
X#endif
X
Xstruct slot_role {
X unsigned reader : 1;
X unsigned wakeup : 1;
X unsigned xwriter : 1;
X unsigned nonxwriter : 1;
X};
X
X/* this slot is sent by the user to the manager when declaring variables */
Xstruct slot_declare {
X int command_association;
X struct slot_role role;
X};
X
X/* this slot is sent by the user to the manager when undeclaring variables */
Xstruct slot_undeclare {
X char dummy; /* this is not used except to take up space */
X};
X
X/* this slot is sent to the user for a number of reasons (all bad!) */
Xstruct slot_error_hdr {
X /* unsigned size; */
X int type; /* type of error */
X};
X
X#define se_type se_hdr.type
X
Xstruct slot_error {
X struct slot_error_hdr se_hdr;
X char msg[1];
X};
X
X/*
XEach slot structure is different depending on what slot type it is.
XAll slots however, contain a slot type and slot name.
X*/
Xunion slot_generic {
X struct slot_declare declare;
X#if 0
X struct slot_read read;
X#endif
X struct slot_write write;
X struct slot_read_response read_response;
X struct slot_error error;
X struct slot_undeclare undeclare;
X/* a command slot is for variables that should be directly interpreted
X/* by the CMM itself. However, this is not currently used. */
X/* struct slot_command command; what the hell is this? */
X};
X
Xstruct slot_hdr {
X char name[CM_VARIABLENAMELENGTH];
X int type; /* type of the slot structure */
X int size; /* size of the slot structure */
X};
X
X#define s_name slot_hdr.name
X#define s_type slot_hdr.type
X#define s_size slot_hdr.size
X
Xstruct slot {
X struct slot_hdr slot_hdr;
X union slot_generic subslot;
X};
X
X/* same as slot but has buffer space at end */
X/* the others are used for handing to sizeof */
Xstruct big_slot {
X char name[CM_VARIABLENAMELENGTH];
X int type;
X int size;
X union slot_generic subslot;
X char buffer[CM_SLOTSIZE];
X};
END_OF_FILE
if test 3894 -ne `wc -c <'src/cm_slot.h'`; then
echo shar: \"'src/cm_slot.h'\" unpacked with wrong size!
fi
# end of 'src/cm_slot.h'
fi
if test -f 'src/cm_usr2.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/cm_usr2.c'\"
else
echo shar: Extracting \"'src/cm_usr2.c'\" \(2844 characters\)
sed "s/^X//" >'src/cm_usr2.c' <<'END_OF_FILE'
X#include <stdio.h>
X#include <sys/time.h>
X#include <strings.h>
X#include "cm_constants.h"
X#include "cm_sd.h"
X#include "cm_var.h"
X#include "cm_interface.h"
X
Xvoid
Xcm_set_value(var,val)
Xcm_variable *var;
Xcm_value *val;
X{
X eprintf(5,"var = %x\n",var);
X eprintf(5,"var->name = %s\n",var->name);
X cm_sd_copy(val,&var->data);
X var->status.written = TRUE;
X var->count++;
X}
X
X
Xcm_value *
Xcm_get_value(var,val)
Xcm_variable *var;
Xcm_value *val;
X{
X cm_sd_copy(&var->data,val);
X var->old_count = var->count;
X return(val);
X}
X
Xvoid
Xcm_set_new_command_value(command_out,command_value)
Xcm_command_variable *command_out;
Xcm_value *command_value;
X{
X cm_set_value(command_out,command_value);
X command_out->command_association++;
X /* or
X command_out->command_association = time_of_day;
X */
X}
X
X/*
XNote that whether we use a timestamp or a counter is implementation dependent.
XThe user should only see the association as an object that guarantees
Xuniqueness between commands. Indeed, it is expected that variables will also
Xhave timestamps and read/write counters, but this is irrelevent.
X*/
X
Xboolean cm_new_command_pending(input_command)
Xcm_command_variable *input_command;
X{
X return (input_command->command_association !=
X input_command->old_command_association);
X}
X
X/* returns true if variable has a new value since cm_get_value() or
X cm_get_new_command_value() has been called */
Xboolean cm_new_value_pending(var)
Xcm_variable *var;
X{
X return (var->count != var->old_count);
X}
X
Xboolean cm_get_new_value(var,val)
Xcm_variable *var;
Xcm_value *val;
X{
X if (!cm_new_value_pending(var)) return(FALSE);
X
X cm_get_value(var,val);
X return(TRUE);
X}
X
X/* returns true if new command received. turns off new flag */
Xboolean cm_get_new_command_value(input_command,value)
Xcm_command_variable *input_command;
Xcm_value *value;
X{
X if (!cm_new_command_pending(input_command)) return(FALSE);
X
X /* turn off strobe for next time around */
X input_command->old_command_association =
X input_command->command_association;
X cm_get_value(input_command,value);
X return(TRUE);
X}
X
Xboolean
Xcm_status_equal(command_out,status_in,status_value)
Xcm_command_variable *command_out;
Xcm_status_variable *status_in;
Xcm_value *status_value;
X{
X return(cm_status_synchronized(command_out,status_in) &&
X (cm_sd_equal(status_value,&status_in->data)
X || (status_value == ANY_STATUS)));
X}
X
Xboolean cm_status_synchronized(command_out,status_in)
Xcm_command_variable *command_out;
Xcm_status_variable *status_in;
X{
X return(command_out->command_association ==
X status_in->command_association);
X}
X
X/* NOTE: command_in argument is new!!! */
Xvoid cm_set_status_value(command_in,status_out,status_value)
Xcm_command_variable *command_in;
Xcm_status_variable *status_out;
Xcm_value *status_value;
X{
X cm_set_value(status_out,status_value);
X status_out->command_association = command_in->command_association;
X}
END_OF_FILE
if test 2844 -ne `wc -c <'src/cm_usr2.c'`; then
echo shar: \"'src/cm_usr2.c'\" unpacked with wrong size!
fi
# end of 'src/cm_usr2.c'
fi
if test -f 'src/franz/global.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/franz/global.h'\"
else
echo shar: Extracting \"'src/franz/global.h'\" \(5801 characters\)
sed "s/^X//" >'src/franz/global.h' <<'END_OF_FILE'
X/* -[Wed Jun 12 07:59:36 1985 by jkf]-
X * global.h $Locker: $
X * main include file
X *
X * $Header: global.h,v 40.27 85/06/26 14:24:02 smh Exp $
X *
X * (c) copyright 1982, Regents of the University of California
X * Enhancements (c) copyright 1984, Franz Inc., Berkeley California
X */
X
X#include <stdio.h>
X
X/*
X** if you change VERNO, then also change the compiler version number
X** in the file /usr/franz/liszt/sys/const.l
X*/
X/* the fasl file version number */
X#define VERNO 422
X/* the current opus number */
X#define OPUS 42
X
X#include "module.h"
X#include "config.h"
X#include "ltypes.h"
X#include "lstructs.h"
X#include "sigtab.h" /* table of all pointers to lisp data */
X#include "dfuncs.h"
X#include "public.h"
X
X#define FALSE 0
X#define TRUE 1
X#define EVER ;;
X
X/* used by Imakeht() and anyone who calls it */
X# define HASHKEY_EQ 1
X# define HASHKEY_EQUAL 2
X
X/* STRBLEN is used in many places as a good size for a char array */
X#define STRBLEN 512
X
X/* LBPG is 'bytes per lisp page'. */
X#define LBPG 512
X
X#define NULL_CHAR 0
X
X/* maximum and minimum fixnums */
X#define MaxINT 0x3fffffff
X#define MinINT (- 0x4000000)
X
Xextern char unbound[];
X
X/*
X * macros for saving state and restoring state
X *
X * Savestack and Restorestack are required at the beginning and end of
X * functions which modify the stack pointers np and lbot.
X * The Savestack(n) should appear at the end of the variable declarations
X * The n refers to the number of register variables declared in this routine.
X * The information is required for the Vax version only.
X *** this ifdef should be broken up into ifdefs
X */
X#ifndef NPINREG
Xextern struct atom nilatom, eofatom;
X#define nil ((lispval) &nilatom)
X#define eofa ((lispval) &eofatom)
X#define Savestack(n) struct argent *OLDlbot = lbot, *OLDnp = np
X#define Restorestack() (lbot = OLDlbot), np = OLDnp
X#else
X#define nil ((lispval) 0)
X#define eofa ((lispval) 20)
X#define Savestack(n) snpand(n)
X#define Restorestack()
X#endif
X
X#ifdef SIXONLY
X#define errorh1 errh1
X#define errorh2 errh2
X#endif
X
X#define CNIL ((lispval) (OFFSET-4))
X#define NOTNIL(a) (nil!=a)
X#define ISNIL(a) (nil==a)
X
X#ifdef SPISFP
X#define initxstack() xsp = exsp = xstack + xstksize;
Xextern word *xsp, *exsp, xstack[];
Xextern int xstksize;
X#define sp() (word*)xsp
X#define stack(z) (xsp > xstack ? (*--xsp = z): xserr())
X#define unstack() (*xsp++)
X#define Keepxs() word *oxsp = xsp;
X#define Freexs() xsp = oxsp;
X#else
X#define initxstack() /* nothing */
Xextern word *sp(), stack(), unstack();
X#define Keepxs() /* */
X#define Freexs() /* */
X#endif
X
X#ifdef apollo
Xextern char textstart[], datastart[];
Xextern char textend[], dataend[];
Xextern char heapstart[];
Xextern char heapend[];
X#endif apollo
X
X#define UPTR(x) ((unsigned)(((word)(x))-(word)CNIL))
X#define VALID(a) (UPTR(a) <= UPTR(datalim))
X
X#define roundup(x,inc) (((x - 1) | (inc - 1)) + 1)
X#define NPAGES(b) ONPAGE(roundup(b, LBPG))
X#define ONPAGE(a1) (((word) (a1)) >> 9)
X#define ATOX(a1) ((((word)(a1)) - OFFSET) >> 9)
X
X#define TYPE(a1) ((typetable+1)[ATOX(a1)])
X#define SETTYPE(s,typ) (typetable+1)[ATOX(s)] = typ
X#define HUNKSIZE(a1) ((TYPE(a1)+5) & 15)
X
X#define Popframe() (errp->olderrp)
X
X/* TNP - test np to see if it has exceeded the limit of the namestack */
X#define TNP if(np >= nplim) namerr();
X
X/*
X * protect - stack the given value on the namestack, 'protect'ing from
X * the garbage collector
X */
X#define protect(p) ((np++)->val = (p))
X
X/*
X * chkarg - If there aren't p arguments on the namestack,
X * print an argument error with x being the name of the function called.
X */
X#define chkarg(p,x) if((p)!=np-lbot) argerr(x);
X#define chkrange(low,high,x) if ((np-lbot < low) || (np-lbot > high))\
X argerr(x);
X
X
X/* number of counters for fasl to use in a profiling lisp */
X#define NMCOUNT 5000
X
X
X
X/*
X * big string buffer for whomever needs it
X *** this should be in public.h but can't until we initialize the
X *** string buffer correctly.
X */
Xextern char *strbuf;
Xextern char *endstrb;
X
X
X/*
X * PUSHDOWN stores the given 'atom' and its old value on the bindstack
X * and then sets 'atom' to 'value'
X */
X
X#define PUSHDOWN(atom,value)\
X {bnp->atm=(atom);bnp->bindv=(atom)->a.bindv;\
X (bnp++)->val=(atom)->a.clb;(atom)->a.clb=value;\
X (atom)->a.bindv=(atom);\
X if(bnp>bnplim) binderr();}
X
X/* PUSHDOWNB is like PUSHDOWN but allows specification of both the clb
X * and bindv of the new binding. Presently used only for instance
X * variables during interpreted method code.
X */
X
X#define PUSHDOWNB(atom,vclb,vbindv)\
X {bnp->atm=(atom);bnp->bindv=(atom)->a.bindv;\
X (bnp++)->val=(atom)->a.clb;(atom)->a.clb=(vclb);\
X (atom)->a.bindv=(vbindv);\
X if(bnp>bnplim) binderr();}
X
X/*
X * POP pops off the top value on the bindstack, restoring the value
X * of the atom.
X */
X
X#define POP\
X {--bnp; bnp->atm->a.clb=bnp->val; bnp->atm->a.bindv=bnp->bindv;}
X
X/* PUSHVAL is used to store a specific atom and value on the
X * bindstack. Currently only used by closure code
X */
X#define PUSHVAL(atom,value)\
X {bnp->atm=(atom);bnp->bindv=(atom)->a.bindv;(bnp++)->val=value;\
X if(bnp>bnplim) binderr();}
X
X
X/*
X * the Fixzero table is a table of fixnums from -1024 to 1023, with
X * Fixzero[0] being zero. The SMALL(n) macro return the fixnum n
X */
Xextern word Fixzero[];
X#define SMALL(i) ((lispval)(Fixzero + i))
X
X/*
X * register lisp macros for registers only used in non-portable vax version
X * These place code in the assembler stream which tells 'fixmask'
X * to alter the register save mask
X * saveonly(n) - save the first n registers (r11,r10,...,r6)
X * snpand(n) - save np and lbot (r6+r7) then the first n registers
X */
X#ifdef NPINREG
X# define saveonly(n) asm("#save n")
X# define snpand(n) asm("#protect n")
X#endif
X
X
X/*
X * Chkint - macro to check if an interrupt has occured, and if
X * it does then to process it
X */
X#define Chkint() if (sigintcnt > 0) dosigint()
END_OF_FILE
if test 5801 -ne `wc -c <'src/franz/global.h'`; then
echo shar: \"'src/franz/global.h'\" unpacked with wrong size!
fi
# end of 'src/franz/global.h'
fi
if test -f 'src/franz/lstructs.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/franz/lstructs.h'\"
else
echo shar: Extracting \"'src/franz/lstructs.h'\" \(4369 characters\)
sed "s/^X//" >'src/franz/lstructs.h' <<'END_OF_FILE'
X/* -[Wed Jun 5 21:16:25 1985 by layer]-
X** lstructs.h $Locker: $
X** lisp data object structure definitions
X**
X** $Header: lstructs.h,v 40.17 85/06/06 16:03:19 layer Exp $ *
X**
X** (c) copyright 1984, Franz Inc., Berkeley California
X*/
X
Xtypedef union lispobj *lispval;
X
Xstruct dtpr {
X lispval cdr, car;
X};
X
Xstruct sdot {
X word I;
X lispval CDR;
X};
X
X
X/*
X** If you change the size of the following structure, then
X** you must also do the following:
X** 1. give ATOMSPP a new value (in structs.h), which is:
X** integer part of (512 / sizeof (struct atom))
X** 2. fix the initialization of nilatom and eofatom in low.c
X** 3. fix the init of atom_str in data.c
X**
X** NOTE: there are places in the imterpreter and compiler which
X** know about offsets in the atom structure, and they are:
X** 1. {vax,68k}/qfuncl (the #define Atomfnbnd)
X** 2. const.l in the compiler (bindv-offset and clb-offset).
X*/
Xstruct atom {
X lispval clb; /* current level binding */
X lispval bindv; /* pointer to the current value */
X char *pname; /* print name */
X lispval fnbnd; /* function binding */
X lispval pkg; /* home package (for printing) */
X lispval plist; /* property list */
X};
X
X/* all references to the value of a symbol should use the following macro */
X#define SymValue(x) (((x)->a.bindv)->a.clb)
X
Xstruct array {
X lispval accfun, /* access function--may be anything */
X aux; /* slot for dimensions or auxilliary data */
X char *data; /* pointer to first byte of array */
X lispval length, delta; /* length in items and length of one item */
X};
X
Xstruct bfun {
X lispval (*start)(); /* entry point to routine */
X lispval discipline; /* argument-passing discipline */
X#ifdef apollo
X lispval canlink; /* can link this function in trantb */
X lispval (*ecb)(); /* pointer to ecb */
X lispval (*ecb2)(); /* second pointer to ecb */
X#endif apollo
X};
X
Xstruct Hunk {
X lispval hunk[1];
X};
X
Xstruct Vector {
X lispval vector[1];
X};
X
X/* the vectori types */
Xstruct Vectorb {
X char vectorb[1];
X};
X
X/* The manual says this must be 16 bits */
Xstruct Vectorw {
X short vectorw[1];
X};
X
Xstruct Vectorl {
X int32 vectorl[1];
X};
X
Xstruct Vectorf {
X float vectorf[1];
X};
X
Xstruct Vectord {
X double vectord[1];
X};
X
Xstruct Hasht {
X lispval size;
X lispval test;
X lispval count;
X lispval rehash_size;
X lispval rehash_thres;
X lispval bucket;
X};
X
X/*
X** if you change the size of this structure, then
X** change the initialization of boguslp in data.c
X*/
Xstruct package {
X lispval tables;
X lispval name;
X lispval nicknames;
X lispval use_list;
X lispval used_by_list;
X lispval internal_symbols;
X lispval external_symbols;
X lispval shadowing_symbols;
X};
X
Xunion lispobj {
X struct atom a;
X struct array ar;
X struct bfun bcd;
X char c;
X char *st; /* string */
X struct dtpr d;
X lispval (*f)();
X struct Hunk h;
X struct Hasht ht;
X word i;
X word *j;
X lispval l;
X FILE *p;
X struct package pk;
X double r;
X struct sdot s;
X struct Vector v;
X struct Vectorb vb;
X struct Vectorw vw;
X struct Vectorl vl;
X struct Vectorf vf;
X struct Vectord vd;
X};
X
X/* offset of size info from beginning of vector,
X in longwords (ie 32 bit words) */
X/* these values are not valid when a vector is stored in the free */
X/* list, in which case the chaining is done through the propery field */
X#define VSizeOff -2
X#define VPropOff -1
X
X/* VecTotSize: the total number of longwords for the data segment of
X * the vector. Takes a byte count and rounds up to nearest long.
X */
X
X#define VecTotSize(x) (((x)+3) >> 2)
X#define VecTotToByte(x) ((x) * sizeof(word))
X
X/* these vector size macros determine the number of complete objects
X in the vector
X */
X#define VecSize(x) ((x) >> 2)
X#define VecWordSize(x) ((x) >> 1)
X#define VecByteSize(x) (x)
X#define VecFloatSize(x) ((x) >> 2) /* not used yet */
X#define VecDoubSize(x) ((x) >> 3) /* not used yet */
X
X#define VSIZE(vec) VecSize((int)vec->v.vector[VSizeOff])
X/*
X * internal lisp structures
X */
X
X/*
X * nament is misnamed. It is actually the structure of a bindstack entry
X * recording the saved value (val) of a symbol (atm) and bindv
X */
Xstruct nament {
X lispval val,
X atm,
X bindv;
X};
X
X/*
X * argent is the structure of an object on the namestack, which
X * is a stack of lisp values, usually arguments to functions and
X * local variables in compiled code.
X */
Xstruct argent {
X lispval val;
X};
END_OF_FILE
if test 4369 -ne `wc -c <'src/franz/lstructs.h'`; then
echo shar: \"'src/franz/lstructs.h'\" unpacked with wrong size!
fi
# end of 'src/franz/lstructs.h'
fi
if test -f 'src/franz/sigtab.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/franz/sigtab.h'\"
else
echo shar: Extracting \"'src/franz/sigtab.h'\" \(4580 characters\)
sed "s/^X//" >'src/franz/sigtab.h' <<'END_OF_FILE'
X/* -[Wed Jun 5 21:45:38 1985 by layer]-
X * sigtab.h $Locker: $
X * table of lispvals needed by C
X *
X * $Header: sigtab.h,v 40.10 85/06/06 16:03:43 layer Exp $
X *
X * (c) copyright 1982, Regents of the University of California
X * Enhancements (c) copyright 1984, Franz Inc., Oakland California
X */
X
X/*
X * lispvals in use by the program should be in this table.
X * Otherwise they may get garbage-collected.
X */
X
X# define SIGNIF 148
X
XPublic lispval lispsys[SIGNIF];
X
X#define tatom (lispsys[1])
X#define lambda (lispsys[2])
X#define nlambda (lispsys[3])
X#define perda (lispsys[4])
X#define lpara (lispsys[5])
X#define rpara (lispsys[6])
X#define lbkta (lispsys[7])
X#define rbkta (lispsys[8])
X#define Eofa (lispsys[9])
X#define snqta (lispsys[10])
X#define exclpa (lispsys[11])
X#define quota (lispsys[12])
X#define xatom (lispsys[13])
X#define cara (lispsys[14])
X#define cdra (lispsys[15])
X#define gcafter (lispsys[16])
X /* gap */
X#define int_name (lispsys[19])
X#define str_name (lispsys[20])
X#define atom_name (lispsys[21])
X#define doub_name (lispsys[22])
X#define dtpr_name (lispsys[23])
X#define int_items (lispsys[24])
X#define int_pages (lispsys[25])
X#define str_items (lispsys[26])
X#define str_pages (lispsys[27])
X#define dtpr_items (lispsys[28])
X#define dtpr_pages (lispsys[29])
X#define doub_items (lispsys[30])
X#define doub_pages (lispsys[31])
X#define atom_items (lispsys[32])
X#define atom_pages (lispsys[33])
X#define gccall1 (lispsys[34])
X#define gccall2 (lispsys[35])
X#define sysa (lispsys[36])
X#define plima (lispsys[37])
X#define macro (lispsys[38])
X#define startup (lispsys[39])
X#define rcomms (lispsys[40])
X#define commta (lispsys[41])
X#define plimit (lispsys[44])
X#define array_items (lispsys[45])
X#define array_pages (lispsys[46])
X#define array_name (lispsys[47])
X#define sdot_items (lispsys[48])
X#define sdot_pages (lispsys[49])
X#define sdot_name (lispsys[50])
X#define val_items (lispsys[51])
X#define val_pages (lispsys[52])
X#define val_name (lispsys[53])
X#define splice (lispsys[54])
X#define rdrsdot (lispsys[55])
X#define funct_items (lispsys[56])
X#define funct_pages (lispsys[57])
X#define funct_name (lispsys[58])
X#define nstack (lispsys[59])
X#define rdrint (lispsys[63])
X#define nilplist (lispsys[64])
X#define Vprintsym (lispsys[65])
X /* gap */
X#define gcdis (lispsys[68])
X /* gap */
X#define bstack (lispsys[83])
X#define lexpr_atom (lispsys[84])
X#define lexpr (lispsys[85])
X#define ibase (lispsys[86])
X#define Vpiport (lispsys[87])
X#define Vpoport (lispsys[88])
X#define Veval (lispsys[89])
X#define Vererr (lispsys[90])
X#define Vertpl (lispsys[91])
X#define Verall (lispsys[92])
X#define Vermisc (lispsys[93])
X#define Vlerall (lispsys[94])
X#define stlist (lispsys[95])
X#define Vreadtable (lispsys[96])
X#define strtab (lispsys[97])
X#define Verbrk (lispsys[98])
X#define Vnogbar (lispsys[99])
X#define rdrsdot2 (lispsys[100])
X#define Veruwpt (lispsys[101])
X
X#define hunkfree (lispsys[102])
X#define port_name (lispsys[103])
X#define reseta (lispsys[104])
X#define rsetatom (lispsys[105])
X#define bptr_atom (lispsys[106])
X#define evalhatom (lispsys[107])
X#define funhatom (lispsys[108])
X#define Vptport (lispsys[109])
X#define Vcntlw (lispsys[110])
X#define Verrset (lispsys[111])
X#define Verundef (lispsys[112])
X#define Vsubrou (lispsys[113])
X#define Vprinlevel (lispsys[114])
X#define Vprinlength (lispsys[115])
X#define Vfloatformat (lispsys[116])
X#define Vldprt (lispsys[117])
X#define Verdepth (lispsys[118])
X#define mrtabspace (lispsys[119])
X#define pnameprot (lispsys[120])
X#define other_name (lispsys[121])
X#define Vevalframe (lispsys[122])
X#define Vpurcopylits (lispsys[123])
X#define vect_name (lispsys[124])
X#define vecti_name (lispsys[125])
X#define vect_items (lispsys[126])
X#define vecti_items (lispsys[127])
X#define vect_pages (lispsys[128])
X#define vecti_pages (lispsys[129])
X#define Vdisplacemacros (lispsys[130])
X#define other_pages (lispsys[131])
X#define other_items (lispsys[132])
X#define fclosure (lispsys[133])
X#define Vgcprint (lispsys[134])
X#define clos_marker (lispsys[135])
X#define Vpbv (lispsys[136])
X#define atom_buffer (lispsys[137])
X#define Vlibdir (lispsys[138])
X#define flavor (lispsys[139])
X#define self (lispsys[140])
X#define self_map (lispsys[141])
X#define gccall3 (lispsys[142])
X#define hasht_atom (lispsys[143])
X#define pkg_atom (lispsys[144])
X#define print_self (lispsys[145])
X#define clos_prop (lispsys[146])
X#define vector_print (lispsys[147])
X
X/* various status switches */
X#define STSIZE 16
XPublic lispval stattab[STSIZE];
X
X#define Schainp (stattab[0])
X#define Sautor (stattab[1])
X#define Strans (stattab[2])
X#define evalhsw (stattab[3])
END_OF_FILE
if test 4580 -ne `wc -c <'src/franz/sigtab.h'`; then
echo shar: \"'src/franz/sigtab.h'\" unpacked with wrong size!
fi
# end of 'src/franz/sigtab.h'
fi
if test -f 'src/man_get_slot.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/man_get_slot.c'\"
else
echo shar: Extracting \"'src/man_get_slot.c'\" \(5392 characters\)
sed "s/^X//" >'src/man_get_slot.c' <<'END_OF_FILE'
X/*
X
Xthese functions are used by the CMM to read and process information from
Xincoming slots
X
X*/
X
X#include <sys/time.h>
X#include <sys/types.h>
X#include <netinet/in.h>
X#include "cm_constants.h"
X#include "cm_var.h"
X#include "cm_sd.h"
X#include "cm_slot.h"
X#include "cm_man.h"
X#include "cm_msg.h"
X#include "cm_time.h"
X
Xstruct variable *get_variable();
X
Xextern struct process processes[];
Xextern struct msg *cm_omsg; /* defined in man.c */
X
X#define TRUE 1
X#define FALSE 0
X
Xint /* returns 0 if ok, negative if error */
Xman_decode_slot(s,pin)
Xstruct slot *s;
Xint pin; /* process index */
X{
X int rc = 0;
X
X switch (s->s_type) {
X case CM_SLOT_DECLARE:
X eprintf(5,"slot declare\n");
X rc = get_slot_declare(s->s_name,&s->subslot.declare,pin);
X break;
X case CM_SLOT_WRITE:
X eprintf(5,"slot write\n");
X rc = get_slot_write(s->s_name,&s->subslot.write,pin);
X break;
X#if 0
X case CM_SLOT_READ:
X eprintf(5,"slot read\n");
X /* note this destroys the message first, so this should */
X /* always appear as the last slot */
X send_read_vars_to(cm_omsg,pin);
X break;
X#endif
X case CM_SLOT_UNDECLARE:
X eprintf(5,"slot undeclare\n");
X rc = get_slot_undeclare(s->s_name,&s->subslot.undeclare,pin);
X break;
X default:
X printf("slot bad");
X put_slot_error(cm_omsg,s->s_name,CM_SLOT_NULL,
X "bad slot type");
X rc = E_CM_GET_SLOT_UNKNOWN_SLOT_TYPE;
X break;
X }
X eprintf(5,"successfully decoded slot (%s %s)\n",
X s->s_name,cm_slot_type(s->s_type));
X return(rc);
X}
X
Xint /* returns 0 if ok */
Xget_slot_declare(name,s,pin)
Xchar *name;
Xstruct slot_declare *s;
Xint pin;
X{
X struct variable *v;
X
X if (!(v = get_variable(name))) {
X put_slot_error(cm_omsg,name,CM_SLOT_DECLARE,
X "not enough common memory to declare variable");
X return(E_GET_VARIABLE_NO_SPACE);
X }
X
X /* check access rights */
X if (s->role.reader) {
X set_reader(pin,v);
X /* if it's been written, note that */
X if (v->count) set_new(pin,v);
X }
X if (s->role.wakeup) {
X set_wakeup(pin,v);
X /* if it has a new value, wake us up */
X if (is_new(pin,v)) processes[pin].wakeup = TRUE;
X }
X if (s->role.nonxwriter) {
X if (v->xwriter == CM_NULL_PROCESS)
X set_nonxwriter(pin,v);
X else {
X put_slot_error(cm_omsg,name,CM_SLOT_DECLARE,
X "cannot get nonexclusive write access");
X return(E_CM_DECLARE_CANT_GET_XWRITE_ACCESS);
X }
X }
X if (s->role.xwriter) {
X if (v->xwriter == CM_NULL_PROCESS
X || is_xwriter(pin,v)) {
X set_xwriter(pin,v);
X } else {
X put_slot_error(cm_omsg,name,CM_SLOT_DECLARE,
X "cannot get exclusive write access");
X return(E_CM_DECLARE_CANT_GET_XWRITE_ACCESS);
X }
X }
X
X#if 0
X /* update cm_variable_list */
X for (i=0;
X#endif
X
X return(0);
X}
X
X/*ARGSUSED*/
Xint
Xget_slot_undeclare(name,s,pin)
Xchar *name;
Xstruct slot_undeclare *s;
Xint pin;
X{
X struct variable *v;
X
X if (!(v = get_variable(name))) {
X put_slot_error(cm_omsg,name,CM_SLOT_UNDECLARE,
X "undeclare of undeclared variable");
X return(E_CM_UNDECLARE_UNDECLARE);
X }
X if (!var_inuse(v)) {
X put_slot_error(cm_omsg,name,CM_SLOT_UNDECLARE,
X "undeclare of undeclared variable");
X return(E_CM_UNDECLARE_UNDECLARE);
X }
X unset_reader(pin,v);
X unset_writer(pin,v);
X unset_wakeup(pin,v);
X
X /* note: var_inuse may have different value now */
X if (!var_inuse(v)) {
X /* if var had been set, free up any space taken by it */
X if (v->count) {
X cm_sd_free(&v->data);
X v->count = 0;
X }
X
X /* remove from cm_variable_list */
X }
X return(E_CM_SLOT_OK);
X}
X
Xint /* returns 0 if ok, error otherwise */
Xget_slot_write(name,s,pin)
Xchar *name;
Xstruct slot_write *s;
Xint pin;
X{
X int i;
X struct variable *v;
X
X if (!(v = get_variable(name))) {
X put_slot_error(cm_omsg,name,CM_SLOT_WRITE,
X "not enough common memory to declare variable");
X return(E_CM_DECLARE_GET_VARIABLE_NO_SPACE);
X }
X
X /* if variable has not been declared, error */
X if (!var_inuse(v)) {
X put_slot_error(cm_omsg,name,CM_SLOT_WRITE,
X "variable has not been declared");
X return(E_CM_WRITE_NOT_DECLARED_YET);
X }
X
X /* check access */
X if (!(is_writer(pin,v))) {
X put_slot_error(cm_omsg,name,CM_SLOT_WRITE,
X "not declared as writer");
X return(E_CM_WRITE_NOT_WRITER);
X }
X
X /* write new value */
X if (0 > cm_flat_to_sd(&s->fdata,&v->data)) {
X put_slot_error(cm_omsg,name,CM_SLOT_WRITE,
X "get_slot_write: cm_flat_to_sd() failed! no space?\n");
X return(E_CM_GET_SLOT_FLAT_TO_SD);
X }
X /* the CMM generates new values for count and timestamp */
X v->count++;
X time_now(&v->timestamp);
X /* the user generates new values for command_association */
X v->command_association = s->sw_hdr.command_association;
X
X for (i=0;i<CM_MAXPROCESSES;i++) {
X set_new(i,v);
X /* flag any processes to be woken up */
X if (is_wakeup(i,v)) {
X processes[i].wakeup = TRUE;
X }
X }
X return(E_CM_SLOT_OK);
X}
X
X#if 0
X/*ARGSUSED*/
Xint /* returns 0 if ok, error otherwise */
Xget_slot_read(name,s,pin)
Xchar *name;
Xchar *s; /*struct slot_read *s;*/
Xint pin;
X{
X struct variable *v;
X
X v = get_variable(name);
X
X if (!var_inuse(v)) {
X put_slot_error(cm_omsg,name,CM_SLOT_READ,
X "variable not defined");
X return(E_CM_READ_NOT_DECLARED_YET);
X }
X
X /* check access */
X if (!(is_reader(pin,v))) {
X put_slot_error(cm_omsg,name,CM_SLOT_READ,
X "not declared as reader");
X return(E_CM_READ_NOT_READER);
X }
X
X /* read value, create slot, and add to outgoing message buffer */
X put_slot_read_response(cm_omsg,name,v->count,
X &v->timestamp,v->command_association,&v->data);
X return(E_CM_SLOT_OK);
X}
X#endif
END_OF_FILE
if test 5392 -ne `wc -c <'src/man_get_slot.c'`; then
echo shar: \"'src/man_get_slot.c'\" unpacked with wrong size!
fi
# end of 'src/man_get_slot.c'
fi
if test -f 'stream/sized_io.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'stream/sized_io.c'\"
else
echo shar: Extracting \"'stream/sized_io.c'\" \(3534 characters\)
sed "s/^X//" >'stream/sized_io.c' <<'END_OF_FILE'
X/*
X
Xthese two routines enable us to have use stream io, but still detect end of
Xrecord marks. Each call to sized_read() returns a complete buffer, that is
Xwhat was written by one call to sized_write().
X
XNotes:
X
XThe IPC system seems to be a confusing mess. I.e. unusual conditions are
Xhandled in all different ways. Specifically,
X
XWhile we are reading, if the writer goes away, we sometimes get a read()
X== -1 && errno == ECONNRESET. Sometimes we get a read() == 0. Why the
Xdifference?
X
XWhile we are writing, if the reader goes away, we get a signal (SIGPIPE).
X
X
X*/
X
X#include <stdio.h>
X#include <errno.h>
Xextern int errno;
X#include <sys/types.h> /* defines u_long */
X#include <netinet/in.h> /* defines htonl(), etc */
X
Xint /* returns number of bytes read or -1 if error (i.e. EOF) */
Xsized_read(fd,buffer,maxbytes)
Xint fd;
Xchar *buffer;
Xint maxbytes; /* unlike read(), this parameter is the maximum size of */
X /* the buffer */
X{
X int size; /* size of incoming packet */
X int cc;
X int rembytes; /* remaining bytes */
X u_long netlong; /* network byte ordered length */
X
X /* read header */
X if (sizeof(size) != (cc = read(fd,(char *)&netlong,sizeof(netlong)))){
X /* if the connection is broken, we end up here */
X#ifdef DEBUG
X fprintf(stderr,"sized_read: expecting buffer size but only read %d chars\n",cc);
X#endif
X if (cc == -1)
X if (errno != ECONNRESET) perror("read");
X return(-1);
X }
X
X size = ntohl(netlong);
X
X /* read data */
X if (size == 0) return(0);
X else if (size > maxbytes) {
X fprintf(stderr,"sized_read: buffer too small. ");
X fprintf(stderr,"buffer size was %d actual size was %d\n",
X maxbytes,size);
X return(-1);
X }
X
X /* handle buffers to large to fit in one transfer */
X rembytes = size;
X while (rembytes) {
X if (-1 == (cc = read(fd,buffer,rembytes))) {
X fprintf(stderr,"sized_read(,,%d) = read(,,%d) = %d\n",
X size,rembytes,cc);
X if (errno != ECONNRESET) perror("read");
X return(-1);
X }
X
X /* new! */
X if (0 == cc) { /* EOF - process died */
X return(-1);
X }
X
X#ifdef DEBUG
X if (rembytes != cc)
X fprintf(stderr,"sized_read(,,%d) = read(,,%d) = %d\n",
X size,rembytes,cc);
X#endif
X /* read() returned more bytes than requested!?!?!?! */
X /* this can't happen, but appears to be anyway */
X if (cc > rembytes) {
X fprintf(stderr,"sized_read(,,%d) = read(,,%d) = %d!?!?!\n",
X size,rembytes,cc);
X fprintf(stderr,"read() returned more chars than requested! Aborting program.\n");
X abort();
X }
X buffer += cc;
X rembytes -= cc;
X }
X return(size);
X}
X
Xint /* returns number of data bytes written or -1 if error */
Xsized_write(fd,buffer,nbytes)
Xint fd;
Xchar *buffer;
Xint nbytes;
X{
X int cc;
X int rembytes;
X u_long netlong; /* network byte ordered length */
X
X /* write header */
X netlong = htonl(nbytes);
X if (sizeof(nbytes) != (cc = write(fd,(char *)&netlong,
X sizeof(netlong)))) {
X#ifdef DEBUG
X /* this can never happen (SIGPIPE will always occur first) */
X fprintf(stderr,"sized_write: tried to write buffer size but only wrote %d chars\n",cc);
X#endif
X if (cc == -1) perror("write");
X return(-1);
X }
X
X /* write data */
X if (nbytes == 0) return(0);
X
X rembytes = nbytes;
X while (rembytes) {
X if (-1 == (cc = write(fd,buffer,rembytes))) {
X fprintf(stderr,"sized_write(,,%d) = write(,,%d) = %d\n",
X nbytes,rembytes,cc);
X perror("write");
X return(-1);
X }
X#ifdef DEBUG
X if (rembytes != cc)
X fprintf(stderr,"sized_write(,,%d) = write(,,%d) = %d\n",
X nbytes,rembytes,cc);
X#endif
X buffer += cc;
X rembytes -= cc;
X }
X return(nbytes);
X}
END_OF_FILE
if test 3534 -ne `wc -c <'stream/sized_io.c'`; then
echo shar: \"'stream/sized_io.c'\" unpacked with wrong size!
fi
# end of 'stream/sized_io.c'
fi
if test -f 'stream/stream.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'stream/stream.c'\"
else
echo shar: Extracting \"'stream/stream.c'\" \(4225 characters\)
sed "s/^X//" >'stream/stream.c' <<'END_OF_FILE'
X#include <stdio.h>
X#include <sys/types.h>
X#include <sys/socket.h>
X#include <sys/time.h>
X#include <netinet/in.h>
X#include <netdb.h>
X#include <errno.h>
X#include "inet.h"
X
X#define MAXHOSTNAMELENGTH 255
Xchar hostname[MAXHOSTNAMELENGTH];
X
Xextern errno;
Xstatic int maxfds;
Xstatic struct timeval zerotime;
X
Xint /* returns a socket, or -1 for failure */
Xinitport(porttype,port_name,port_number,role,sockettype,host_in)
Xint porttype;
Xchar *port_name;
Xu_short port_number;
Xint role;
Xint sockettype;
Xchar *host_in; /* host to provide service */
X{
X int s; /* the socket */
X struct sockaddr_in sin;
X struct hostent *h;
X struct servent *sp; /* used by getservbyname - may not be nec. */
X
X maxfds = getdtablesize(); /* for future reference */
X zerotime.tv_sec = zerotime.tv_usec = 0L;
X
X if (client) {
X if (host_in && strcmp(host_in,"")) strcpy(hostname,host_in);
X else {
X if (gethostname(hostname,MAXHOSTNAMELENGTH)) {
X fprintf(stderr,"gethostname() failed\n");
X perror("initport(client)");
X return(-1);
X }
X }
X
X if (!(h = gethostbyname(hostname))) {
X fprintf(stderr,"gethostbyname() failed\n");
X perror("initport(client)");
X return(-1);
X }
X }
X
X if (porttype == PORT_TYPE_NAME) {
X if (!(sp = getservbyname(port_name,NULL))) {
X fprintf(stderr,"getservbyname() failed to find %s\n",port_name);
X exit(-1);
X }
X }
X
X if (-1 == (s = socket(AF_INET,sockettype,0))) {
X fprintf(stderr,"socket() failed\n");
X perror("initport");
X return(-1);
X }
X
X sin.sin_family = AF_INET;
X sin.sin_addr.s_addr = (server?INADDR_ANY:*(u_long *) h->h_addr);
X sin.sin_port = (porttype == PORT_TYPE_NAME?sp->s_port:port_number);
X
X if (client) {
X if (connect(s,(struct sockaddr *)&sin,sizeof(struct sockaddr_in))) {
X fprintf(stderr,"connect() failed\n");
X perror("initport(client)");
X return(-1);
X }
X } else {
X /* bind the socket */
X /* following line is for debugging, see IPC primer, p. 25 */
X setsockopt(s,SOL_SOCKET,SO_REUSEADDR,(char *)0,0);
X if (-1 == (bind(s,(struct sockaddr *)&sin,sizeof(sin)))) {
X fprintf(stderr,"bind() failed\n");
X perror("initport(server)");
X return(-1);
X }
X if (listen(s,1)) {
X perror("listen");
X return(-1);
X }
X }
X return(s);
X}
X
Xselect_server_stream(connection_socket,readers)
Xint connection_socket;
Xint *readers; /* file descriptors of client sockets */
X{
X struct sockaddr_in from;
X int fromlen;
X static int fd; /* next file descriptor to look at */
X int readfds, c;
X int user;
X
X /* how do you get sockets to block? there is some hint (recv(2)) */
X /* in the manual that you can but I can't find the reference! */
X
X /* select does not like bogus file descriptors, so keep track of */
X /* them by hand */
X *readers |= 1<<connection_socket;
X
Xrestart:
X do {
X /* save readers because select wipes them out */
X readfds = *readers;
X c = select(maxfds,&readfds,(int *)0,(int *)0,(struct timeval *)0);
X if (c == -1) {
X if (errno == EBADF) {
X int i, suspect;
X /* someone augered in, lets forget about'm */
X for (i=0;i<maxfds;i++) {
X if ((1<<i) & *readers) {
X /* use a temporary for the suspect because select() */
X /* requires an address */
X suspect = 1<<i;
X if (-1 == select(maxfds,&suspect,(int *)0,(int *)0,
X &zerotime)) {
X /* found a reader who closed his socket */
X /* so get rid of him */
X *readers &= ~(1<<i);
X }
X }
X }
X } else {
X /* lets hope it was a recoverable interrupt and try again */
X perror("select");
X exit(-1);
X }
X }
X } while (c == -1);
X /* given the set of ready file descriptors pick one out that is ready */
X /* start from where we left off, so as to give everyone service */
X while (!(readfds & 1<<(fd = (1+fd)%maxfds))) ;
X
X if (fd == connection_socket) { /* check for new connections */
X fromlen = sizeof(from);
X user = accept(connection_socket,(struct sockaddr *)&from,&fromlen);
X *readers |= 1<<user;
X goto restart;
X }
X
X return(fd);
X}
X
Xprint_address(x)
Xstruct sockaddr_in *x;
X{
X printf("x->sin_family = %d\n",(int)x->sin_family);
X printf("x->sin_port = %d\n",(int)x->sin_port);
X printf("x->sin_addr.s_addr = %d\n",(int)x->sin_port);
X printf("x->sin_zero[0] = %c\n",x->sin_zero[0]);
X}
END_OF_FILE
if test 4225 -ne `wc -c <'stream/stream.c'`; then
echo shar: \"'stream/stream.c'\" unpacked with wrong size!
fi
# end of 'stream/stream.c'
fi
echo shar: End of archive 2 \(of 4\).
cp /dev/null ark2isdone
MISSING=""
for I in 1 2 3 4 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 4 archives.
rm -f ark[1-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0
--
Please send comp.sources.unix-related mail to rsalz@uunet.uu.net.