/* (C) Copyright International Business Machines Corporation 23 January */
/* 1990.  All Rights Reserved. */
/*  */
/* See the file USERAGREEMENT distributed with this software for full */
/* terms and conditions of use. */
#ifndef lint
static char sccsinfo[] = "@(#)hermcall.c	1.16 2/13/92";
#endif

#include <varargs.h>

#include "cherm.h"
#include "storage.h"

#include "predefined.cd"

/* following is used to save important local variables to make sure */
/* optimizations won't screw up their availability on return via */
 /* longjmp (ugh!) */

typedef struct hermcall_save_struct {
  int argc;
  schedblock *sched;
  pcb *current;
  dfd_callmessage *cm;
  object *cmobj;
  message *cmmsg;
  callmessage_info *suspinfo;
  struct hermcall_save_struct *prev;
} hermcall_save;
static hermcall_save *callstack = nil;

/*VARARGS*/
status
hermcall(va_alist)
va_dcl
{
  void set_trigger();
  predef_exception call_subr();
  void make_current();
  
  va_list argv;
  JumpBuf jbuf;
  schedblock *sched;
  argblock args;
  int argc;
  pcb *current;
  object *Errobj;
  status retval;
  
  dfd_callmessage *cm = nil;
  object *cmobj = nil;
  message *cmmsg = nil;
  callmessage_info *suspinfo = nil;
  hermcall_save *save = nil;

  va_start(argv);
  sched = va_arg(argv, schedblock *);
  current = sched->ready;
  
  if ((Errobj = (object *) SetJmp(jbuf)) is nil) {
    set_trigger(current, jbuf);
    
    args.nextop = 0;
    args.qualifiers.integer = nil;
    args.sched = sched;
    
    argc = 0;
    
    do {
      args.operandstack[argc] = va_arg(argv, objectp);
    } while (args.operandstack[argc++] isnt nil);
    
    cm = getdotmain(argc);	/* this struct is dynamically sized */
    if (cm isnt nil)
      suspinfo = new(callmessage_info);
    if (suspinfo isnt nil)
      cmobj = new(object);
    if (cmobj isnt nil)
      cmmsg = new(message);
    if (cmmsg isnt nil)
      save = new(hermcall_save);
    if (save is nil) {
      nilerror("hermcall","out of memory");
      abort_nili("hermcall");
    }
    cm->info.callmessage = suspinfo;
    
    if (call_subr(& args.operandstack[0], args.sched, cmobj, cmmsg, cm)
	isnt Normal)
      return(FAILURE);
    
    /* we enter the mainloop wanting the current process (the C-process) */
    /* descheduled and the process awakened by call_subr() in the */
    /* newprocs field waiting to be revived.  */
    
    sched->suspend(sched, current, nil);
    save->argc = argc;
    save->sched = sched;
    save->current = current;
    save->cm = cm;
    save->cmobj = cmobj;
    save->cmmsg = cmmsg;
    save->suspinfo = suspinfo;
    save->prev = callstack;
    callstack = save;

    main_loop(sched);
    
    /*NOTREACHED*/
  }
  
  else {
    /* main_loop() returns here.  the C-process has been added back to */
    /* the ready ring, but may not be the current process.  so we call */
    /* the hokey function make_current() to advance the ring to the */
    /* C-process. */
    
    /* restore our local variables */
    save = callstack;
    callstack = save->prev;
    argc = save->argc;
    sched = save->sched;
    current = save->current;
    cm = save->cm;
    cmobj = save->cmobj;
    cmmsg = save->cmmsg;
    suspinfo = save->suspinfo;
    dispose(save, hermcall_save)

    sched->make_current(sched, current);
    
    /* free up space allocated specially for our call */
    { freedotmain(cm, argc); }
    dispose(suspinfo, callmessage_info);
    dispose(cmobj, object);
    
    if (obj_case_of(Errobj) is handler_type__others)
      retval = SUCCESS;	/* no error. */
    else
      retval = FAILURE;	/* signal that some error happened. */
    
    /* return storage allocated for Errobj by the schduler's */
    /* triggering mechanism */
    dispose(Errobj, object);

    return(retval);
  }
}



