Пример #1
0
void 
o_doaddpipe (memel *argp)
{
	XINT	getpipe_pc = *argp;
	char	*x1, *pk, *t, *x2;	
	char	*ltname;
	struct	operand	o;
	struct	ltask *ltp;
	char	*addpipe();

	/* ADDPIPE is called immediately before REDIR and before EXEC so we
	 * do not have to worry about storing the pipefile name in the dict.
	 * Our argument is the PC of the GETPIPE instruction, the args field
	 * of which is the taskname of the second task in the pipe.  If either
	 * the new task (first task in the pipe) or the second task is a
	 * FOREIGN task, the pipe must be created as a text file.
	 */
	ltname = (char *)&(coderef(getpipe_pc)->c_args);
	if (*ltname == '$')
	    ltname++;
	breakout (ltname, &x1, &pk, &t, &x2);
	ltp = cmdsrch (pk, t);

	binpipe = ((ltp == NULL || !(ltp->lt_flags & LT_FOREIGN)) &&
	    !(newtask->t_flags & T_FOREIGN));

	if (binpipe)
	    newtask->t_flags |= T_STDOUTB;

	o.o_type = OT_STRING;
	o.o_val.v_s = comdstr (addpipe());
	pushop (&o);
}
Пример #2
0
/* <name of file to be used as stdout> .
 */
void 
o_redir (void)
{
	struct	operand o;
	char	*fname, *mode;

	opcast (OT_STRING);
	o = popop();
	fname = (o.o_val.v_s);

	if (newtask->t_flags & T_FOREIGN && newtask->t_stdout == stdout) {
	    /* If foreign task let ZOSCMD open the spool file.
	     */
	    newtask->ft_out = comdstr (fname);

	} else if (strcmp (fname, IPCOUT) == 0) {
	    /* Redirect the task stdout via IPC to a subprocess. */
	    newtask->t_stdout = newtask->t_out;
	    newtask->t_flags |= T_IPCIO;

	} else {
	    mode = (newtask->t_flags & T_STDOUTB) ? "wb" : "w";

	    if ((newtask->t_stdout = fopen (fname, mode)) == NULL)
		cl_error (E_UERR, e_wopen, fname);

	    newtask->t_flags |= T_MYOUT;
	}
}
Пример #3
0
/* <name of file to be used as stderr> .
 * redirect everything, including the stderr channel.
 */
void 
o_allredir (void)
{
	struct	operand o;
	char	*fname, *mode;

	opcast (OT_STRING);
	o = popop();
	fname = (o.o_val.v_s);

	if (newtask->t_flags & T_FOREIGN &&
	    newtask->t_stdout == stdout && newtask->t_stderr == stderr) {

	    /* If foreign task and i/o has not already been redirected by
	     * the parent, let ZOSCMD open the spool file.
	     */
	    newtask->ft_out = newtask->ft_err = comdstr (fname);

	} else {
	    mode = (newtask->t_flags & T_STDOUTB) ? "wb" : "w";

	    if ((newtask->t_stderr = fopen (fname, mode)) == NULL)
		cl_error (E_UERR, e_wopen, fname);

	    newtask->t_stdout = newtask->t_stderr;
	    newtask->t_flags |= (T_MYOUT|T_MYERR);
	}
}
Пример #4
0
/* 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);
}
Пример #5
0
void 
o_dogetpipe (
    memel *argp			/* name of ltask (not used) */
)
{
	struct	operand o;
	char	*getpipe(), *comdstr();

	/* GETPIPE is called immediately before REDIRIN and before EXEC so we
	 * do not have to worry about storing the pipefile name in the dict.
	 * The flag binpipe is set by the last ADDPIPE if the pipe is a binary
	 * file.
	 */
	if (binpipe)
	    newtask->t_flags |= T_STDINB;

	o.o_type = OT_STRING;
	o.o_val.v_s = comdstr (getpipe());
	pushop (&o);
}
Пример #6
0
/* 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);
}
Пример #7
0
/* <name of file to be used as stdin> .
 */
