void pipc(const char *unixfile, const char *cpmfile, int bin)
{
FILE *ufid;
char name[9], ext[4];
C_FILE *cid;
int flag = 0;
if ((ufid = fopen(unixfile, "r")) == NULL) {
printf("can't open %s\n", unixfile);
return;
}
if (!(namesep(cpmfile, name, ext)))
return;
if (bin)
flag = BINARY;
if ((cid = c_creat(name, ext, flag)) == NULL)
return;
if (bin)
pipbin(cid, ufid);
else
piptext(cid, ufid);
c_close(cid);
fclose(ufid);
}
void virtual_kb_close(char *c) {
c_close();
}
static void grammar_pre(struct s_node *n) {
int i, r = 0;
struct s_node *p;
static int cooked = 0;
g_node = n;
if (arg_defines()) {
c_str("#include \"");c_str(arg_defines());c_strln("\"");
if (arg_feed() && cooked) {
c_strln("#undef PACC_NAME");
c_strln("#define PACC_NAME PACC_FEED_NAME");
}
} else
c_defines();
++cooked;
pre_decl();
/* We slightly simplify both building & walking the tree and insist
* that every grammar starts with a preamble, which may be null.
* It's a bit odd to represent no preamble with an empty preamble
* node. */
p = n->first;
assert(p->type == preamble);
if (!arg_defines() && p->text) c_raw(p->text);
p = p->next;
for ( ; p; p = p->next) {
assert(p->type == rule);
++r;
}
c_str("static const int n_rules = "); c_int(r); c_semi();
c_str("static const int start_rule_id = "); c_long(n->first->next->id);
c_semi();
g_name = n->text;
/* type of start rule is always u0 */
type_list(n->first->next->first->text);
for (p = n->first; p; p = p->next)
if (p->type == rule) type_list(p->first->text);
c_str("union PACC_SYM(vals)"); c_open();
for (i = 0; i < t_max; ++i) {
c_str(t_list[i]); c_str(" u"); c_int(i); c_semi();
}
c_close(); c_semi();
/* XXX just for debugging */
c_str("#define TYPE_PRINTF ");
if (strcmp(n->first->next->first->text, "int") == 0) c_str("\"%d\"");
else if (strcmp(n->first->next->first->text, "char *") == 0) c_str("\"%s\"");
else c_str("\"%p\"");
c_strln("");
c_str("#define PACC_TYPE "); c_strln(n->first->next->first->text);
pre_engine();
c_str("_st=");
c_long(n->first->type == preamble ? n->first->next->id : n->first->id);
c_semi();
c_strln("goto top;");
c_strln("contin:");
c_strln("_st=_cont;");
c_strln("PACC_TRACE fprintf(stderr, \"continuing in state %d\\n\", _cont);");
c_strln("top:");
c_strln("PACC_TRACE fprintf(stderr, \"switch to state %d\\n\", _st);");
c_str("switch(_st)"); c_open();
}
void
cl_error (int errtype, char *diagstr, ...)
{
va_list args;
register struct task *tp;
static int nfatal = 0;
static int break_locks = 1;
va_start (args, diagstr);
/* (Re)-initialize the error action.
*/
erract_init();
/* Safety measure, in the event of error recursion.
*/
if (err_abort) {
if (nfatal)
clexit();
if (errlev++ > 2) {
nfatal++;
eprintf ("Error recursion. Cl dies.\n");
clexit();
}
}
/* The first setjmp(errenv) is not done until we start the main loop.
* Set validerrenv when start the first interactive cl to indicate that
* we may safely longjmp back to main's loop on an error. ERRENV is
* not set for bkg jobs since error restart is not permitted.
*/
if (!validerrenv && !(firstask->t_flags & T_BATCH)) {
nfatal++;
u_doprnt (diagstr, &args, currentask->t_stderr);
if (errtype & E_P)
perror ("\nOS errmsg");
else
eprintf ("\n");
eprintf ("Fatal startup error. CL dies.\n");
clexit();
}
/* Any error occurring during logout is fatal.
*/
if (loggingout || gologout) {
nfatal++;
u_doprnt (diagstr, &args, currentask->t_stderr);
if (errtype & E_P)
perror ("\nOS errmsg");
else
eprintf ("\n");
eprintf ("Fatal logout error. CL dies.\n");
clexit();
}
/* Perform any ONERROR error recovery in the vos first. Initialize
* the error recovery mechanism (necessary since the iraf main is not
* being allowed to do error recovery).
*/
c_xonerr (1);
XER_RESET(); /* TODO: move into LIBC interface */
/* Clear terminal raw mode if still set. */
c_fseti ((XINT)STDIN, F_RAW, NO);
if (firstask->t_flags & T_BATCH)
eprintf ("\n[%d] ", bkgno);
if (errtype & E_IERR)
eprintf ("INTERNAL ");
if (errtype & E_FERR)
eprintf ("FATAL ");
/* Disable error tracing if requested.
*/
if (err_trace == YES || (errtype & E_UERR)) {
if (currentask->t_flags & T_SCRIPT &&
currentask->t_flags & T_INTERACTIVE)
eprintf ("ERROR on line %d: ", errorline);
else
eprintf ("ERROR: ");
u_doprnt (diagstr, &args, currentask->t_stderr);
if (errtype & E_P)
perror ("\nOS errmsg");
else
eprintf ("\n");
}
/* Log the error message if from a script or an executable.
*/
if (!errlog && keeplog() && log_errors()) {
if (currentask->t_flags & T_SCRIPT || currentask->t_pid != -1) {
PKCHAR buf[SZ_LINE+1];
FILE *fp;
int fd;
fd = c_stropen (buf, SZ_LINE, NEW_FILE);
fp = fdopen (fd, "w");
fprintf (fp, "ERROR on line %d: ", errorline);
u_doprnt (diagstr, &args, fp);
fclose (fp);
c_close (fd);
putlog (currentask, c_strpak (buf, (char *)buf, SZ_LINE));
}
}
errlog = 0;
/* Initialize the current command block but do not log the command
* which aborted. If we're only trapping errors and not fully
* recovering, don't reset the command block so we have the option
* to continue execution.
*/
if ((err_abort == YES && do_error == NO) ||
(do_error == YES || (errtype & E_UERR)))
yy_startblock (NOLOG);
/* Delete all pipefiles. Call iofinish() first as some OS's may
* require that the files be closed before they can be deleted.
*/
for (tp=currentask; !(tp->t_flags & T_INTERACTIVE); tp=next_task(tp)) {
iofinish (tp);
if (tp == firstask)
break;
}
delpipes (0);
/* Do not go on if this is a fatal error or we are unattended.
*/
if (errtype & E_FERR) {
nfatal++;
pr_dumpcache (0, break_locks);
clexit();
} else if (firstask->t_flags & T_BATCH)
clshutdown();
/* Reset state variables. */
/* Most of these probably needn't be reset, but we'll play
* it safe.
*/
nestlevel = 0; /* set nesting to 0 */
offsetmode (0); /* offset mode to index */
ncaseval = 0; /* number of case values */
n_indexes = 0;
imloopset = 0; /* in an implicit loop */
n_oarr = 0; /* implicit loop indicators */
i_oarr = 0;
maybeindex = 0; /* sexagesimal/index range */
parse_state = PARSE_FREE;
if (last_parm) { /* have we tried to add a param */
last_parm->p_np = NULL;
currentask->t_pfp->pf_lastpp = last_parm;
last_parm = NULL;
}
/* Set the error flag. */
errcom.errflag++;
errcom.nhandlers++;
/* Get back to an interactive state. We simply return if we're
* trapping errors except when processing a E_UERR. These type
* messages come from the CL itself and require user attention to
* correct (e.g. task not found, parameter type/syntax errors, etc).
* The calling procedure is not expecting us to return, so we cannot
* properly trap without rewriting the calling code.
*/
if (cltrace) {
eprintf ("cl_error: abort=%d beep=%d trace=%d flpr=%d\n",
err_abort, err_beep, err_trace, err_flpr);
eprintf ("cl_error: code=%d do_err=%d errtype=%d/%d task='%s'\n",
errcom.errcode, do_error, errtype, errtype&E_UERR,
currentask->t_ltp->lt_lname);
}
if ((err_abort == YES && do_error == NO) ||
(do_error == YES || (errtype & E_UERR))) {
extern ErrCom errcom;
register struct param *pp;
if (!errcom.errcode && (errtype & E_UERR)) {
errcom.errcode = errtype;
strcpy (errcom.errmsg, diagstr);
strcpy (errcom.task, currentask->t_ltp->lt_lname);
pp = paramfind (firstask->t_pfp, "$errno", 0, YES);
pp->p_val.v_i = errcom.errcode;
pp = paramfind (firstask->t_pfp, "$errmsg", 0, YES);
pp->p_val.v_s = errcom.errmsg;
pp = paramfind (firstask->t_pfp, "$errtask", 0, YES);
pp->p_val.v_s = errcom.task;
}
taskunwind();
/* If an abort occurs while interrupts are disabled they will
* never get reenabled unless we do so here.
*/
intr_reset();
/* Go back to main loop in main().
*/
va_end (args);
longjmp (errenv, 1);
} else {
va_end (args);
return;
}
}
