/* (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.12 3/13/90";
#endif

#include <varargs.h>

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

#include "predefined.cd"

/*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;


    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);

	{
	    dfd_callmessage *cm = nil;
	    object *cmobj = nil;
	    message *cmmsg = nil;
	    callmessage_info *suspinfo = 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 is nil) {
		nilerror("hermcall","out of memory");
		abort_nili("hermcall");
	    }
	    cm->info.callmessage = suspinfo;

	    if (call_subr(&args, cmobj, cmmsg, cm) isnt Normal)
	      return(FAILURE);

/*	    { freedotmain(cm, argc); } */
/* should the free be moved to the else? */
	}

	/* 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);

	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. */

	sched->make_current(sched, current);

	if (case_of(Errobj) is handler_type__others)
	  return(SUCCESS);	/* no error. */
	else
	  return(FAILURE);	/* signal that some error happened. */

	/* what about storage of Errobj? */
    }
}