void 
o_redirin (void)
{
	struct	operand o;
	char	*fname, *mode;

	opcast (OT_STRING);
	o = popop();
	fname = (o.o_val.v_s);

	if (newtask->t_flags & T_FOREIGN && newtask->t_stdin == stdin) {
	    /* If foreign task let ZOSCMD open the command file.
	     */
	    newtask->ft_in = comdstr (fname);
	} else {
	    mode = (newtask->t_flags & T_STDINB) ? "rb" : "r";

	    if ((newtask->t_stdin = fopen (fname, mode)) == NULL)
		cl_error (E_UERR, e_ropen, fname);

	    newtask->t_flags |= T_MYIN;
	}
}
Пример #8
0
/* <name of file to be appended> .
 */
void 
o_append (void)
{
	struct	operand o;
	char	*fname, *mode;

	opcast (OT_STRING);
	o = popop();
	fname = (o.o_val.v_s);

	if (newtask->t_flags & T_FOREIGN && newtask->t_stdout == stdout) {
	    /* If foreign task let ZOSCMD open the spool file.
	     */
	    newtask->ft_out = comdstr (fname);
	    newtask->t_flags |= T_APPEND;
	} else {
	    mode = (newtask->t_flags & T_STDOUTB) ? "ab" : "a";

	    if ((newtask->t_stdout = fopen (fname, mode)) == NULL)
		cl_error (E_UERR, e_appopen, fname);

	    newtask->t_flags |= T_MYOUT;
	}
}
Пример #9
0
int 
crackident (char *s)
{
	struct keywords {
		char *k_name;		/* the keyword string itself.	*/
		short k_token;		/* yacc %token for the keyword	*/
		short k_yylval;		/* the value associated with token.*/
	};

	static struct keywords kw[] = {

	    /* Control flow keywords.
	     */
	    { "while",  Y_WHILE,  0 },	{ "if",        Y_IF,        0 },
	    { "else",   Y_ELSE,   0 },	{ "switch",    Y_SWITCH,    0 },
	    { "case",   Y_CASE,   0 },	{ "default",   Y_DEFAULT,   0 },
	    { "break",  Y_BREAK,  0 },	{ "next",      Y_NEXT,      0 }, 
	    { "return", Y_RETURN, 0 },	{ "goto",      Y_GOTO,      0 },
	    { "for",    Y_FOR,    0 },	{ "procedure", Y_PROCEDURE, 0 },
	    { "begin",  Y_BEGIN,  0 },	{ "end",       Y_END,       0 },
	    { "iferr",  Y_IFERR,  0 },	{ "ifnoerr",   Y_IFNOERR,   0 },
	    { "then",   Y_THEN,   0 },

	    /* Parameter and variable types.
	     */
	    { "int",    Y_INT,    0 },	{ "char",      Y_STRING,    0 },
	    { "real",   Y_REAL,   0 },	{ "string",    Y_STRING,    0 },
	    { "file",   Y_FILE,   0 },	{ "gcur",      Y_GCUR,      0 },
	    { "imcur",  Y_IMCUR,  0 },	{ "ukey",      Y_UKEY,      0 },
	    { "pset",   Y_PSET,   0 },	{ "bool",      Y_BOOL,      0 },
	    { "struct", Y_STRUCT, 0 },

	    /* debugging commands.
	     */
	    { "d_d",    D_D,      0 },
	    { "d_peek", D_PEEK,   0 },

	    { "", 0, 0 } 		/* sentinel; leave it here... */
	};

	static struct keywords kf[] = {
	    /* Keywords of intrinsic functions that get built into
	     * the grammar.  Most intrinsics handled by intrinsic().
	     */
	    { "scan",   Y_SCAN,   0 },
	    { "scanf",  Y_SCANF,  0 },
	    { "fscan",  Y_FSCAN,  0 },
	    { "fscanf", Y_FSCANF, 0 },

	    /* sentinel; leave it here... */
	    { "", 0, 0 } 
	};

	register struct keywords *kp;
	XINT	oldtopd;
	static	char sch, kch;		/* static storage is faster here   */
	char	*scopy;			/* non-makelower'd copy		   */
	char    sb[REALWIDTH];


	oldtopd = topd;			/* save topd			   */
	scopy = comdstr(s);		/* make a copy in the dictionary   */
	makelower (scopy);		/* make it lower case for compares */
	topd = oldtopd;			/*restore topd but scopy still there!*/

	/* Put the first character of the identifier we are searching for
	 * in local storage to permit fast rejection of keywords without all
	 * the overhead involved in a call to strcmp.  This is an easy way
	 * to speed things up several times w/o coding fancy data structures.
	 */
	sch = *scopy;
	kch = *s;	/* save original string */

	/* Check for and handle special-case keywords first.
	 */
	if (sch == *truestr && !strcmp (scopy, truestr)) {
	    yylval = addconst (truestr, OT_BOOL);
	    return (Y_CONSTANT);
	} else if (sch == *falsestr && !strcmp (scopy, falsestr)) {
	    yylval = addconst (falsestr, OT_BOOL);
	    return (Y_CONSTANT);
	} else if (sch == *indeflc && !strcmp (scopy, indeflc)) {
	    yylval = addconst (scopy, OT_INT);
	    return (Y_CONSTANT);
	} else if (sch == *eoflc && !strcmp (scopy, eoflc)) {
	    yylval = addconst (CL_EOFSTR, OT_INT);
	    return (Y_CONSTANT);
	} else if (sch == *errorstr && !strcmp (scopy, errorstr)) {
	    yylval = addconst (errorstr, OT_STRING);
	    return (Y_IDENT);

	/* Check for defined numerical constants.  For backwards compatability
	 * we match 'epsilon', however this particular value is deprecated by
	 * the fp_equal() builtin and we assume CL constants will be upper
	 * case strings.
	 */
	} else if ((sch == *epsilonstr && !strcmp (scopy, epsilonstr)) ||
		   (kch == *epsilonuc && !strcmp (s, epsilonuc))) {
	    sprintf (sb, "%e", EPSILON);
	    yylval = addconst (sb, OT_REAL);
	    return (Y_CONSTANT);

	} else if (const_str (pistr)) { 	retconst (PI);
	} else if (const_str (twopistr)) { 	retconst (TWOPI);
	} else if (const_str (fourpistr)) { 	retconst (FOURPI);
	} else if (const_str (halfpistr)) { 	retconst (HALFPI);
	} else if (const_str (sqrtpistr)) { 	retconst (SQRTOFPI);
	} else if (const_str (sqrttwostr)) { 	retconst (SQRTOF2);
	} else if (const_str (baseestr)) { 	retconst (BASE_E);
	} else if (const_str (ln2str)) { 	retconst (LN_2);
	} else if (const_str (ln10str)) { 	retconst (LN_10);
	} else if (const_str (lnpistr)) { 	retconst (LN_PI);
	} else if (const_str (logestr)) { 	retconst (LOG_E);
	} else if (const_str (gammastr)) { 	retconst (GAMMA);
	} else if (const_str (radianstr)) { 	retconst (RADIAN);

	} else if (const_str (austr)) { 	retconst (AU);
	} else if (const_str (gaccelstr)) { 	retconst (GRAV_ACCEL);
	} else if (const_str (gconststr)) { 	retconst (GRAV_CONST);
	} else if (const_str (lystr)) { 	retconst (LIGHT_YEAR);
	} else if (const_str (parsecstr)) { 	retconst (PARSEC);
	} else if (const_str (lightstr)) { 	retconst (SPEED_OF_LIGHT);
	} else if (const_str (solmassstr)) { 	retconst (SOLAR_MASS);


	} else if (!inarglist && parenlevel == 0) {
	    /* Search the keyword list; kewords are not recognized in argument
	     * lists and expressions, else unquoted strings like "for" and
	     * "file" will cause syntax errors.
	     */
	    for (kp=kw;  (kch = *kp->k_name);  kp++)
		if (kch == sch)
		    if (strcmp (scopy, kp->k_name) == 0) {
			yylval = kp->k_yylval;
			return (kp->k_token);
		    }

	} else {
	    /* Search the list of intrinsic functions.
	     */
	    for (kp=kf;  (kch = *kp->k_name);  kp++)
		if (kch == sch)
		    if (strcmp (scopy, kp->k_name) == 0) {
			yylval = kp->k_yylval;
			return (kp->k_token);
		    }
	}

	/* S not a keyword, so it's just an identifier.
	 */
	yylval = addconst (s, OT_STRING);	/* use original */
	return (Y_IDENT);
}
Пример #10
0
/* 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);
}