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; }
void gtm_startup(struct startup_vector *svec) /* Note: various references to data copied from *svec could profitably be referenced directly */ { unsigned char *mstack_ptr; void gtm_ret_code(); static readonly unsigned char init_break[1] = {'B'}; int4 lct; int i; static char other_mode_buf[] = "OTHER"; mstr log_name; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; assert(INVALID_IMAGE != image_type); assert(svec->argcnt == SIZEOF(*svec)); IA64_ONLY(init_xfer_table()); get_page_size(); cache_table_relobjs = &cache_table_rebuild; ht_rhash_ch = &hashtab_rehash_ch; jbxm_dump_ch = &jobexam_dump_ch; heartbeat_timer_ptr = &heartbeat_timer; stpgc_ch = &stp_gcol_ch; rtn_fst_table = rtn_names = (rtn_tabent *)svec->rtn_start; rtn_names_end = rtn_names_top = (rtn_tabent *)svec->rtn_end; if (svec->user_stack_size < 4096) svec->user_stack_size = 4096; if (svec->user_stack_size > 8388608) svec->user_stack_size = 8388608; mstack_ptr = (unsigned char *)malloc(svec->user_stack_size); msp = stackbase = mstack_ptr + svec->user_stack_size - mvs_size[MVST_STORIG]; /* mark the stack base so that if error occur during call-in gtm_init(), the unwind * logic in gtmci_ch() will get rid of the stack completely */ fgncal_stack = stackbase; mv_chain = (mv_stent *)msp; mv_chain->mv_st_type = MVST_STORIG; /* Initialize first (anchor) mv_stent so doesn't do anything */ mv_chain->mv_st_next = 0; mv_chain->mv_st_cont.mvs_storig = 0; stacktop = mstack_ptr + 2 * mvs_size[MVST_NTAB]; stackwarn = stacktop + (16 * 1024); break_message_mask = svec->break_message_mask; if (svec->user_strpl_size < STP_INITSIZE) svec->user_strpl_size = STP_INITSIZE; else if (svec->user_strpl_size > STP_MAXINITSIZE) svec->user_strpl_size = STP_MAXINITSIZE; stp_init(svec->user_strpl_size); if (svec->user_indrcache_size > MAX_INDIRECTION_NESTING || svec->user_indrcache_size < MIN_INDIRECTION_NESTING) svec->user_indrcache_size = MIN_INDIRECTION_NESTING; TREF(ind_result_array) = (mval **)malloc(SIZEOF(mval *) * svec->user_indrcache_size); TREF(ind_source_array) = (mval **)malloc(SIZEOF(mval *) * svec->user_indrcache_size); TREF(ind_result_sp) = TREF(ind_result_array); TREF(ind_result_top) = TREF(ind_result_sp) + svec->user_indrcache_size; TREF(ind_source_sp) = TREF(ind_source_array); TREF(ind_source_top) = TREF(ind_source_sp) + svec->user_indrcache_size; rts_stringpool = stringpool; TREF(compile_time) = FALSE; /* assert that is_replicator and run_time is properly set by gtm_imagetype_init invoked at process entry */ # ifdef DEBUG switch (image_type) { case GTM_IMAGE: case GTM_SVC_DAL_IMAGE: assert(is_replicator && run_time); break; case MUPIP_IMAGE: assert(!is_replicator && !run_time); break; default: assert(FALSE); } # endif gtm_utf8_init(); /* Initialize the runtime for Unicode */ /* Initialize alignment requirement for the runtime stringpool */ log_name.addr = DISABLE_ALIGN_STRINGS; log_name.len = STR_LIT_LEN(DISABLE_ALIGN_STRINGS); /* mstr_native_align = logical_truth_value(&log_name, FALSE, NULL) ? FALSE : TRUE; */ mstr_native_align = FALSE; /* TODO: remove this line and uncomment the above line */ getjobname(); INVOKE_INIT_SECSHR_ADDRS; getzprocess(); getzmode(); geteditor(); zcall_init(); cmd_qlf.qlf = glb_cmd_qlf.qlf; cache_init(); # ifdef __sun if (NULL != GETENV(PACKAGE_ENV_TYPE)) /* chose xcall (default) or rpc zcall */ xfer_table[xf_fnfgncal] = (xfer_entry_t)op_fnfgncal_rpc; /* using RPC */ # endif msp -= SIZEOF(stack_frame); frame_pointer = (stack_frame *)msp; memset(frame_pointer,0, SIZEOF(stack_frame)); frame_pointer->temps_ptr = (unsigned char *)frame_pointer; frame_pointer->ctxt = GTM_CONTEXT(gtm_ret_code); frame_pointer->mpc = CODE_ADDRESS(gtm_ret_code); frame_pointer->type = SFT_COUNT; frame_pointer->rvector = (rhdtyp*)malloc(SIZEOF(rhdtyp)); memset(frame_pointer->rvector, 0, SIZEOF(rhdtyp)); symbinit(); /* Variables for supporting $ZSEARCH sorting and wildcard expansion */ TREF(zsearch_var) = lv_getslot(curr_symval); TREF(zsearch_dir1) = lv_getslot(curr_symval); TREF(zsearch_dir2) = lv_getslot(curr_symval); LVVAL_INIT((TREF(zsearch_var)), curr_symval); LVVAL_INIT((TREF(zsearch_dir1)), curr_symval); LVVAL_INIT((TREF(zsearch_dir2)), curr_symval); /* Initialize global pointer to control-C handler. Also used in iott_use */ ctrlc_handler_ptr = &ctrlc_handler; io_init(IS_MUPIP_IMAGE); /* starts with nocenable for GT.M runtime, enabled for MUPIP */ if (!IS_MUPIP_IMAGE) { sig_init(generic_signal_handler, ctrlc_handler_ptr, suspsigs_handler, continue_handler); atexit(gtm_exit_handler); cenable(); /* cenable unless the environment indicates otherwise - 2 steps because this can report errors */ } jobinterrupt_init(); getzdir(); dpzgbini(); zco_init(); /* a base addr of 0 indicates a gtm_init call from an rpc server */ if ((GTM_IMAGE == image_type) && (NULL != svec->base_addr)) jobchild_init(); else { /* Trigger enabled utilities will enable through here */ (TREF(dollar_zmode)).mvtype = MV_STR; (TREF(dollar_zmode)).str.addr = other_mode_buf; (TREF(dollar_zmode)).str.len = SIZEOF(other_mode_buf) -1; } svec->frm_ptr = (unsigned char *)frame_pointer; dollar_ztrap.mvtype = MV_STR; dollar_ztrap.str.len = SIZEOF(init_break); dollar_ztrap.str.addr = (char *)init_break; dollar_zstatus.mvtype = MV_STR; dollar_zstatus.str.len = 0; dollar_zstatus.str.addr = NULL; ecode_init(); zyerror_init(); ztrap_form_init(); ztrap_new_init(); zdate_form_init(svec); dollar_system_init(svec); init_callin_functable(); gtm_env_xlate_init(); SET_LATCH_GLOBAL(&defer_latch, LOCK_AVAILABLE); curr_pattern = pattern_list = &mumps_pattern; pattern_typemask = mumps_pattern.typemask; initialize_pattern_table(); ce_init(); /* initialize compiler escape processing */ /* Initialize local collating sequence */ TREF(transform) = TRUE; lct = find_local_colltype(); if (lct != 0) { TREF(local_collseq) = ready_collseq(lct); if (!TREF(local_collseq)) { exi_condition = -ERR_COLLATIONUNDEF; gtm_putmsg(VARLSTCNT(3) ERR_COLLATIONUNDEF, 1, lct); exit(exi_condition); } } else TREF(local_collseq) = 0; prealloc_gt_timers(); gt_timers_add_safe_hndlrs(); for (i = 0; FNPC_MAX > i; i++) { /* Initialize cache structure for $Piece function */ (TREF(fnpca)).fnpcs[i].pcoffmax = &(TREF(fnpca)).fnpcs[i].pstart[FNPC_ELEM_MAX]; (TREF(fnpca)).fnpcs[i].indx = i; } (TREF(fnpca)).fnpcsteal = (TREF(fnpca)).fnpcs; /* Starting place to look for cache reuse */ (TREF(fnpca)).fnpcmax = &(TREF(fnpca)).fnpcs[FNPC_MAX - 1]; /* The last element */ /* Initialize zwrite subsystem. Better to do it now when we have storage to allocate than * if we fail and storage allocation may not be possible. To that end, pretend we have * seen alias acitivity so those structures are initialized as well. */ assert(FALSE == curr_symval->alias_activity); curr_symval->alias_activity = TRUE; lvzwr_init((enum zwr_init_types)0, (mval *)NULL); curr_symval->alias_activity = FALSE; if ((NULL != (TREF(mprof_env_gbl_name)).str.addr)) turn_tracing_on(TADR(mprof_env_gbl_name), TRUE, (TREF(mprof_env_gbl_name)).str.len > 0); return; }
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; }