/* (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. */
/* SCCS Info: @(#)cherm.c	1.10 3/13/90 */

#include <stdio.h>
#include <varargs.h>

#define ISCHERM
#include "cherm.h"
#include "storage.h"

/* need sysdep due to use of varargs */
#include "sysdep.h"

static argblock argb;
static schedblock schedb;

extern flag cherm_flag;		/* interpreter flag for C-Hermes. */
extern predef_exception cherm_excep;
				/* this is where NILI puts the exception */
				/*  codes when raise_predefined() is called. */

object *Bottom;
static object bottom_obj;


qualholder _qh;

status
init_cherm()
{
    status init_keys();
    status init_chermargs();
    void free_keys();
    void abort_nili();

    /* init_keys needs Bottom */
    bottom_obj.value.integer = 0;
    bottom_obj.tsdr = &dr_bottom;
    Bottom = &bottom_obj;

    if (!init_keys()) goto cleanup;
    if (!init_chermargs()) {
      free_keys();
      goto cleanup;
    }
    cherm_flag = FALSE;		/* while C-Hermes operations are in */
				/* progress, this flag must be TRUE */
    return(SUCCESS);

  cleanup:
    abort_nili("init_cherm");
    /*NOTREACHED*/
}


static status
init_chermargs()
{
    void no_scheduling();

    if ((schedb.ready = new(pcb)) is nil) goto cleanup;
    schedb.ready->state = READY;
    schedb.ready->ep.h = nil;
    if ((schedb.ready->ep.h = getdotmain(3)) is nil) goto cleanup; 
    schedb.ready->ep.h->info.context = nil;
    if ((schedb.ready->ep.h->info.context = new(context_info)) is nil)
      goto cleanup;
    schedb.ready->ep.h->info.context->estack = nil;
    schedb.ready->next = schedb.ready->prev = schedb.ready;
    schedb.blocked = schedb.blocked_nokey = schedb.newprocs = nil;

    schedb.suspend = schedb.wakeup = schedb.wakeup_proc = schedb.kill
      = schedb.add = schedb.make_current = schedb.advance = no_scheduling;

    argb.nextop = -1;
    argb.sched = &schedb;
    return(SUCCESS);

  cleanup:
    /* insufficient stg... release any we managed to get, and then fail */
    if (schedb.ready isnt nil) {
	if (schedb.ready->ep.h isnt nil) {
	    if (schedb.ready->ep.h->info.context isnt nil)
	      { dispose(schedb.ready->ep.h->info.context,context_info); }
	    { freedotmain(schedb.ready->ep.h,3); }
	}
	{ dispose(schedb.ready,pcb); }
    }
    nilerror("init_chermargs","Unable to allocate C-Hermes scheduler block");
    return(FAILURE);
}


static void
no_scheduling()
{
    nilerror("no_scheduling", "Scheduler invoked while in C-Hermes mode!\n");
    abort_nili("no_scheduling");
}


static predef_exception
docall(func, argv)
void (*func)();
va_list argv;
{
    int argc;
    flag oldcherm;


    argc = 0;
    do
      argb.operandstack[argc] = va_arg(argv, object *);
    while (argb.operandstack[argc++] isnt nil);

    oldcherm = cherm_flag;  cherm_flag = TRUE;
    cherm_excep = Normal;	/* clear error status */
    (*func)(&argb);		/* call NILI function */
    cherm_flag = oldcherm;

    va_end(argv);		/* end argument list traversal */

    return(cherm_excep);	/* return error status */
}



/*VARARGS*/
predef_exception
h_call(va_alist)
va_dcl
{
    void (*func)();
    va_list argv;


    argb.qualifiers.integer = 0;

    va_start(argv);
    func = (void (*)()) va_arg(argv, int *);

    return(docall(func, argv));
}


/*VARARGS*/
predef_exception
h_qcall(va_alist)
va_dcl
{
    void (*func)();
    va_list argv;
    qualholder qual;


    va_start(argv);
    func = (void (*)()) va_arg(argv, int *);

    qual = union_va_arg(argv, qualholder);
    argb.qualifiers = qual.val;

    return(docall(func, argv));
}


/*VARARGS*/
predef_exception
h_scall(va_alist)
va_dcl
{
    void (*func)();
    va_list argv;
    schedblock *sched, bogus_sched;
    predef_exception excep;

    va_start(argv);
    func = (void (*)()) va_arg(argv, int *);
    sched = va_arg(argv, schedblock *);
    bogus_sched = schedb;
    schedb = *sched;

    argb.qualifiers.integer = 0;
    excep = docall(func, argv);

    *sched = schedb;
    schedb = bogus_sched;

    return(excep);
}



/*VARARGS*/
predef_exception
h_lookup(va_alist)
va_dcl
{
    va_list argv;


    argb.qualifiers.integer = 0; /* use primary key (key 0) */

    va_start(argv);

    return(docall(o_find, argv));
}


/*VARARGS*/
predef_exception
h_lookup_secondary(va_alist)
va_dcl
{
    va_list argv;


    argb.qualifiers.integer = 1; /* use secondary key (key 1) */

    va_start(argv);

    return(docall(o_find, argv));
}
