/************************************************************************* * * (c) Copyright 1992,1993,1994 by G & A Technical Software, Inc., * 28 Research Drive, Hampton, Virginia, 23666. * * All Rights Reserved. No part of this software or publication may be * reproduced, stored in a retrieval system, or transmitted, in any form * or by any means, electronic, mechanical, photocopying, recording, or * otherwise without the prior written permission of G & A Technical * Software, Inc. * ************************************************************************* * * Filename: * * Purpose: * * Author: John Burton * * Date: 5/31/94 * ************************************************************************* * * Modification History: * * $Log: s3_executive.c,v $ * Revision 2.1 1994/07/08 17:52:20 jcburt * Updated typedefs, defines and function protypes to allow recursive * parsing of pct files. Enabled use of sub-PDT files and scoping of * datasets. Datasets used in a pct must be defined either in the * associated pdt file or the pdt file associated with the direct * ancestors of the current pct file. * * DataSet functions and subroutines now have an additional parameter * passed to them, indicating the number of parameters passed in the * dataset list, i.e. was: function(DataSet **dl) * now: function(int nargs, DataSet **dl) * Parameters passed to the dataset routines from the PCT level are all * still contained in the dataset list, nargs is during the function or * subroutine call from s3_exec_enode * * Revision 2.0.0.1 1994/06/28 18:48:27 jcburt * S3 Version 2.0 Initial Source * * ************************************************************************* * * Revision Control Information: * *************************************************************************/ static char rcsid[] = "$Id: s3_executive.c,v 2.1 1994/07/08 17:52:20 jcburt Exp $"; static char rcsrev[] = "$Revision: 2.1 $"; /************************************************************************* * * Include Files * *************************************************************************/ #include "s3_defines.h" #include "s3_typedefs.h" #include "s3_externals.h" #include "s3_globals.h" #include #include #include /************************************************************************* * * Defines and Macros * *************************************************************************/ #define FACTOR CLOCKS_PER_SEC /************************************************************************* * * Module: s3_breakpoint_event * * Description: * * Syntax: void s3_breakpoint_event() * * Inputs: * * Outputs: * * Returns: * * Modules Called: * *************************************************************************/ void s3_breakpoint_event() {} /************************************************************************* * * Module: s3_init_s3executive * * Description: Initialize Process Control Procedure * - get filename for Process Control Table (PCT) file * - get filename for Parameter Definition Table (PDT) file * - initialize symbol table * - read PDT file and set up Parameter Definition Table * - read PCT file and set up Process Control Tree * - return a pointer to the root (main) PCT node (Pnode) * of the Process Control Tree * * Syntax: void s3_init_s3executive(char *basename) * * Inputs: basename: * * Outputs: * * Returns: * * Modules Called: * *************************************************************************/ void s3_init_s3executive(char *basename) { ST_entry *stentry; double t1,t2; int count,result; t1 = (double)clock(); if(verbose) printf("Initializing PCP (Init_PCP) ...\n"); progname = strsave(basename); pdtfilename = strsave2(basename,".pdt"); pctfilename = strsave2(basename,".pct"); emtfilename = strsave2(basename,".emt"); s3_init_symbol_table(); t2 = (double)clock(); if(verbose) printf("Time Required for Init_PCP = %g secs\n",(t2-t1)/FACTOR); } /************************************************************************* * * Module: s3_exec_pnode * * Description: Main Process Control Procedure * - Gets Execution Order Control list (EOL) and * Execution Order Control index (EOI) for the * PCT node pointed to by pn * - Determines which procedure is to be called next by * getting the element in EOL located at EOI * (EOL[EOI]) * - The value returned by the called procedure determines * what to do next: * - 0 => normal return, continue execution based on * EOL & EOI * - 1 => abnormal return, exit this invocation of exec_pcp * and return a 0 to the routine calling this * invocation of exec_pcp * - n => abnormal return, exit exec_pcp & return n-1 to * calling routine (n = 1,2,3,...) * The returned value allows for unwinding the execution * stack a precise amount * * Syntax: int s3_exec_pnode(Pnode *pn) * * Inputs: pn: * * Outputs: * * Returns: * * Modules Called: * *************************************************************************/ int s3_exec_pnode(Pnode *pn) { int indx, quit; int type,EOI; double t1,t2; byte bp; char ch[2],*EOL; ST_entry *entry,*tmp; ch[1] = '\0'; quit = FALSE; EOL = pn->EOL; EOI = pn->EOI; if(verbose) { fprintf(fperr,"Executing PCT %s\n",pn->name); fprintf(fperr," EOL = %s\n",pn->EOL); fprintf(fperr," EOI = %d\n",pn->EOI); fprintf(fperr,"PNODE NDS = %d\n",pn->NDS); } if(pn->NDS > 0) { if(pn->dslist[0]->ds.type != INT) s3_error(LOC,"datatype of first pct parameter must be INT"); pn->EOI = pn->dslist[0]->ds.d.in[0]; if(verbose) fprintf(fperr,"New EOI = %d\n",pn->dslist[0]->ds.d.in[0]); } if(pn->NDS > 1) { type = pn->dslist[1]->ds.type; if((type != STRING)&&(type != CHAR)) s3_error(LOC,"datatype of second pct parameter must be STRING or CHAR"); pn->EOL = pn->dslist[1]->ds.d.st; if(verbose) fprintf(fperr,"New EOI = %s\n",pn->dslist[1]->ds.d.st); } if(verbose) { fprintf(fperr,"After parsing PCT %s parameter list\n",pn->name); fprintf(fperr," EOL = %s\n",pn->EOL); fprintf(fperr," EOI = %d\n",pn->EOI); } while(!quit) { pct_info->current_pct = (ST_entry *)pn; if(pn->EOI >= strlen(pn->EOL)) { pn->EOI = 0; quit = TRUE; } else { /*************Not used yet**************** bp = pn->breakpt[pn->EOI]; if(bp) s3_breakpoint_event(); *****************************************/ ch[0] = pn->EOL[pn->EOI]; s3_dprint("in exec_pnode - index = %d, ch = %c",pn->EOI,ch); pn->EOI++; if((indx = strcspn(pn->elkey,ch)) >= strlen(pn->elkey)) quit = TRUE; else { if(verbose) fprintf(fperr,"EOI = %d => Executing routine %s ...\n",pn->EOI-1,pn->elist[indx]->ss.name); s3_dprint(" in exec_pnode - name = %s ",pn->name); t1 = (double)clock(); entry = pn->elist[indx]; tmp = s3_get_symbol(entry->ss.name); type = entry->ss.type; if(type == PNODE) quit = s3_exec_pnode((Pnode *)entry); else quit = s3_exec_enode((Enode *)entry); t2 = (double)clock(); tmp->ss.count += 1; tmp->ss.qtime += ((t2-t1)/FACTOR); } } } quit--; pn->EOL = EOL; pn->EOI = EOI; return quit; } /************************************************************************* * * Module: s3_exec_enode * * Description: * * Syntax: int s3_exec_enode(Enode *en) * * Inputs: en: * * Outputs: * * Returns: * * Modules Called: * *************************************************************************/ int s3_exec_enode(Enode *en) { int i, nds, quit; int (*func)(); int type; DataSet **dl; quit = FALSE; func = en->function; dl = (DataSet **)en->dslist; type = en->type; nds = en->NDS; if(debug) { s3_dprint(" in exec_enode - name = %s",en->name); s3_dprint(" func = %p",en->function); s3_dprint(" type = %x",en->type); s3_dprint(" nds = %d",en->NDS); fprintf(fperr,"%s has %d datasets \n",en->name,nds); for(i=0;i ",i); s3_display_dataset(dl[i],fperr); } } for(i=0;id.data == NULL) dl[i] = (DataSet *)s3_allocate_dataset(dl[i]); switch(type) { case CFUNC : quit = s3_call_c_function(func,nds,dl); break; case CSUBR : (void) s3_call_c_subroutine(func,nds,dl); break; case DFUNC : quit = (func)(nds,dl); break; case DSUBR : (func)(nds,dl); break; case FFUNC : quit = s3_call_f_function(func,nds,dl); break; case FSUBR : (void)s3_call_f_subroutine(func,nds,dl); break; default: s3_internal_error(__FILE__,__LINE__,LOC,"exec_enode: %s has invalid procedure type - %x",en->name,type); break; } return quit; }