/* RPCFir.c 
  Client and Server Lupine-level functions for RPC 
  Last modified by D. Swinehart, November 11, 1982 10:28 am
   L. Stewart, December 27, 1982  3:18 PM, flush nested declarations
   L. Stewart, January 1, 1983  4:15 PM, flush AllocZero
 */

#include <Alloc.h>
#include <Signal.h>
#include <Queue.h>
#include <Env.h>
#include <Rpc.h>
#include <RpcInternal.h>
#include <RpcLupine.h>
#include <RpcPkt.h>
#include <RpcBind.h>

    /* from RpcPktIO, etc. */
extern int Call();
extern int *mySoc;
extern struct ZN *myZone;
extern StartCall();

    /* from RpcSignals */
extern int CallFailed;
extern int RejectUnbound;

    /* from Pup Package */
extern struct PBI *GetPBI();
extern ReleasePBI();

    /* from OS */
extern int *Allocate();
extern int *MyFrame();
extern Free();
extern int *MyFrame();
extern int **CallersFrame();

/* swap all bytes if swapBytes is true */
extern Marshall(/* swapBytes, dest, source, nWords */);

extern int apply(/* int args[], proc, nargs */ );

/* Type codes: 
  Code  Meaning    Unmarshalled  Marshalled

  W	Word		int		num
  B	2 bytes		[byte1, byte2]	[byte1, byte2]  (no swabbing!)

  D	DoubleWord  &[int, int]	&[word, word]

  S	String		&ShortSTRING  &ShortSTRING, lengths swapped

  Q	Word Seq.	SEQUENCE ln: CARDINAL OF int  ditto word, length swapped 

  C	Byte Sequence  SEQUENCE ln: CARDINAL OF {0..256)  ditto, length swapped

  x	Special Value  As specified by last call to AddType
        ('A' <= x <= 'Z') */

/* Special types defined so far include:
  K	word sequence, not swapped. */

/* Type Descriptors:
  These correspond to the records produced by
  functions like "rope", "char", "int", etc., in the PF world.
  They further describe pointers that don't have enough
  intrinsic marshalling information.
  Right now there's only one.  Later, maybe, we'll add special ones
  for sequences, lists, or other common structures. ??
  
  All word or word-sequence values within packets are assumed to
  be in "marshalled", or "big-endian" form.
  Ditto with all sequence and string length words.
  Vice versa for the unmarshalled values.
 */

struct Type {
  int esWord; /* = {
    bit eltsAreWords;  // bytes need to be swapped when shalling
    bit atLen;  if on, #include len from base!len
    bit[3] blank;  other specs
    bit[11] elementSize; in bits, m/b x16 if >16, must divide 16 if <=
    };  */
  int overhead;  /* non-duplicated header, assumed words (to be swapped) */
  int length;  /* number of elements, or index thereof */
  };
#define lenType (sizeof (struct Type)/2)
    
#define atLenField 040000
#define eltsAreWordsField 0100000
#define elementSizeField 03777

struct Sequence {
  int maxLength;
  int data[1];
  };
  
struct DSpecs {
  int *proc;  /* The remote procedure !!! */
  struct ShortSTRING *argSpecs;  /* string specifying parameters */
  struct ShortSTRING *resSpecs; /* one-character string specifying results. */
  };
#define lenDSpecs (sizeof (struct DSpecs)/2)

 
struct DSpecsTable {
  int *Free;  /*: PROC{dSpecsTable;}; -- releases table */
  int maxProcs;
  struct DSpecs entries[1];
  };
#define lenDSpecsTable (sizeof(struct DSpecsTable)/2 - lenDSpecs)
  
#define lupineOffset 4

  /* First proc index is 4. */

static struct Type *types[];

/*********** Descriptor procedures **********
  These correspond to the "rope", etc., PF functions. */

