/* SETLABEL -- called when a label is first seen. It allocates
* space for the label on the dictionary and also copies the
* label name onto the dictionary. The label is placed at the
* top of a linked list.
*/
struct label *
setlabel (struct operand *name)
{
struct label *p;
p = (struct label *) memneed (sizeof(struct label));
p->l_name = comdstr (name->o_val.v_s);
if (label1 == NULL)
p->l_next = NULL;
else
p->l_next = label1;
label1 = p;
return (p);
}
/* <increment to be added to named parameter> .
*/
void
o_addassign (memel *argp)
{
/* order of operands will be incorrect.
* strictly speaking, only strings are not commutative but we need
* to pop both operands anyway to check.
*/
char *pname = (char *) argp;
char *pk, *t, *p, *f;
struct param *pp;
struct operand o1, o2;
breakout (pname, &pk, &t, &p, &f);
pp = paramsrch (pk, t, p);
validparamget (pp, *f);
o1 = popop();
o2 = popop();
if ((o2.o_type & OT_BASIC) == OT_STRING) {
/* copy o2 onto dictionary to avoid overwriting it on stack
* when o1 is pushed. we can get by with not worrying about o1
* as long as whatever code copies the string works when the
* strings overlap.
*/
XINT oldtopd = topd;
char *s2 = memneed (btoi (strlen (o2.o_val.v_s) + 1));
strcpy (s2, o2.o_val.v_s);
o2.o_val.v_s = s2;
pushop (&o1);
pushop (&o2);
topd = oldtopd; /* discard temp string area */
} else {
pushop (&o1);
pushop (&o2);
}
binop (OP_ADD);
paramset (pp, *f);
pp->p_flags |= P_SET;
}
/* ADDCONST -- Called during parsing to convert string s into operand of
* type t and push it as an operand onto the dictionary (NOT the operand
* stack).
* Use dictionary because this routine is called at compile time and the
* operand stack is being filled with compiled code; use dictionary as
* a quiet workspace.
* Convert as per makeop().
* Return dictionary index of new operand entry so that it may be used as
* ((struct operand *)&dictionary[$1])->o_... in yacc specs.
*/
XINT
addconst (char *s, int t)
{
register struct operand *op;
XINT lasttopd;
lasttopd = topd; /* could just derefenece op */
op = (struct operand *) memneed (OPSIZ);
if (t == OT_STRING) {
/* makeop with an OT_STRING type will reuse the
* string pointer but we want to compile into the dictionary.
* fortunately, it's easy because lex has already removed any
* surrounding quotes.
*/
op->o_type = t;
op->o_val.v_s = comdstr (s);
} else
*op = makeop (s, t);
return (lasttopd);
}
/* LOGIN -- Hand-craft the first cl process. Push the first task to become
* currentask, set up clpackage at pachead and set cl as its first ltask.
* Add the builtin function ltasks. Run the startup file as the stdin of cl.
* If any of this fails, we die.
*/
static void
login (char *cmd)
{
register struct task *tp;
register char *ip, *op;
struct ltask *ltp;
struct operand o;
char *loginfile = LOGINFILE;
char alt_loginfile[SZ_PATHNAME];
char clstartup[SZ_PATHNAME];
char clprocess[SZ_PATHNAME];
char *arglist;
strcpy (clstartup, HOSTLIB);
strcat (clstartup, CLSTARTUP);
strcpy (clprocess, CLDIR);
strcat (clprocess, CLPROCESS);
tp = firstask = currentask = pushtask();
tp->t_in = tp->t_stdin = stdin;
tp->t_out = tp->t_stdout = stdout;
tp->t_stderr = stderr;
tp->t_stdgraph = fdopen (STDGRAPH, "w");
tp->t_stdimage = fdopen (STDIMAGE, "w");
tp->t_stdplot = fdopen (STDPLOT, "w");
tp->t_pid = -1;
tp->t_flags |= (T_INTERACTIVE|T_CL);
/* Make root package. Avoid use of newpac() since pointers are not
* yet set right.
*/
pachead = topd;
curpack = (struct package *) memneed (PACKAGESIZ);
curpack->pk_name = comdstr (ROOTPACKAGE);
curpack->pk_ltp = NULL;
curpack->pk_pfp = NULL;
curpack->pk_npk = NULL;
curpack->pk_flags = 0;
/* Make first ltask.
*/
ltp = newltask (curpack, "cl", clprocess, (struct ltask *) NULL);
tp->t_ltp = ltp;
ltp->lt_flags |= (LT_PFILE|LT_CL);
tp->t_pfp = pfileload (ltp); /* call newpfile(), read cl.par */
tp->t_pfp->pf_npf = NULL;
setclmodes (tp); /* uses cl's params */
setbuiltins (curpack); /* add more ltasks off clpackage*/
/* Define the second package, the "clpackage", and make it the
* current package (default package at startup). Tasks subsequently
* defined by the startup script will get put in clpackage.
*/
curpack = newpac (CLPACKAGE, "bin$");
/* Compile code that will run the startup script then, if it exists
* in the current directory, a login.cl script. We need to do as
* much by hand here as the forever loop in main would have if this
* code came from calling yyparse().
*/
if (c_access (clstartup,0,0) == NO)
cl_error (E_FERR, "Cannot find startup file `%s'", clstartup);
currentask->t_bascode = 0;
pc = 0;
o.o_type = OT_STRING;
o.o_val.v_s = clstartup;
compile (CALL, "cl");
compile (PUSHCONST, &o);
compile (REDIRIN);
compile (EXEC);
compile (FIXLANGUAGE);
/* The following is to permit error recovery in the event that an
* error occurs while reading the user's LOGIN.CL file.
*/
validerrenv = 1;
if (setjmp (errenv)) {
eprintf ("Error while reading login.cl file");
eprintf (" - may need to rebuild with mkiraf\n");
eprintf ("Fatal startup error. CL dies.\n");
clexit();
}
ninterrupts = 0;
if (setjmp (jumpcom))
onerr();
/* Nondestructively decompose the host command line into the startup
* filename and/or the argument string.
*/
if (strncmp (cmd, "-f", 2) == 0) {
for (ip=cmd+2; *ip && isspace(*ip); ip++)
;
for (op=alt_loginfile; *ip && ! isspace(*ip); *op++ = *ip++)
;
*op = EOS;
for ( ; *ip && isspace(*ip); ip++)
;
arglist = ip;
} else {
*alt_loginfile = EOS;
arglist = cmd;
}
/* Copy any user supplied host command line arguments into the
* CL parameter $args to use in the startup script (for instance).
*/
o.o_type = OT_STRING;
strcpy (o.o_val.v_s, arglist);
compile (PUSHCONST, &o);
compile (ASSIGN, "args");
if (alt_loginfile[0]) {
if (c_access (alt_loginfile,0,0) == NO)
printf ("Warning: script file %s not found\n", alt_loginfile);
else {
o.o_val.v_s = alt_loginfile;
compile (CALL, "cl");
compile (PUSHCONST, &o);
compile (REDIRIN);
compile (EXEC);
}
} else if (c_access (loginfile,0,0) == NO) {
char *home = envget ("HOME");
char global[SZ_LINE];
memset (global, 0, SZ_LINE);
sprintf (global, "%s/.iraf/login.cl", home);
if (c_access (global, 0, 0) == YES) {
o.o_val.v_s = global;
compile (CALL, "cl");
compile (PUSHCONST, &o);
compile (REDIRIN);
compile (EXEC);
} else {
printf ("Warning: no login.cl found in login directory\n");
}
} else {
o.o_val.v_s = loginfile;
compile (CALL, "cl");
compile (PUSHCONST, &o);
compile (REDIRIN);
compile (EXEC);
}
compile (END);
topos = basos = pc - 1;
pc = 0;
run(); /* returns after doing the first EXEC */
/* Add nothing here that will effect the dictionary or the stacks.
*/
if (cldebug)
printf ("topd, pachead, parhead: %u, %u, %u\n",
topd, pachead, parhead);
}