Пример #1
0
void gtmci_isv_save(void)
{
	gtm_savetraps();	/* Save either etrap or ztrap as appropriate */
	op_newintrinsic(SV_ESTACK);

	/* Save $ECODE/$STACK values of previous environment into SFF_CI frame of
	 * the current call-in environment. When this frame unwinds, their old values
	 * will be restored in dollar_ecode_ci and dollar_stack_ci (see unwind logic
	 * in ci_ret_code_quit) */
	assert(frame_pointer->flags & SFF_CI);
	dollar_ecode_addr = &dollar_ecode_ci;
	push_stck(&dollar_ecode, sizeof(dollar_ecode), (void**)&dollar_ecode_addr);
	dollar_stack_addr = &dollar_stack_ci;
	push_stck(&dollar_stack, sizeof(dollar_stack), (void**)&dollar_stack_addr);
	ecode_init();
}
Пример #2
0
void trans_code_finish(void)
{
	mval		dummy;

	frame_pointer->type = proc_act_type;
	proc_act_type = 0;
	/* Save/restore restart_pc over dispatch of this error handler */
	PUSH_MV_STENT(MVST_RSTRTPC);
	mv_chain->mv_st_cont.mvs_rstrtpc.restart_pc_save = restart_pc;
	mv_chain->mv_st_cont.mvs_rstrtpc.restart_ctxt_save = restart_ctxt;
	if (0 != dollar_zyerror.str.len)
	{
		dummy.mvtype = MV_STR;
		dummy.str = dollar_zyerror.str;
		ESTABLISH(zyerr_ch);
		op_commarg(&dummy, indir_do);
		REVERT;
		op_newintrinsic(SV_ZYERROR); /* for user's convenience */
		assert(NULL == zyerr_frame);
		zyerr_frame = frame_pointer;
	}
	return;
}
Пример #3
0
void op_svput(int varnum, mval *v)
{
	int	i, ok, state;
	char	*vptr;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	switch (varnum)
	{
		case SV_X:
			MV_FORCE_NUM(v);
			io_curr_device.out->dollar.x = (short)MV_FORCE_INT(v);
			if ((short)(io_curr_device.out->dollar.x) < 0)
				io_curr_device.out->dollar.x = 0;
			break;
		case SV_Y:
			MV_FORCE_NUM(v);
			io_curr_device.out->dollar.y = (short)MV_FORCE_INT(v);
			if ((short)(io_curr_device.out->dollar.y) < 0)
				io_curr_device.out->dollar.y = 0;
			break;
		case SV_ZCOMPILE:
			MV_FORCE_STR(v);
			if ((TREF(dollar_zcompile)).addr)
				free ((TREF(dollar_zcompile)).addr);
			(TREF(dollar_zcompile)).addr = (char *)malloc(v->str.len);
			memcpy((TREF(dollar_zcompile)).addr, v->str.addr, v->str.len);
			(TREF(dollar_zcompile)).len = v->str.len;
			break;
		case SV_ZSTEP:
			MV_FORCE_STR(v);
			op_commarg(v,indir_linetail);
			op_unwind();
			dollar_zstep = *v;
			break;
		case SV_ZGBLDIR:
			MV_FORCE_STR(v);
			if ((dollar_zgbldir.str.len != v->str.len)
			    || memcmp(dollar_zgbldir.str.addr, v->str.addr, dollar_zgbldir.str.len))
			{
				if (0 == v->str.len)
				{
					/* set $zgbldir="" */
					dpzgbini();
					gd_header = NULL;
				} else
				{
					gd_header = zgbldir(v);
					/* update the gd_map */
					SET_GD_MAP;
					dollar_zgbldir.str.len = v->str.len;
					dollar_zgbldir.str.addr = v->str.addr;
					s2pool(&dollar_zgbldir.str);
				}
				if (NULL != gv_currkey)
				{
					gv_currkey->base[0] = '\0';
					gv_currkey->prev = gv_currkey->end = 0;
				} else if (NULL != gd_header)
					gvinit();
				if (NULL != gv_target)
					gv_target->clue.end = 0;
			}
			break;
		case SV_ZMAXTPTIME:
			dollar_zmaxtptime = mval2i(v);
			break;
		case SV_ZROUTINES:
			MV_FORCE_STR(v);
			/* The string(v) should be parsed and loaded before setting $zroutines
			 * to retain the old value in case errors occur while loading */
			zro_load(&v->str);
			if ((TREF(dollar_zroutines)).addr)
				free ((TREF(dollar_zroutines)).addr);
			(TREF(dollar_zroutines)).addr = (char *)malloc(v->str.len);
			memcpy((TREF(dollar_zroutines)).addr, v->str.addr, v->str.len);
			(TREF(dollar_zroutines)).len = v->str.len;
			break;
		case SV_ZSOURCE:
			MV_FORCE_STR(v);
			dollar_zsource.mvtype = MV_STR;
			dollar_zsource.str = v->str;
			break;
		case SV_ZTRAP:
#			ifdef GTM_TRIGGER
			if (0 < gtm_trigger_depth)
				rts_error(VARLSTCNT(1) ERR_NOZTRAPINTRIG);
#			endif
			MV_FORCE_STR(v);
			if (ztrap_new)
				op_newintrinsic(SV_ZTRAP);
			dollar_ztrap.mvtype = MV_STR;
			dollar_ztrap.str = v->str;
			/* Setting either $ZTRAP or $ETRAP to empty causes any current error trapping to be canceled */
			if (!v->str.len)
			{
				dollar_etrap.mvtype = MV_STR;
				dollar_etrap.str = v->str;
				ztrap_explicit_null = TRUE;
			} else /* Ensure that $ETRAP and $ZTRAP are not both active at the same time */
			{
				ztrap_explicit_null = FALSE;
				if (dollar_etrap.str.len > 0)
					gtm_newintrinsic(&dollar_etrap);
			}
			if (ztrap_form & ZTRAP_POP)
				ztrap_save_ctxt();
			if (tp_timeout_deferred && !dollar_zininterrupt)
				/* A tp timeout was deferred. Now that $ETRAP is no longer in effect and no job interrupt is in
				 * effect, the timeout need no longer be deferred and can be recognized.
				 */
				tptimeout_set(0);
			break;
		case SV_ZSTATUS:
			MV_FORCE_STR(v);
			dollar_zstatus.mvtype = MV_STR;
			dollar_zstatus.str = v->str;
			break;
		case SV_PROMPT:
			MV_FORCE_STR(v);
			MV_FORCE_LEN_STRICT(v); /* Ensure that direct mode prompt will not have BADCHARs,
						 * otherwise the BADCHAR error may fill up the filesystem
						 */
			if (v->str.len <= SIZEOF_prombuf)
				(TREF(gtmprompt)).len = v->str.len;
			else if (!gtm_utf8_mode)
				(TREF(gtmprompt)).len = SIZEOF_prombuf;
#			ifdef UNICODE_SUPPORTED
			else
			{
				UTF8_LEADING_BYTE(v->str.addr + SIZEOF_prombuf, v->str.addr, vptr);
				(TREF(gtmprompt)).len = INTCAST(vptr - v->str.addr);
			}
#			endif
			memcpy((TREF(gtmprompt)).addr, v->str.addr, (TREF(gtmprompt)).len);
			break;
		case SV_ECODE:
			MV_FORCE_STR(v);
			if (v->str.len)
			{
				/* Format must be like ,Mnnn,Mnnn,Zxxx,Uxxx,
				 * Mnnn are ANSI standard error codes
				 * Zxxx are implementation-specific codes
				 * Uxxx are end-user defined codes
				 * Note that there must be commas at the start and at the end
				 */
				for (state = 2, i = 0; (i < v->str.len) && (state <= 2); i++)
				{
					switch(state)
					{
						case 2: state = (v->str.addr[i] == ',') ? 1 : 101;
							break;
						case 1: state = ((v->str.addr[i] == 'M') ||
								 (v->str.addr[i] == 'U') ||
								 (v->str.addr[i] == 'Z')) ? 0 : 101;
							break;
						case 0: state = (v->str.addr[i] == ',') ? 1 : 0;
							break;
					}
				}
				/* The above check would pass strings like ","
				 * so double-check that there are at least three characters
				 * (starting comma, ending comma, and something in between)
				 */
				if ((state != 1) || (v->str.len < 3))
				{
					/* error, ecode = M101 */
					rts_error(VARLSTCNT(4) ERR_INVECODEVAL, 2, v->str.len, v->str.addr);
				}
			}
			if (v->str.len > 0)
			{
				ecode_add(&v->str);
				rts_error(VARLSTCNT(2) ERR_SETECODE, 0);
			} else
			{
				NULLIFY_DOLLAR_ECODE;	/* reset $ECODE related variables to correspond to $ECODE = NULL state */
				NULLIFY_ERROR_FRAME;	/* we are no more in error-handling mode */
				if (tp_timeout_deferred && !dollar_zininterrupt)
					/* A tp timeout was deferred. Now that we are clear of error handling and no job interrupt
					 * is in process, allow the timeout to be recognized.
					 */
					tptimeout_set(0);
			}
			break;
		case SV_ETRAP:
			MV_FORCE_STR(v);
			dollar_etrap.mvtype = MV_STR;
			dollar_etrap.str = v->str;
			/* Setting either $ZTRAP or $ETRAP to empty causes any current error trapping to be canceled */
			if (!v->str.len)
			{
				dollar_ztrap.mvtype = MV_STR;
				dollar_ztrap.str = v->str;
			} else if (dollar_ztrap.str.len > 0)
			{	/* Ensure that $ETRAP and $ZTRAP are not both active at the same time */
				assert(FALSE == ztrap_explicit_null);
				gtm_newintrinsic(&dollar_ztrap);
			}
			ztrap_explicit_null = FALSE;
			break;
		case SV_ZERROR:
			MV_FORCE_STR(v);
			dollar_zerror.mvtype = MV_STR;
			dollar_zerror.str = v->str;
			break;
		case SV_ZYERROR:
			MV_FORCE_STR(v);
			dollar_zyerror.mvtype = MV_STR;
			dollar_zyerror.str = v->str;
			break;
		case SV_SYSTEM:
			assert(FALSE);
			rts_error(VARLSTCNT(4) ERR_SYSTEMVALUE, 2, v->str.len, v->str.addr);
			break;
		case SV_ZDIR:
			setzdir(v, NULL); 	/* change directory to v */
			getzdir(); 		/* update dollar_zdir with current working directory */
			break;
		case SV_ZINTERRUPT:
			MV_FORCE_STR(v);
			dollar_zinterrupt.mvtype = MV_STR;
			dollar_zinterrupt.str = v->str;
			break;
		case SV_ZDATE_FORM:
			MV_FORCE_NUM(v);
			TREF(zdate_form) = (short)MV_FORCE_INT(v);
			break;
		case SV_ZTEXIT:
			MV_FORCE_STR(v);
			dollar_ztexit.mvtype = MV_STR;
			dollar_ztexit.str = v->str;
			/* Coercing $ZTEXIT to boolean at SET command is more efficient than coercing before each
			 * rethrow at TR/TRO. Since we want to maintain dollar_ztexit as a string, coercion should
			 * not be performed on dollar_ztext, but on a temporary (i.e. parameter v)
			 */
			dollar_ztexit_bool = MV_FORCE_BOOL(v);
			break;
		case SV_ZQUIT:
			dollar_zquit_anyway = MV_FORCE_BOOL(v);
			break;
		case SV_ZTVALUE:
#			ifdef GTM_TRIGGER
			assert(!dollar_tlevel || (tstart_trigger_depth <= gtm_trigger_depth));
			if (!dollar_tlevel || (tstart_trigger_depth == gtm_trigger_depth))
				rts_error(VARLSTCNT(4) ERR_SETINTRIGONLY, 2, RTS_ERROR_TEXT("$ZTVALUE"));
			if (dollar_ztriggerop != &gvtr_cmd_mval[GVTR_CMDTYPE_SET])
				rts_error(VARLSTCNT(4) ERR_SETINSETTRIGONLY, 2, RTS_ERROR_TEXT("$ZTVALUE"));
			assert(0 < gtm_trigger_depth);
			memcpy(dollar_ztvalue, v, SIZEOF(mval));
			dollar_ztvalue->mvtype &= ~MV_ALIASCONT;	/* Make sure to shut off alias container flag on copy */
			assert(NULL != ztvalue_changed_ptr);
			*ztvalue_changed_ptr = TRUE;
			break;
#			else
			rts_error(VARLSTCNT(1) ERR_UNIMPLOP);
#			endif
		case SV_ZTWORMHOLE:
#			ifdef GTM_TRIGGER
			MV_FORCE_STR(v);
			/* See jnl.h for why MAX_ZTWORMHOLE_SIZE should be less than minimum alignsize */
			assert(MAX_ZTWORMHOLE_SIZE < (JNL_MIN_ALIGNSIZE * DISK_BLOCK_SIZE));
			if (MAX_ZTWORMHOLE_SIZE < v->str.len)
				rts_error(VARLSTCNT(4) ERR_ZTWORMHOLE2BIG, 2, v->str.len, MAX_ZTWORMHOLE_SIZE);
			dollar_ztwormhole.mvtype = MV_STR;
			dollar_ztwormhole.str = v->str;
			break;
#			else
			rts_error(VARLSTCNT(1) ERR_UNIMPLOP);
#			endif
		case SV_ZTSLATE:
#			ifdef GTM_TRIGGER
			assert(!dollar_tlevel || (tstart_trigger_depth <= gtm_trigger_depth));
			if (!dollar_tlevel || (tstart_trigger_depth == gtm_trigger_depth))
				rts_error(VARLSTCNT(4) ERR_SETINTRIGONLY, 2, RTS_ERROR_TEXT("$ZTSLATE"));
			assert(0 < gtm_trigger_depth);
			MV_FORCE_DEFINED(v);
			memcpy((char *)&dollar_ztslate, v, SIZEOF(mval));
			dollar_ztslate.mvtype &= ~MV_ALIASCONT;	/* Make sure to shut off alias container flag on copy */
			break;
#			else
			rts_error(VARLSTCNT(1) ERR_UNIMPLOP);
#			endif
		default:
			GTMASSERT;
	}
	return;
}
Пример #4
0
void op_svput(int varnum, mval *v)
{
    int		i, ok, state;
    error_def(ERR_UNIMPLOP);
    error_def(ERR_TEXT);
    error_def(ERR_INVECODEVAL);
    error_def(ERR_SETECODE);
    error_def(ERR_SYSTEMVALUE);

    switch (varnum)
    {
    case SV_X:
        MV_FORCE_NUM(v);
        io_curr_device.out->dollar.x = (short)MV_FORCE_INT(v);
        if ((short)(io_curr_device.out->dollar.x) < 0)
            io_curr_device.out->dollar.x = 0;
        break;
    case SV_Y:
        MV_FORCE_NUM(v);
        io_curr_device.out->dollar.y = (short)MV_FORCE_INT(v);
        if ((short)(io_curr_device.out->dollar.y) < 0)
            io_curr_device.out->dollar.y = 0;
        break;
    case SV_ZCOMPILE:
        MV_FORCE_STR(v);
        if (dollar_zcompile.addr)
            free (dollar_zcompile.addr);
        dollar_zcompile.addr = (char *)malloc(v->str.len);
        memcpy (dollar_zcompile.addr, v->str.addr, v->str.len);
        dollar_zcompile.len = v->str.len;
        break;
    case SV_ZSTEP:
        MV_FORCE_STR(v);
        op_commarg(v,indir_linetail);
        op_unwind();
        dollar_zstep = *v;
        break;
    case SV_ZGBLDIR:
        MV_FORCE_STR(v);
        if (!(dollar_zgbldir.str.len == v->str.len &&
                !memcmp(dollar_zgbldir.str.addr, v->str.addr,
                        dollar_zgbldir.str.len)))
        {
            if(v->str.len == 0)
            {
                /* set $zgbldir="" */
                dpzgbini();
                gd_header = NULL;
            } else
            {
                gd_header = zgbldir(v);
                dollar_zgbldir.str.len = v->str.len;
                dollar_zgbldir.str.addr = v->str.addr;
                s2pool(&dollar_zgbldir.str);
            }
            if (gv_currkey)
                gv_currkey->base[0] = 0;
            if (gv_target)
                gv_target->clue.end = 0;
        }
        break;
    case SV_ZMAXTPTIME:
        dollar_zmaxtptime = mval2i(v);
        break;
    case SV_ZROUTINES:
        MV_FORCE_STR(v);
        /* The string(v) should be parsed and loaded before setting $zroutines
         * to retain the old value in case errors occur while loading */
        zro_load(&v->str);
        if (dollar_zroutines.addr)
            free (dollar_zroutines.addr);
        dollar_zroutines.addr = (char *)malloc(v->str.len);
        memcpy (dollar_zroutines.addr, v->str.addr, v->str.len);
        dollar_zroutines.len = v->str.len;
        break;
    case SV_ZSOURCE:
        MV_FORCE_STR(v);
        dollar_zsource = v->str;
        break;
    case SV_ZTRAP:
        MV_FORCE_STR(v);
        if (ztrap_new)
            op_newintrinsic(SV_ZTRAP);
        dollar_ztrap.mvtype = MV_STR;
        dollar_ztrap.str = v->str;
        /* Setting either $ZTRAP or $ETRAP to empty causes any current error trapping to be canceled */
        if (!v->str.len)
        {
            dollar_etrap.mvtype = MV_STR;
            dollar_etrap.str = v->str;
            ztrap_explicit_null = TRUE;
        } else /* Ensure that $ETRAP and $ZTRAP are not both active at the same time */
        {
            ztrap_explicit_null = FALSE;
            if (dollar_etrap.str.len > 0)
                gtm_newintrinsic(&dollar_etrap);
        }
        if (ztrap_form & ZTRAP_POP)
            ztrap_save_ctxt();
        break;
    case SV_ZSTATUS:
        MV_FORCE_STR(v);
        dollar_zstatus.mvtype = MV_STR;
        dollar_zstatus.str = v->str;
        break;
    case SV_PROMPT:
        MV_FORCE_STR(v);
        gtmprompt.len = v->str.len < sizeof(prombuf) ? v->str.len : sizeof(prombuf);
        memcpy(gtmprompt.addr,v->str.addr,gtmprompt.len);
        break;
    case SV_ECODE:
        MV_FORCE_STR(v);
        if (v->str.len)
        {
            /* Format must be like ,Mnnn,Mnnn,Zxxx,Uxxx,
             * Mnnn are ANSI standard error codes
             * Zxxx are implementation-specific codes
             * Uxxx are end-user defined codes
             * Note that there must be commas at the start and at the end
             */
            for (state = 2, i = 0; (i < v->str.len) && (state <= 2); i++)
            {
                switch(state)
                {
                case 2:
                    state = (v->str.addr[i] == ',') ? 1 : 101;
                    break;
                case 1:
                    state = ((v->str.addr[i] == 'M') ||
                             (v->str.addr[i] == 'U') ||
                             (v->str.addr[i] == 'Z')) ? 0 : 101;
                    break;
                case 0:
                    state = (v->str.addr[i] == ',') ? 1 : 0;
                    break;
                }
            }
            /* The above check would pass strings like ","
             * so double-check that there are at least three characters
             * (starting comma, ending comma, and something in between)
             */
            if ((state != 1) || (v->str.len < 3))
            {
                /* error, ecode = M101 */
                rts_error(VARLSTCNT(4) ERR_INVECODEVAL, 2, v->str.len, v->str.addr);
            }
        }
        if (v->str.len > 0)
        {
            ecode_add(&v->str);
            rts_error(VARLSTCNT(2) ERR_SETECODE, 0);
        } else
        {
            NULLIFY_DOLLAR_ECODE;	/* reset $ECODE related variables to correspond to $ECODE = NULL state */
            NULLIFY_ERROR_FRAME;	/* we are no more in error-handling mode */
        }
        break;
    case SV_ETRAP:
        MV_FORCE_STR(v);
        dollar_etrap.mvtype = MV_STR;
        dollar_etrap.str = v->str;
        /* Setting either $ZTRAP or $ETRAP to empty causes any current error trapping to be canceled */
        if (!v->str.len)
        {
            dollar_ztrap.mvtype = MV_STR;
            dollar_ztrap.str = v->str;
        } else if (dollar_ztrap.str.len > 0)
        {   /* Ensure that $ETRAP and $ZTRAP are not both active at the same time */
            assert(FALSE == ztrap_explicit_null);
            gtm_newintrinsic(&dollar_ztrap);
        }
        ztrap_explicit_null = FALSE;
        break;
    case SV_ZERROR:
        MV_FORCE_STR(v);
        dollar_zerror.mvtype = MV_STR;
        dollar_zerror.str = v->str;
        break;
    case SV_ZYERROR:
        MV_FORCE_STR(v);
        dollar_zyerror.mvtype = MV_STR;
        dollar_zyerror.str = v->str;
        break;
    case SV_SYSTEM:
        ok = 1;
        if (!(v->mvtype & MV_STR))
            ok = 0;
        if (ok && v->str.addr[0] != '4')
            ok = 0;
        if (ok && v->str.addr[1] != '7')
            ok = 0;
        if ((' ' != v->str.addr[2]) && !ispunct(v->str.addr[2]))
            ok = 0;
        if (ok)
            dollar_system.str = v->str;
        else
            rts_error(VARLSTCNT(4) ERR_SYSTEMVALUE, 2, v->str.len, v->str.addr);
        break;
    case SV_ZDIR:
        setzdir(v, NULL); /* change directory to v */
        getzdir(); /* update dollar_zdir with current working directory */
        break;
    case SV_ZINTERRUPT:
        MV_FORCE_STR(v);
        dollar_zinterrupt.mvtype = MV_STR;
        dollar_zinterrupt.str = v->str;
        break;
    case SV_ZDATE_FORM:
        MV_FORCE_NUM(v);
        zdate_form = (short)MV_FORCE_INT(v);
        break;
    case SV_ZTEXIT:
        MV_FORCE_STR(v);
        dollar_ztexit.mvtype = MV_STR;
        dollar_ztexit.str = v->str;
        /* Coercing $ZTEXIT to boolean at SET command is more efficient than coercing before each
         * rethrow at TR/TRO. Since we want to maintain dollar_ztexit as a string, coercion should
         * not be performed on dollar_ztext, but on a temporary (i.e. parameter v) */
        dollar_ztexit_bool = MV_FORCE_BOOL(v);
        break;
    default:
        GTMASSERT;
    }
    return;
}