struct Type
*dBlock(elementSize, overhead, length, atLen, eltWd) 
  int elementSize, overhead, length, atLen, eltWd;
  {
  struct Type *res;
  res = (struct Type *) Allocate(myZone, lenType);
  res->esWord = elementSize;  /* element size field is low order */
  res->overhead = overhead;
  res->length = length;
  if (atLen) res->esWord |= atLenField;
  if (eltWd) res->esWord |= eltsAreWordsField;
  return (res);
  };

static int
BlockSize(loc, type, lvLen) 
  int loc[]; struct Type *type; int *lvLen;
  {
  /* if lvLen, marshalling, store swapped numElts field there.
    Else unmarshalling, fetch length value swapped. */
  int eltLen, numElts, temp;
  if ((type->esWord&atLenField)==0) numElts = type->length;
  else {
    numElts = loc[type->length];
    if (lvLen==0) numElts =  swab(numElts);
    };
  if (lvLen) *lvLen=swab(numElts);
  eltLen = type->esWord&elementSizeField;
  if (eltLen >= 16) temp = (eltLen >> 4)*numElts;
  else temp = ((numElts-1)/(16/eltLen))+1;
  Block();
  return (type->overhead + temp);
  };

/************* Dillonesque Utilities *************/

int
MarshallFormatted(spec, pkt, pktLength, args)
  struct ShortSTRING *spec; struct PBI *pkt; int pktLength; int *args[];
  {
/* spec is C (!!) string of spec codes. */
  int dest[];
  int i; char tChar;
  struct Header *hdr;
  struct ShortSTRING *ss;
  struct Type *type;
  int src[], len, isNil, swapBytes, oLen;
  hdr = pkt->pup;
  dest = hdr->callData.words;
  for (i = 0; i<spec->length; ++i) {
    Block();
    swapBytes=false; oLen=0;
    src = args[i];
    isNil = (src)? 0: swapped1;
    dest[pktLength++] = isNil;  /* isNil spec */
    switch (tChar=spec->text[i]) {
      case 'W': {
        dest[pktLength-1] = swab(src);
        continue;
        };
      case 'B': {
        dest[pktLength-1] = (int) src;
        continue;
        };
      case 'D': {
        --pktLength; /* no "isNil" word */
        len=2;
        swapBytes=true;
        break;
        };
      case 'S': {
        ss=(struct ShortSTRING *) src;
        ++src;
        len=(ss->length+3)/2;
        oLen=1;
        break;
        };
      /* All multi-word values are stored as:
        a one-word BOOLEAN value indicating nilness
          (already stored, above)
        If non-nil, a two-word length value specifying the block length,
  in elements. (This is in addition to any intrinsic length fields,
  which is included in the above.)
        */
      default: {
        if (isNil) continue;
        type = types[tChar-'A'];
        if (type==0) SIGNAL(CallFailed, badArgs);
        len = BlockSize(src, type, &dest[pktLength++]);
        oLen = type->overhead;
        swapBytes = type->esWord&eltsAreWordsField;
        if ((type->esWord&atLenField)!=0) dest[pktLength++] = 0;
         /* SHORT values only. */
         else pktLength -= 1;
         };
      };
    if (isNil) continue;
    if (oLen) Marshall(true, &dest[pktLength], src, oLen);
    pktLength += oLen;
    len-=oLen;
    if (len) Marshall(swapBytes, &dest[pktLength], &src[oLen], len);
    pktLength += len;
    };
  if (pktLength > maxDataLength) SIGNAL(CallFailed, badArgs);
  return pktLength;
  };

