home *** CD-ROM | disk | FTP | other *** search
- Subject: v14i095: Shared memory emulation for 4.2BSD, Part02/04
- Newsgroups: comp.sources.unix
- Sender: sources
- Approved: rsalz@uunet.UU.NET
-
- 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
-
-