int
UnmarshallFormatted(spec, pkt, pktLength, vbls)
  struct ShortSTRING *spec;
  struct PBI *pkt;
  int pktLength;
  int vbls[];
  {
/* a's are now all pointers to variables to be updated with appropriate values.  For Blocks, the receiving variable must contain a block descriptor with element size and overhead specified.  This descriptor will be released.
 */
  int src[];
  int *dests, dest[], len, i;
  char tChar;
  struct Header *hdr;
  struct ShortSTRING *ss;
  struct Type *type;
  int isNil, val, oLen, swapBytes;
  hdr=pkt->pup;
  src = hdr->callData.words;
  for (i = 0; i<spec->length; ++i) {
    Block();
    swapBytes = oLen = 0;
    isNil = src[pktLength++];
    dests=&vbls[i]; if (isNil) *dests=0;
    switch (tChar=spec->text[i]) {
      case 'W':  {
        *dests = swab(isNil); /* no nil test, really */
        continue;
        };
      case 'B': {
        *dests = isNil;
        continue;
        };
      case 'D': {
        --pktLength; /* no "isNil" */
        len=2;
        swapBytes=true;
        break;
        };
      case 'S': {
        if (isNil)  continue;
        ss = (struct ShortSTRING *) &src[pktLength];
        len = (swab(ss->length)+5)/2;
        --pktLength;
        src[pktLength]=src[pktLength+1];
        oLen=2;
        break;
        };
      default: {
        if (isNil)  continue;
        type = types[tChar-'A'];
        if (type==0) SIGNAL(CallFailed, badArgs);
        if ((type->esWord&atLenField)!=0) pktLength+=2;
       /* account for sequence length field */
        len=BlockSize(&src[pktLength], type, 0);
        oLen=type->overhead;
        swapBytes = type->esWord&eltsAreWordsField;
        };
      };
    *dests= (int) (dest=Allocate(myZone, len));
    if (oLen) Marshall(true, dest, &src[pktLength], oLen);
    if (len -= oLen) Marshall(swapBytes, &dest[oLen], &src[pktLength+=oLen], len);
    pktLength+=len;
    };
  if (pktLength > (swab(hdr->length)>>1)-headerSize-1) SIGNAL(CallFailed, badArgs);
  return pktLength;
  };

static UnwindPkt(sig, code, seal)
  int sig, code;
  struct Seal1 *seal;
  {
  ReleasePBI(seal->data[0]);
  DISABLE(seal);
  };

static struct PBI
*GetUnwindPkt(seal)
  struct Seal1 *seal;
  {
  struct PBI *pkt;
  pkt = GetPBI(mySoc);
  ENABLEWithFrame(UNWIND, &UnwindPkt, seal, MyFrame());
  seal->data[0] = (int) pkt;
  return (pkt);
  };

/* *************** Client Interface to RPC *************** */

/* Procedures can return more than one result (retSpec->length>1.)  The first one is returned; it and the others live in the args record beyond the parameters.  Corollary: args record must be big enough to hold both params and results. */

int
CallFormatted(interface, proc, argSpec, retSpec, args)
  struct ImportInstance *interface;
  int *proc;
  struct ShortSTRING *argSpec, *retSpec;
  int *args;
  {
  int pktLength;
  int defArgs[10];
  int callResults[];
  struct PBI *pkt; struct Header *hdr;
  struct Seal1 seal;
  int na;
  pkt = GetUnwindPkt(&seal);
  /* Releases on unwind!!!!!!!!!!!!!!!!!! */
  na = argSpec->length;
  if (args==0) args = defArgs;
  StartCall(pkt, interface, interface->currentConversation);
  hdr = pkt->pup;
  hdr->callData.words[0] = swab(proc);
  pktLength = MarshallFormatted(argSpec, pkt, 1, args);
  Call(pkt, pktLength, maxDataLength);
  callResults = &args[na];
  UnmarshallFormatted(retSpec, pkt, 0, callResults);
  UnwindPkt(0,0,&seal);
  return callResults[0];
  };

/* **************** Server Interface to RPC *************** -- */
  
FreeSpecs(dSpecsT)
  struct DSpecsTable *dSpecsT;
  {
  Free(myZone, dSpecsT);
  };

struct DSpecsTable
*StartDispatcherSpecs(maxProcs)
  int maxProcs;
  {
  struct DSpecsTable *res;
  if (types==0) AddType('Z', 0); /* force type table initialization */
  res = (struct DSpecsTable *) Allocate(myZone, lenDSpecsTable + (maxProcs * lenDSpecs));
  res->Free = &FreeSpecs;
  res->maxProcs = maxProcs;
  return res;
  };

AddToDispatcherSpecs(dSpecsT, procIndex, proc, argSpec, retSpec)
   struct DSpecsTable *dSpecsT;
  int procIndex, *proc;
  struct ShortSTRING *argSpec, *retSpec;
  {
  struct DSpecs *dSpecs;
  procIndex -= lupineOffset;
  if (procIndex >= dSpecsT->maxProcs) SIGNAL(ERROR);
  dSpecs = &dSpecsT->entries[procIndex];
  dSpecs->proc = proc;
  dSpecs->argSpecs = argSpec;
  dSpecs->resSpecs = retSpec;
  Block( );
  };
  
AddType(letter, type)
  char letter;
  struct Type *type;
  {
  if (type==0) {
    types = (struct Type **) Allocate(myZone, 26);
    AddType('Q', dBlock(16, 1, 0, true, true));   /* Word Sequence */
    AddType('C', dBlock(8, 1, 0, true, false)); /* Byte Sequence */
    };
  types[letter-'A'] = type;
  };

int
StdDispatcher(pkt, newLength, conversation, dSpecsT)
  struct PBI *pkt;
  int newLength;
  int *conversation;
  struct DSpecsTable *dSpecsT;
  {
  int args[10];
  int rout, argLen;
  struct DSpecs *dSpecs;
  struct ShortSTRING *argSpecs;
  struct Header *hdr;
  hdr = pkt->pup;
  rout = swab(hdr->callData.words[0]) - lupineOffset;
  if (rout >= dSpecsT->maxProcs) SIGNAL(RejectUnbound);
  dSpecs = &dSpecsT->entries[rout];
  argSpecs = dSpecs->argSpecs;
  argLen = argSpecs->length;
  if (argLen>10) SIGNAL(CallFailed, badArgs);
  if (dSpecs->proc == 0) SIGNAL(RejectUnbound);
  UnmarshallFormatted(argSpecs, pkt, 1, args);
  args[0] = apply(args, dSpecs->proc, argLen); 
  return (MarshallFormatted(dSpecs->resSpecs, pkt, 0, args));
  };

/* The following two procedures MUST be called directly by the interface procedure dispatched to by the StdDispatcher!!!!! */
  
/* Returns args[10];
    n parameters are in args[0..n);
    m results are to go into in args[n..n+m)
  However, StdDispatcher is going to put result 0 in args[n],
  so don't bother.
 */

int *GetDispatcherArgs()
  {
  int *f[];
  f = CallersFrame /* to apply frame */
    (CallersFrame /* to interface procedure */
      (MyFrame /* to GetDispatchersArgs frame */ ()));
  /* Stack is
    [ argLen, dSpecs->proc, (f=>CallersFrame()), return addr, args ]
   */
  return (f[2]);
  };

/* Returns conversation handle used in this call of the server procedure.  This won't work worth beans if the server procedure was called from anywhere but the StdDispatcher.
 */

int *GetServerConversation()
  {
  int *f[];
  f = CallersFrame /* to StdDispatcher's frame */
    (CallersFrame /* to apply frame */
      (CallersFrame /* to interface procedure */
        (MyFrame /* to GetDispatchersArgs frame */ ())));
  /* Stack is [ dspecsT, conversation, (f=>CallersFrame()), return addr, newLength, pkt ] */
  return (f[-1]);
  };
  
/* Most interface exporters are expected to supply:
  dispatcher = StdDispatcher
  dispatcherArgs = a DSpecsTable
  */