void getjobnum(void) { uint4 status; int4 item_code; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; item_code = JPI$_PID; if (SS$_NORMAL !=(status = lib$getjpi(&item_code, 0, 0, &process_id, 0, 0))) rts_error(VARLSTCNT(1) status); get_proc_info(process_id, TADR(login_time), &image_count); }
void gtm_threadgbl_init(void) { void *lcl_gtm_threadgbl; if (SIZEOF(gtm_threadgbl_true_t) != size_gtm_threadgbl_struct) { /* Size mismatch with gtm_threadgbl_deftypes.h - no error handling yet available so do * the best we can. */ FPRINTF(stderr, "GTM-F-GTMASSERT gtm_threadgbl_true_t and gtm_threadgbl_t are different sizes\n"); exit(ERR_GTMASSERT); } if (NULL != gtm_threadgbl) { /* has already been initialized - don't re-init */ FPRINTF(stderr, "GTM-F-GTMASSERT gtm_threadgbl is already initialized\n"); exit(ERR_GTMASSERT); } gtm_threadgbl = lcl_gtm_threadgbl = malloc(size_gtm_threadgbl_struct); if (NULL == gtm_threadgbl) { /* Storage was not allocated for some reason - no error handling yet still */ perror("GTM-F-MEMORY Unable to allocate startup thread structure"); exit(UNIX_ONLY(ERR_MEMORY) VMS_ONLY(ERR_VMSMEMORY)); } memset(gtm_threadgbl, 0, size_gtm_threadgbl_struct); gtm_threadgbl_true = (gtm_threadgbl_true_t *)gtm_threadgbl; /* Add specific initializations if other than 0s here using the TREF() family of macros: */ (TREF(director_ident)).addr = TADR(director_string); TREF(for_stack_ptr) = TADR(for_stack); (TREF(gtmprompt)).addr = TADR(prombuf); (TREF(gtmprompt)).len = SIZEOF(DEFAULT_PROMPT) - 1; TREF(lv_null_subs) = LVNULLSUBS_OK; /* UNIX: set in gtm_env_init_sp(), VMS: set in gtm$startup() - init'd here * in case alternative invocation methods bypass gtm_startup() */ MEMCPY_LIT(TADR(prombuf), DEFAULT_PROMPT); (TREF(replgbl)).jnl_release_timeout = DEFAULT_JNL_RELEASE_TIMEOUT; (TREF(window_ident)).addr = TADR(window_string); }
int m_break(void) { DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; if ((TK_SPACE != TREF(window_token)) && (TK_EOL != TREF(window_token))) if (!m_xecute()) return FALSE; newtriple(OC_BREAK); if (TREF(for_stack_ptr) == TADR(for_stack)) start_fetches (OC_FETCH); else start_for_fetches (); return TRUE; }
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; }
int m_for(void) { unsigned int arg_cnt, arg_index, for_stack_level; oprtype arg_eval_addr[MAX_FORARGS], increment[MAX_FORARGS], terminate[MAX_FORARGS], arg_next_addr, arg_value, dummy, control_variable, *iteration_start_addr, iteration_start_addr_indr, *not_even_once_addr; triple *eval_next_addr[MAX_FORARGS], *control_ref, *forchk1opc, forpos_in_chain, *init_ref, *ref, *step_ref, *term_ref, *var_ref; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; forpos_in_chain = TREF(pos_in_chain); FOR_PUSH(); if (TK_SPACE == TREF(window_token)) { /* "argumentless" form */ FOR_END_OF_SCOPE(1, dummy); ref = newtriple(OC_FORCHK1); if (!linetail()) { TREF(pos_in_chain) = forpos_in_chain; assert(TREF(source_error_found)); stx_error(TREF(source_error_found)); FOR_POP(BLOWN_FOR); return FALSE; } SAVE_FOR_OVER_ADDR(); /* stash address of next op in the for_stack array */ newtriple(OC_JMP)->operand[0] = put_tjmp(ref); /* transfer back to just before the begining of the body */ FOR_POP(GOOD_FOR); /* and pop the array */ return TRUE; } for_stack_level = (TREF(for_stack_ptr) - TADR(for_stack)); init_ref = newtriple(OC_FORNESTLVL); init_ref->operand[0] = put_ilit(for_stack_level); if (TK_ATSIGN == TREF(window_token)) { if (!indirection(&control_variable)) { FOR_POP(BLOWN_FOR); return FALSE; } ref = newtriple(OC_INDLVADR); ref->operand[0] = control_variable; control_variable = put_tref(ref); control_ref = NULL; } else { /* The following relies on the fact that lvn() always generates an OC_VAR triple first */ control_ref = (TREF(curtchain))->exorder.bl; if (!lvn(&control_variable, OC_SAVPUTINDX, NULL)) { FOR_POP(BLOWN_FOR); return FALSE; } assert(OC_VAR == control_ref->exorder.fl->opcode); assert(MVAR_REF == control_ref->exorder.fl->operand[0].oprclass); } if (TK_EQUAL != TREF(window_token)) { stx_error(ERR_EQUAL); FOR_POP(BLOWN_FOR); return FALSE; } newtriple(OC_PASSTHRU)->operand[0] = control_variable; /* make sure optimizer doesn't ditch control_variable */ FOR_END_OF_SCOPE(1, dummy); assert((0 < for_stack_level) && (MAX_FOR_STACK >= for_stack_level)); if ((OC_SAVPUTINDX == control_variable.oprval.tref->opcode) || (OC_INDLVADR == control_variable.oprval.tref->opcode)) TAREF1(for_temps, for_stack_level) = TRUE_WITH_INDX; /* most uses treat this as a boolean, but some need more */ else init_ref->opcode = OC_NOOP; iteration_start_addr = (oprtype *)mcalloc(SIZEOF(oprtype)); iteration_start_addr_indr = put_indr(iteration_start_addr); arg_next_addr.oprclass = NOCLASS; not_even_once_addr = NULL; /* used to skip processing where the initial control exceeds the termination */ for (arg_cnt = 0; ; ++arg_cnt) { if (MAX_FORARGS <= arg_cnt) { stx_error(ERR_MAXFORARGS); FOR_POP(BLOWN_FOR); return FALSE; } assert((TK_COMMA == TREF(window_token)) || (TK_EQUAL == TREF(window_token))); advancewindow(); tnxtarg(&arg_eval_addr[arg_cnt]); /* put location of this arg eval in arg_eval_addr array */ if (NULL != not_even_once_addr) { *not_even_once_addr = arg_eval_addr[arg_cnt]; not_even_once_addr = NULL; } if (EXPR_FAIL == expr(&arg_value, MUMPS_EXPR)) /* starting (possibly only) value */ { FOR_POP(BLOWN_FOR); return FALSE; } assert(TRIP_REF == arg_value.oprclass); if (TK_COLON != TREF(window_token)) { /* list point value? */ increment[arg_cnt].oprclass = terminate[arg_cnt].oprclass = 0; DEAL_WITH_DANGER(for_stack_level, control_variable, arg_value); } else { /* stepping value */ init_ref = newtriple(OC_STOTEMP); /* tuck it in a temp undisturbed by coming evals */ init_ref->operand[0] = arg_value; newtriple(OC_CONUM)->operand[0] = put_tref(init_ref); /* make start numeric */ advancewindow(); /* past the first colon */ var_ref = (TREF(curtchain))->exorder.bl; if (EXPR_FAIL == expr(&increment[arg_cnt], MUMPS_EXPR)) /* pick up step */ { FOR_POP(BLOWN_FOR); return FALSE; } assert(TRIP_REF == increment[arg_cnt].oprclass); ref = increment[arg_cnt].oprval.tref; if (OC_LIT != var_ref->exorder.fl->opcode) { if (!TAREF1(for_temps, for_stack_level)) TAREF1(for_temps, for_stack_level) = TRUE; if (OC_VAR == var_ref->exorder.fl->opcode) { /* The above relies on lvn() always generating an OC_VAR triple first - asserted earlier */ step_ref = newtriple(OC_STOTEMP); step_ref->operand[0] = put_tref(ref); increment[arg_cnt] = put_tref(step_ref); } } if (TK_COLON != TREF(window_token)) { DEAL_WITH_DANGER(for_stack_level, control_variable, put_tref(init_ref)); terminate[arg_cnt].oprclass = 0; /* no termination on iteration for this arg */ } else { advancewindow(); /* past the second colon */ var_ref = (TREF(curtchain))->exorder.bl; if (EXPR_FAIL == expr(&terminate[arg_cnt], MUMPS_EXPR)) /* termination control value */ { FOR_POP(BLOWN_FOR); return FALSE; } assert(TRIP_REF == terminate[arg_cnt].oprclass); ref = terminate[arg_cnt].oprval.tref; if (OC_LIT != ref->opcode) { if (!TAREF1(for_temps, for_stack_level)) TAREF1(for_temps, for_stack_level) = TRUE; if (OC_VAR == var_ref->exorder.fl->opcode) { /* The above relies on lvn() always generating an OC_VAR triple first */ term_ref = newtriple(OC_STOTEMP); term_ref->operand[0] = put_tref(ref); terminate[arg_cnt] = put_tref(term_ref); } } DEAL_WITH_DANGER(for_stack_level, control_variable, put_tref(init_ref)); term_ref = newtriple(OC_PARAMETER); term_ref->operand[0] = terminate[arg_cnt]; step_ref = newtriple(OC_PARAMETER); step_ref->operand[0] = increment[arg_cnt]; step_ref->operand[1] = put_tref(term_ref); ref = newtriple(OC_FORINIT); ref->operand[0] = control_variable; ref->operand[1] = put_tref(step_ref); not_even_once_addr = newtriple(OC_JMPGTR)->operand; } } if ((0 < arg_cnt) || (TK_COMMA == TREF(window_token))) { if (!TAREF1(for_temps, for_stack_level)) TAREF1(for_temps, for_stack_level) = TRUE; if (NOCLASS == arg_next_addr.oprclass) arg_next_addr = put_tref(newtriple(OC_CDADDR)); (eval_next_addr[arg_cnt] = newtriple(OC_LDADDR))->destination = arg_next_addr; } if (TK_COMMA != TREF(window_token)) break; newtriple(OC_JMP)->operand[0] = iteration_start_addr_indr; } if (not_even_once_addr) FOR_END_OF_SCOPE(1, *not_even_once_addr); /* 1 means down a level */ forchk1opc = newtriple(OC_FORCHK1); /* FORCHK1 is a do-nothing routine used by the out-of-band mechanism */ *iteration_start_addr = put_tjmp(forchk1opc); if ((TK_EOL != TREF(window_token)) && (TK_SPACE != TREF(window_token))) { stx_error(ERR_SPOREOL); FOR_POP(BLOWN_FOR); return FALSE; } if (!linetail()) { TREF(pos_in_chain) = forpos_in_chain; assert(TREF(source_error_found)); stx_error(TREF(source_error_found)); FOR_POP(BLOWN_FOR); return FALSE; } SAVE_FOR_OVER_ADDR(); /* stash address of next op in the for_stack array */ if (0 < arg_cnt) newtriple(OC_JMPAT)->operand[0] = put_tref(eval_next_addr[0]); for (arg_index = 0; arg_index <= arg_cnt; ++arg_index) { if (0 < arg_cnt) tnxtarg(eval_next_addr[arg_index]->operand); if (TRUE_WITH_INDX == TAREF1(for_temps, for_stack_level)) { /* since it might have moved, before touching the control variable get a fix on it */ ref = newtriple(OC_RFRSHINDX); ref->operand[0] = put_ilit(for_stack_level); ref->operand[1] = put_ilit((increment[arg_index].oprclass || terminate[arg_index].oprclass) ? FALSE : TRUE); /* if increment rather than new value, rfrsh w/ srchindx else putindx */ control_variable = put_tref(ref); } else { assert(control_ref); control_variable = put_mvar(&control_ref->exorder.fl->operand[0].oprval.vref->mvname); } newtriple(OC_PASSTHRU)->operand[0] = control_variable; /* warn off optimizer */ if (terminate[arg_index].oprclass) { term_ref = newtriple(OC_PARAMETER); term_ref->operand[0] = terminate[arg_index]; step_ref = newtriple(OC_PARAMETER); step_ref->operand[0] = increment[arg_index]; step_ref->operand[1] = put_tref(term_ref); init_ref = newtriple(OC_PARAMETER); init_ref->operand[0] = control_variable; init_ref->operand[1] = put_tref(step_ref); ref = newtriple(OC_FORLOOP); /* redirects back to forchk1, which is at the beginning of new iteration */ ref->operand[0] = *iteration_start_addr; ref->operand[1] = put_tref(init_ref); } else if (increment[arg_index].oprclass) { step_ref = newtriple(OC_ADD); step_ref->operand[0] = control_variable; step_ref->operand[1] = increment[arg_index]; ref = newtriple(OC_STO); ref->operand[0] = control_variable; ref->operand[1] = put_tref(step_ref); newtriple(OC_JMP)->operand[0] = *iteration_start_addr; } if (arg_index < arg_cnt) /* go back and evaluate the next argument */ newtriple(OC_JMP)->operand[0] = arg_eval_addr[arg_index + 1]; } FOR_POP(GOOD_FOR); return TRUE; }
int comp_fini(int status, mstr *obj, opctype retcode, oprtype *retopr, oprtype *dst, mstr_len_t src_len) { triple *ref; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; if (status) { while (TK_SPACE == TREF(window_token)) /* Eat up trailing white space */ advancewindow(); if (TK_ERROR == TREF(window_token)) { status = EXPR_FAIL; stx_error(ERR_INDRCOMPFAIL); } else if ((TK_EOL != TREF(window_token)) || (source_column < src_len)) { status = EXPR_FAIL; stx_error(ERR_INDEXTRACHARS); } else { cg_phase = CGP_RESOLVE; assert(TREF(for_stack_ptr) == TADR(for_stack)); if (*TREF(for_stack_ptr)) tnxtarg(*TREF(for_stack_ptr)); ref = newtriple(retcode); if (retopr) ref->operand[0] = *retopr; if (OC_IRETMVAL == retcode) ref->operand[1] = *dst; start_fetches(OC_NOOP); resolve_ref(0); /* cannot fail because there are no MLAB_REF's in indirect code */ alloc_reg(); INVOKE_STP_GCOL(0); /* The above invocation of stp_gcol with a parameter of 0 is a critical part of compilation * (both routine compilations and indirect dynamic compilations). This collapses the indirect * (compilation) stringpool so that only the literals are left. This stringpool is then written * out to the compiled object as the literal pool for that compilation. Temporary stringpool * use for conversions or whatever are eliminated. Note the path is different in stp_gcol for * the indirect stringpool which is only used during compilations. */ assert(indr_stringpool.base == stringpool.base); indr_stringpool = stringpool; stringpool = rts_stringpool; TREF(compile_time) = FALSE; ind_code(obj); indr_stringpool.free = indr_stringpool.base; } } else { /* If this assert fails, it means a syntax problem could have been caught earlier. Consider placing a more useful * and specific error message at that location. */ assert(FALSE); stx_error(ERR_INDRCOMPFAIL); } if (EXPR_FAIL == status) { assert(indr_stringpool.base == stringpool.base); indr_stringpool = stringpool; stringpool = rts_stringpool; indr_stringpool.free = indr_stringpool.base; TREF(compile_time) = FALSE; cg_phase = CGP_NOSTATE; } TREF(transform) = TRUE; COMPILE_HASHTAB_CLEANUP; mcfree(); return status; }
int m_do(void) { int opcd; oprtype *cr; triple *calltrip, *labelref, *obp, *oldchain, *ref0, *ref1, *routineref, tmpchain, *triptr; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; if ((TK_EOL == TREF(window_token)) || (TK_SPACE == TREF(window_token))) { if (!run_time) /* DO SP SP is a noop at run time */ { calltrip = newtriple(OC_CALLSP); calltrip->operand[0] = put_mnxl(); } return TRUE; } else if (TK_AMPERSAND == TREF(window_token)) { if (!extern_func(0)) return FALSE; else return TRUE; } dqinit(&tmpchain, exorder); oldchain = setcurtchain(&tmpchain); calltrip = entryref(OC_CALL, OC_EXTCALL, (mint)indir_do, TRUE, FALSE, FALSE); setcurtchain(oldchain); if (!calltrip) return FALSE; if (TK_LPAREN == TREF(window_token)) { if (OC_CALL == calltrip->opcode) { assert(MLAB_REF == calltrip->operand[0].oprclass); calltrip->opcode = OC_EXCAL; ref0 = calltrip; } else { if (OC_EXTCALL == calltrip->opcode) { assert(TRIP_REF == calltrip->operand[1].oprclass); if (OC_CDLIT == calltrip->operand[1].oprval.tref->opcode) assert(CDLT_REF == calltrip->operand[1].oprval.tref->operand[0].oprclass); else { assert(OC_LABADDR == calltrip->operand[1].oprval.tref->opcode); assert(TRIP_REF == calltrip->operand[1].oprval.tref->operand[1].oprclass); assert(OC_PARAMETER == calltrip->operand[1].oprval.tref->operand[1].oprval.tref->opcode); assert(TRIP_REF == calltrip->operand[1].oprval.tref->operand[1].oprval.tref->operand[0].oprclass); DEBUG_ONLY(opcd = calltrip->operand[1].oprval.tref->operand[1].oprval.tref-> operand[0].oprval.tref->opcode); assert((OC_ILIT == opcd) || (OC_COMINT == opcd)); DEBUG_ONLY(opcd = calltrip->operand[1].oprval.tref->operand[1].oprval.tref-> operand[0].oprval.tref->operand[0].oprclass); assert((ILIT_REF == opcd) || (TRIP_REF == opcd)); /* The opcd references above added to allow an invalid syntax using indirect values for * offsets while specifying a parm list to get through the above asserts (invalid syntax * should not trip asserts) but it leads to the conclusion that the below test may not be * robust enough since it is looking at a literal integer value when there is none so have * added further checks mirroring the first checks done in the two most recent asserts to * make the check more robust. [Example bad code: Do @lbl+@n^artn(arg)] */ if ((0 != calltrip->operand[1].oprval.tref->operand[1].oprval.tref-> operand[0].oprval.tref->operand[0].oprval.ilit) || (OC_ILIT != calltrip->operand[1].oprval.tref->operand[1].oprval.tref-> operand[0].oprval.tref->opcode) || (ILIT_REF != calltrip->operand[1].oprval.tref->operand[1].oprval.tref-> operand[0].oprval.tref->operand[0].oprclass)) { stx_error (ERR_ACTOFFSET); return FALSE; } } } else { /* DO _ @dlabel actuallist */ assert(OC_COMMARG == calltrip->opcode); assert(TRIP_REF == calltrip->operand[1].oprclass); assert(OC_ILIT == calltrip->operand[1].oprval.tref->opcode); assert(ILIT_REF == calltrip->operand[1].oprval.tref->operand[0].oprclass); assert((mint)indir_do == calltrip->operand[1].oprval.tref->operand[0].oprval.ilit); assert(calltrip->exorder.fl == &tmpchain); routineref = maketriple(OC_CURRHD); labelref = maketriple(OC_LABADDR); ref0 = maketriple(OC_PARAMETER); dqins(calltrip->exorder.bl, exorder, routineref); dqins(calltrip->exorder.bl, exorder, labelref); dqins(calltrip->exorder.bl, exorder, ref0); labelref->operand[0] = calltrip->operand[0]; labelref->operand[1] = put_tref (ref0); ref0->operand[0] = calltrip->operand[1]; ref0->operand[0].oprval.tref->operand[0].oprval.ilit = 0; ref0->operand[1] = put_tref (routineref); calltrip->operand[0] = put_tref(routineref); calltrip->operand[1] = put_tref(labelref); } calltrip->opcode = OC_EXTEXCAL; ref0 = newtriple(OC_PARAMETER); ref0->operand[0] = calltrip->operand[1]; calltrip->operand[1] = put_tref(ref0); } if (!actuallist(&ref0->operand[1])) return FALSE; } else if (OC_CALL == calltrip->opcode) { if (TREF(for_stack_ptr) != (oprtype **)TADR(for_stack)) { if (TAREF1(for_temps, (TREF(for_stack_ptr) - (oprtype **)TADR(for_stack)))) calltrip->opcode = OC_FORLCLDO; } } if (TK_COLON == TREF(window_token)) { advancewindow(); cr = (oprtype *)mcalloc(SIZEOF(oprtype)); if (!bool_expr(FALSE, cr)) return FALSE; if ((TREF(expr_start) != TREF(expr_start_orig)) && (OC_NOOP != (TREF(expr_start))->opcode)) { triptr = newtriple(OC_GVRECTARG); triptr->operand[0] = put_tref(TREF(expr_start)); } obp = oldchain->exorder.bl; dqadd(obp, &tmpchain, exorder); /*this is a violation of info hiding*/ if (calltrip->opcode == OC_EXCAL) { triptr = newtriple(OC_JMP); triptr->operand[0] = put_mfun(&calltrip->operand[0].oprval.lab->mvname); calltrip->operand[0].oprclass = ILIT_REF; /* dummy placeholder */ } if ((TREF(expr_start) != TREF(expr_start_orig)) && (OC_NOOP != (TREF(expr_start))->opcode)) { ref0 = newtriple(OC_JMP); ref1 = newtriple(OC_GVRECTARG); ref1->operand[0] = put_tref(TREF(expr_start)); *cr = put_tjmp(ref1); tnxtarg(&ref0->operand[0]); } else tnxtarg(cr); } else { obp = oldchain->exorder.bl; dqadd(obp, &tmpchain, exorder); /*this is a violation of info hiding*/ if (OC_EXCAL == calltrip->opcode) { triptr = newtriple(OC_JMP); triptr->operand[0] = put_mfun(&calltrip->operand[0].oprval.lab->mvname); calltrip->operand[0].oprclass = ILIT_REF; /* dummy placeholder */ } } return TRUE; }
boolean_t line(uint4 *lnc) { boolean_t success; int parmcount, varnum; short int dot_count; mlabel *x; mline *curlin; triple *first_triple, *parmbase, *parmtail, *r; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; first_triple = (TREF(curtchain))->exorder.bl; dot_count = 0; parmbase = NULL; success = TRUE; curlin = (mline *)mcalloc(SIZEOF(*curlin)); curlin->line_number = 0; curlin->table = FALSE; TREF(last_source_column) = 0; if (TK_INTLIT == TREF(window_token)) int_label(); if ((TK_IDENT == TREF(window_token)) || (cmd_qlf.qlf & CQ_LINE_ENTRY)) start_fetches(OC_LINEFETCH); else newtriple(OC_LINESTART); curlin->line_number = *lnc; *lnc = *lnc + 1; curlin->table = TRUE; CHKTCHAIN(TREF(curtchain)); TREF(pos_in_chain) = *(TREF(curtchain)); if (TK_IDENT == TREF(window_token)) { x = get_mladdr(&(TREF(window_ident))); if (x->ml) { stx_error(ERR_MULTLAB); success = FALSE; } else { assert(NO_FORMALLIST == x->formalcnt); x->ml = curlin; advancewindow(); if (TK_COLON != TREF(window_token)) mlmax++; else { x->gbl = FALSE; advancewindow(); } } if (success && (TK_LPAREN == TREF(window_token))) { advancewindow(); parmbase = parmtail = newtriple(OC_BINDPARM); for (parmcount = 0; TK_RPAREN != TREF(window_token); parmcount++) { if (TK_IDENT != TREF(window_token)) { stx_error(ERR_NAMEEXPECTED); success = FALSE; break; } else { varnum = get_mvaddr(&(TREF(window_ident)))->mvidx; for (r = parmbase->operand[1].oprval.tref; r; r = r->operand[1].oprval.tref) { assert(TRIP_REF == r->operand[0].oprclass); assert(ILIT_REF == r->operand[0].oprval.tref->operand[0].oprclass); assert((TRIP_REF == r->operand[1].oprclass) || (0 == r->operand[1].oprclass)); if (r->operand[0].oprval.tref->operand[0].oprval.ilit == varnum) { stx_error(ERR_MULTFORMPARM); success = FALSE; break; } } if (!success) break; r = newtriple(OC_PARAMETER); parmtail->operand[1] = put_tref(r); r->operand[0] = put_ilit(varnum); parmtail = r; advancewindow(); } if (TK_COMMA == TREF(window_token)) advancewindow(); else if (TK_RPAREN != TREF(window_token)) { stx_error(ERR_COMMAORRPAREXP); success = FALSE; break; } } if (success) { advancewindow(); parmbase->operand[0] = put_ilit(parmcount); x->formalcnt = parmcount; assert(!mlabtab->lson); if ((mlabtab->rson == x) && !TREF(code_generated)) mlabtab->formalcnt = parmcount; } } } if (success && (TK_EOL != TREF(window_token))) { if (TK_SPACE != TREF(window_token)) { stx_error(ERR_LSEXPECTED); success = FALSE; } else { assert(0 == dot_count); for (;;) { if (TK_SPACE == TREF(window_token)) advancewindow(); else if (TK_PERIOD == TREF(window_token)) { dot_count++; advancewindow(); } else break; } } if ((block_level + 1) < dot_count) { dot_count = (block_level > 0) ? block_level : 0; stx_error(ERR_BLKTOODEEP); success = FALSE; } } if ((0 != parmbase) && (0 != dot_count)) { stx_error(ERR_NESTFORMP); /* Should be warning */ success = FALSE; dot_count = (block_level > 0 ? block_level : 0); } if ((block_level + 1) <= dot_count) { mline_tail->child = curlin; curlin->parent = mline_tail; block_level = dot_count; } else { for (; dot_count < block_level; block_level--) mline_tail = mline_tail->parent; mline_tail->sibling = curlin; curlin->parent = mline_tail->parent; } mline_tail = curlin; if (success) { assert(TREF(for_stack_ptr) == TADR(for_stack)); *(TREF(for_stack_ptr)) = NULL; success = linetail(); if (success) { assert(TREF(for_stack_ptr) == TADR(for_stack)); if (*(TREF(for_stack_ptr))) tnxtarg(*(TREF(for_stack_ptr))); } } assert(TREF(for_stack_ptr) == TADR(for_stack)); if (first_triple->exorder.fl == TREF(curtchain)) newtriple(OC_NOOP); /* empty line (comment, blank, etc) */ curlin->externalentry = first_triple->exorder.fl; /* First_triple points to the last triple before this line was processed. Its forward link will point to a * LINEFETCH or a LINESTART, or possibly a NOOP. It the line was a comment, there is only a LINESTART, and * hence no "real" code yet. */ TREF(code_generated) = TREF(code_generated) | ((OC_NOOP != first_triple->exorder.fl->opcode) && (first_triple->exorder.fl->exorder.fl != TREF(curtchain))); return success; }
gtcm_server() { static readonly int4 reptim[2] = {-100000, -1}; /* 10ms */ static readonly int4 wait[2] = {-1000000, -1}; /* 100ms */ void gtcm_ch(), gtcm_exi_handler(), gtcm_init_ast(), gtcm_int_unpack(), gtcm_mbxread_ast(), gtcm_neterr(), gtcm_read_ast(), gtcm_remove_from_action_queue(), gtcm_shutdown_ast(), gtcm_write_ast(), la_freedb(); bool gtcm_link_accept(); bool alid; char buff[512]; char *h = NULL; char *la_getdb(); char nbuff[256]; char *pak = NULL; char reply; unsigned short outlen; int4 closewait[2] = {0, -1}; int4 inid = 0, mdl = 0, nid = 0, days = 0; int4 lic_status; int4 lic_x; int4 lm_mdl_nid(); uint4 status; int i, receive(), value; mstr name1, name2; struct NTD *cmu_ntdroot(); connection_struct *prev_curr_entry; struct dsc$descriptor_s dprd; struct dsc$descriptor_s dver; $DESCRIPTOR(node_name, nbuff); $DESCRIPTOR(proc_name, "GTCM_SERVER"); $DESCRIPTOR(timout, buff); DCL_THREADGBL_ACCESS; GTM_THREADGBL_INIT; assert(0 == EMPTY_QUEUE); /* check so dont need gdsfhead everywhere */ common_startup_init(GTCM_GNP_SERVER_IMAGE); /* Side-effect: Sets skip_dbtriggers to TRUE for non-trigger platforms */ gtm_env_init(); /* read in all environment variables */ name1.addr = "GTCMSVRNAM"; name1.len = SIZEOF("GTCMSVRNAM") - 1; status = trans_log_name(&name1, &name2, nbuff); if (SS$_NORMAL == status) { proc_name.dsc$a_pointer = nbuff; proc_name.dsc$w_length = node_name.dsc$w_length = name2.len; } else if (SS$_NOLOGNAM == status) { MEMCPY_LIT(nbuff, "GTCMSVR"); node_name.dsc$w_length = SIZEOF("GTCMSVR") - 1; } else rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) status); sys$setprn(&proc_name); status = lib$get_foreign(&timout, 0, &outlen, 0); if ((status & 1) && (6 > outlen)) { for (i = 0; i < outlen; i++) { value = value * 10; if (buff[i] <= '9' && buff[i] >= '0') value += buff[i] - 48; else break; } if (outlen && (i == outlen)) { cm_timeout = TRUE; closewait[0] = value * -10000000; } } dprd.dsc$w_length = cm_prd_len; dprd.dsc$b_dtype = DSC$K_DTYPE_T; dprd.dsc$b_class = DSC$K_CLASS_S; dprd.dsc$a_pointer= cm_prd_name; dver.dsc$w_length = cm_ver_len; dver.dsc$b_dtype = DSC$K_DTYPE_T; dver.dsc$b_class = DSC$K_CLASS_S; dver.dsc$a_pointer= cm_ver_name; ast_init(); licensed = TRUE; lkid = 2; # ifdef NOLICENSE lid = 1; # else /* this code used to be scattered to discourage reverse engineering, but since it now disabled, that seems pointless */ lic_status = ((NULL == (h = la_getdb(LMDB))) ? LP_NOCNFDB : SS$_NORMAL); lic_status = ((1 == (lic_status & 1)) ? lm_mdl_nid(&mdl, &nid, &inid) : lic_status); lic_status = ((1 == (lic_status & 1)) ? lp_licensed(h, &dprd, &dver, mdl, nid, &lid, &lic_x, &days, pak) : lic_status); if (LP_NOCNFDB != lic_status) la_freedb(h); if (1 == (lic_status & 1)) { licensed = TRUE; if (days < 14) rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_WILLEXPIRE); } else { licensed = FALSE; sys$exit(lic_status); } # endif gtcm_ast_avail = astq_dyn_avail - GTCM_AST_OVRHD; stp_init(STP_INITSIZE); rts_stringpool = stringpool; cache_init(); procnum = 0; get_proc_info(0, TADR(login_time), &image_count); memset(proc_to_clb, 0, SIZEOF(proc_to_clb)); status = cmi_init(&node_name, 0, 0, gtcm_init_ast, gtcm_link_accept); if (!(status & 1)) { rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ((status ^ 3) | 4)); sys$exit(status); } ntd_root = cmu_ntdroot(); ntd_root->mbx_ast = gtcm_mbxread_ast; ntd_root->err = gtcm_neterr; gtcm_connection = FALSE; lib$establish(gtcm_ch); gtcm_exi_blk.exit_hand = >cm_exi_handler; gtcm_exi_blk.arg_cnt = 1; gtcm_exi_blk.cond_val = >cm_exi_condition; sys$dclexh(>cm_exi_blk); INVOKE_INIT_SECSHR_ADDRS; initialize_pattern_table(); assert(run_time); /* Should have been set by common_startup_init */ while (!cm_shutdown) { if (blkdlist) gtcml_chkreg(); assert(!lib$ast_in_prog()); status = sys$dclast(>cm_remove_from_action_queue, 0, 0); if (SS$_NORMAL != status) rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) CMERR_CMSYSSRV, 0, status, 0); if (INTERLOCK_FAIL == curr_entry) rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) CMERR_CMINTQUE); if (EMPTY_QUEUE != curr_entry) { switch (*curr_entry->clb_ptr->mbf) { case CMMS_L_LKCANALL: reply = gtcmtr_lkcanall(); break; case CMMS_L_LKCANCEL: reply = gtcmtr_lkcancel(); break; case CMMS_L_LKREQIMMED: reply = gtcmtr_lkreqimmed(); break; case CMMS_L_LKREQNODE: reply = gtcmtr_lkreqnode(); break; case CMMS_L_LKREQUEST: reply = gtcmtr_lkrequest(); break; case CMMS_L_LKRESUME: reply = gtcmtr_lkresume(); break; case CMMS_L_LKACQUIRE: reply = gtcmtr_lkacquire(); break; case CMMS_L_LKSUSPEND: reply = gtcmtr_lksuspend(); break; case CMMS_L_LKDELETE: reply = gtcmtr_lkdelete(); break; case CMMS_Q_DATA: reply = gtcmtr_data(); break; case CMMS_Q_GET: reply = gtcmtr_get(); break; case CMMS_Q_KILL: reply = gtcmtr_kill(); break; case CMMS_Q_ORDER: reply = gtcmtr_order(); break; case CMMS_Q_PREV: reply = gtcmtr_zprevious(); break; case CMMS_Q_PUT: reply = gtcmtr_put(); break; case CMMS_Q_QUERY: reply = gtcmtr_query(); break; case CMMS_Q_ZWITHDRAW: reply = gtcmtr_zwithdraw(); break; case CMMS_S_INITPROC: reply = gtcmtr_initproc(); break; case CMMS_S_INITREG: reply = gtcmtr_initreg(); break; case CMMS_S_TERMINATE: reply = gtcmtr_terminate(TRUE); break; case CMMS_E_TERMINATE: reply = gtcmtr_terminate(FALSE); break; case CMMS_U_LKEDELETE: reply = gtcmtr_lke_clearrep(curr_entry->clb_ptr, curr_entry->clb_ptr->mbf); break; case CMMS_U_LKESHOW: reply = gtcmtr_lke_showrep(curr_entry->clb_ptr, curr_entry->clb_ptr->mbf); break; case CMMS_B_BUFRESIZE: reply = CM_WRITE; value = *(unsigned short *)(curr_entry->clb_ptr->mbf + 1); if (value > curr_entry->clb_ptr->mbl) { free(curr_entry->clb_ptr->mbf); curr_entry->clb_ptr->mbf = malloc(value); } *curr_entry->clb_ptr->mbf = CMMS_C_BUFRESIZE; curr_entry->clb_ptr->mbl = value; curr_entry->clb_ptr->cbl = 1; break; case CMMS_B_BUFFLUSH: reply = gtcmtr_bufflush(); break; case CMMS_Q_INCREMENT: reply = gtcmtr_increment(); break; default: reply = FALSE; if (SS$_NORMAL == status) rts_error_csa(CSA_ARG(NULL) VARLSTCNT(3) ERR_BADGTMNETMSG, 1, (int)*curr_entry->clb_ptr->mbf); break; } if (curr_entry) /* curr_entry can be NULL if went through gtcmtr_terminate */ { status = sys$gettim(&curr_entry->lastact[0]); if (SS$_NORMAL != status) rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) status); /* curr_entry is used by gtcm_mbxread_ast to determine if it needs to defer the interrupt message */ prev_curr_entry = curr_entry; if (CM_WRITE == reply) { /* if ast == gtcm_write_ast, let it worry */ curr_entry->clb_ptr->ast = gtcm_write_ast; curr_entry = EMPTY_QUEUE; cmi_write(prev_curr_entry->clb_ptr); } else { curr_entry = EMPTY_QUEUE; if (1 == (prev_curr_entry->int_cancel.laflag & 1)) { /* valid interrupt cancel msg, handle in gtcm_mbxread_ast */ status = sys$dclast(gtcm_int_unpack, prev_curr_entry, 0); if (SS$_NORMAL != status) rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) status); } else if (CM_READ == reply) { prev_curr_entry->clb_ptr->ast = gtcm_read_ast; cmi_read(prev_curr_entry->clb_ptr); } } } } else if (1 < astq_dyn_avail) { # ifdef GTCM_REPTIM /* if reptim is not needed - and smw doesn't know why it would be - remove this */ status = sys$schdwk(0, 0, &wait[0], &reptim[0]); # else status = sys$schdwk(0, 0, &wait[0], 0); # endif sys$hiber(); sys$canwak(0, 0); } if (cm_timeout && (0 == gtcm_users)) sys$setimr(efn_ignore, closewait, gtcm_shutdown_ast, &cm_shutdown, 0); } }
/* Routine to eliminate the zlinked trigger code for a given trigger about to be deleted. Operations performed * differ depending on platform type (shared binary or not). */ void gtm_trigger_cleanup(gv_trigger_t *trigdsc) { rtn_tabent *rbot, *mid, *rtop; mident *rtnname; rhdtyp *rtnhdr; textElem *telem; int comp, size; stack_frame *fp, *fpprev; mname_entry key; ht_ent_mname *tabent; routine_source *src_tbl; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; /* First thing to do is release trigger source field if it exists */ if (0 < trigdsc->xecute_str.str.len) { free(trigdsc->xecute_str.str.addr); trigdsc->xecute_str.str.len = 0; trigdsc->xecute_str.str.addr = NULL; } /* Next thing to do is find the routine header in the rtn_names list so we can remove it. */ rtnname = &trigdsc->rtn_desc.rt_name; rtnhdr = trigdsc->rtn_desc.rt_adr; rbot = rtn_names; rtop = rtn_names_end; for (;;) { /* See if routine exists in list via a binary search which reverts to serial search when # of items drops below the threshold S_CUTOFF. */ if ((rtop - rbot) < S_CUTOFF) { comp = -1; for (mid = rbot; mid <= rtop ; mid++) { MIDENT_CMP(&mid->rt_name, rtnname, comp); if (0 == comp) break; if (0 < comp) GTMASSERT; /* Routine should be found */ } break; } else { mid = rbot + (rtop - rbot)/2; MIDENT_CMP(&mid->rt_name, rtnname, comp); if (0 == comp) break; else if (0 > comp) { rbot = mid + 1; continue; } else { rtop = mid - 1; continue; } } } # ifdef DEBUG assert(rtnhdr == mid->rt_adr); /* Verify trigger routine we want to remove is not currently active. If it is, we need to GTMASSERT. * Triggers are not like regular routines since they should only ever be referenced from the stack during a * transaction. Likewise, we should only ever load the triggers as the first action in that transaction. */ for (fp = frame_pointer; fp ; fp = fpprev) { fpprev = fp->old_frame_pointer; # ifdef GTM_TRIGGER if (NULL != fpprev && SFT_TRIGR & fpprev->type) fpprev = *(stack_frame **)(fpprev + 1); # endif /* Only one possible version of a trigger routine */ assert(USHBIN_ONLY(NULL) NON_USHBIN_ONLY(fp->rvector) == OLD_RHEAD_ADR(CURRENT_RHEAD_ADR(fp->rvector))); assert(fp->rvector != rtnhdr); } # endif /* Remove break points in this routine before rmv from rtntbl */ zr_remove(rtnhdr, BREAKMSG); /* Release any $TEXT() info this trigger has loaded */ if (NULL != (TREF(rt_name_tbl)).base) { key.var_name = mid->rt_name; COMPUTE_HASH_MNAME(&key); if (NULL != (tabent = lookup_hashtab_mname(TADR(rt_name_tbl), &key))) /* note assignment */ { /* We have a hash entry. Whether it has a value or not, it has a key name (if this is * the first time this trigger is being deleted) that may be pointing into the routine we * are about to remove. Migrate this key name to the stringpool. */ s2pool(&tabent->key.var_name); if (NULL != tabent->value) { /* Has value, release the source. Entries and source are malloc'd in two blocks on UNIX */ src_tbl = (routine_source *)tabent->value; if (NULL != src_tbl->srcbuff) free(src_tbl->srcbuff); free(src_tbl); tabent->value = NULL; } } } /* Remove the routine from the rtn_table */ size = INTCAST((char *)rtn_names_end - (char *)mid); if (0 < size) memmove((char *)mid, (char *)(mid + 1), size); /* Remove this routine name from sorted table */ rtn_names_end--; urx_remove(rtnhdr); /* Remove any unresolved entries */ # ifdef USHBIN_SUPPORTED stp_move((char *)rtnhdr->literal_text_adr, (char *)(rtnhdr->literal_text_adr + rtnhdr->literal_text_len)); GTM_TEXT_FREE(rtnhdr->ptext_adr); /* R/O releasable section */ free(rtnhdr->literal_adr); /* R/W releasable section part 1 */ free(rtnhdr->linkage_adr); /* R/W releasable section part 2 */ free(rtnhdr->labtab_adr); /* Usually non-releasable but triggers don't have labels so * this is just cleaning up a dangling null malloc */ free(rtnhdr); # else # if (!defined(__linux__) && !defined(__CYGWIN__)) || !defined(__i386) || !defined(COMP_GTA) # error Unsupported NON-USHBIN platform # endif /* For a non-shared binary platform we need to get an approximate addr range for stp_move. This is not * done when a routine is replaced on these platforms but in this case we are able to due to the isolated * environment if we only take the precautions of migrating potential literal text which may have been * pointed to by any set environment variables. * In this format, the only platform we support currently is Linux-x86 (i386) which uses GTM_TEXT_ALLOC * to allocate special storage for it to put executable code in. We can access the storage header for * this storage and find out how big it is and use that information to give stp_move a good range since * the literal segment occurs right at the end of allocated storage (for which there is no pointer * in the fileheader). */ telem = (textElem *)((char *)rtnhdr - offsetof(textElem, userStorage)); assert(TextAllocated == telem->state); stp_move((char *)LNRTAB_ADR(rtnhdr) + (rtnhdr->lnrtab_len * SIZEOF(lnr_tabent)), (char *)rtnhdr + telem->realLen); GTM_TEXT_FREE(rtnhdr); # endif }
int m_do(void) { triple tmpchain, *oldchain, *obp, *ref0, *tripsize, *triptr, *ref1, *calltrip, *routineref, *labelref; oprtype *cr; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; if ((TK_SPACE == window_token) || (TK_EOL == window_token)) { if (!run_time) /* DO SP SP is a noop at run time */ { calltrip = newtriple(OC_CALLSP); calltrip->operand[0] = put_mnxl(); calltrip->operand[1] = put_ocnt(); } return TRUE; } else if (TK_AMPERSAND == window_token) { if (!extern_func(0)) return FALSE; else return TRUE; } dqinit(&tmpchain, exorder); oldchain = setcurtchain(&tmpchain); calltrip = entryref(OC_CALL, OC_EXTCALL, (mint)indir_do, TRUE, FALSE, FALSE); setcurtchain(oldchain); if (!calltrip) return FALSE; if (TK_LPAREN == window_token) { if (OC_CALL == calltrip->opcode) { assert(MLAB_REF == calltrip->operand[0].oprclass); calltrip->opcode = OC_EXCAL; ref0 = newtriple(OC_PARAMETER); calltrip->operand[1] = put_tref(ref0); ref0->operand[0] = put_tsiz(); /* parm to hold size of jump codegen */ tripsize = ref0->operand[0].oprval.tref; assert(OC_TRIPSIZE == tripsize->opcode); } else { if (OC_EXTCALL == calltrip->opcode) { assert(TRIP_REF == calltrip->operand[1].oprclass); if (OC_CDLIT == calltrip->operand[1].oprval.tref->opcode) assert(CDLT_REF == calltrip->operand[1].oprval.tref->operand[0].oprclass); else { assert(OC_LABADDR == calltrip->operand[1].oprval.tref->opcode); assert(TRIP_REF == calltrip->operand[1].oprval.tref->operand[1].oprclass); assert(OC_PARAMETER == calltrip->operand[1].oprval.tref->operand[1].oprval.tref->opcode); assert(TRIP_REF == calltrip->operand[1].oprval.tref->operand[1].oprval.tref->operand[0].oprclass); assert(OC_ILIT == calltrip->operand[1].oprval.tref->operand[1].oprval.tref-> operand[0].oprval.tref->opcode); assert(ILIT_REF == calltrip->operand[1].oprval.tref->operand[1].oprval.tref-> operand[0].oprval.tref->operand[0].oprclass); if (0 != calltrip->operand[1].oprval.tref->operand[1].oprval.tref-> operand[0].oprval.tref->operand[0].oprval.ilit) { stx_error(ERR_ACTOFFSET); return FALSE; } } } else /* DO _ @dlabel actuallist */ { assert(OC_COMMARG == calltrip->opcode); assert(TRIP_REF == calltrip->operand[1].oprclass); assert(OC_ILIT == calltrip->operand[1].oprval.tref->opcode); assert(ILIT_REF == calltrip->operand[1].oprval.tref->operand[0].oprclass); assert((mint)indir_do == calltrip->operand[1].oprval.tref->operand[0].oprval.ilit); assert(calltrip->exorder.fl == &tmpchain); routineref = maketriple(OC_CURRHD); labelref = maketriple(OC_LABADDR); ref0 = maketriple(OC_PARAMETER); dqins(calltrip->exorder.bl, exorder, routineref); dqins(calltrip->exorder.bl, exorder, labelref); dqins(calltrip->exorder.bl, exorder, ref0); labelref->operand[0] = calltrip->operand[0]; labelref->operand[1] = put_tref(ref0); ref0->operand[0] = calltrip->operand[1]; ref0->operand[0].oprval.tref->operand[0].oprval.ilit = 0; ref0->operand[1] = put_tref(routineref); calltrip->operand[0] = put_tref(routineref); calltrip->operand[1] = put_tref(labelref); } calltrip->opcode = OC_EXTEXCAL; ref0 = newtriple(OC_PARAMETER); ref0->operand[0] = calltrip->operand[1]; calltrip->operand[1] = put_tref(ref0); } if (!actuallist(&ref0->operand[1])) return FALSE; } else if (OC_CALL == calltrip->opcode) { calltrip->operand[1] = put_ocnt(); if (TREF(for_stack_ptr) != TADR(for_stack)) { if (TAREF1(for_temps, (TREF(for_stack_ptr) - TADR(for_stack)))) calltrip->opcode = OC_FORLCLDO; } } if (TK_COLON == window_token) { advancewindow(); cr = (oprtype *)mcalloc(SIZEOF(oprtype)); if (!bool_expr((bool) FALSE, cr)) return FALSE; if (TREF(expr_start) != TREF(expr_start_orig)) { triptr = newtriple(OC_GVRECTARG); triptr->operand[0] = put_tref(TREF(expr_start)); } obp = oldchain->exorder.bl; dqadd(obp, &tmpchain, exorder); /*this is a violation of info hiding*/ if (OC_EXCAL == calltrip->opcode) { triptr = newtriple(OC_JMP); triptr->operand[0] = put_mfun(&calltrip->operand[0].oprval.lab->mvname); calltrip->operand[0].oprclass = ILIT_REF; /* dummy placeholder */ tripsize->operand[0].oprval.tsize->ct = triptr; } if (TREF(expr_start) != TREF(expr_start_orig)) { ref0 = newtriple(OC_JMP); ref1 = newtriple(OC_GVRECTARG); ref1->operand[0] = put_tref(TREF(expr_start)); *cr = put_tjmp(ref1); tnxtarg(&ref0->operand[0]); } else tnxtarg(cr); } else { obp = oldchain->exorder.bl; dqadd(obp, &tmpchain, exorder); /*this is a violation of info hiding*/ if (OC_EXCAL == calltrip->opcode) { triptr = newtriple(OC_JMP); triptr->operand[0] = put_mfun(&calltrip->operand[0].oprval.lab->mvname); calltrip->operand[0].oprclass = ILIT_REF; /* dummy placeholder */ tripsize->operand[0].oprval.tsize->ct = triptr; } } return TRUE; }
int op_fnzsearch(mval *file, mint indx, mval *ret) { struct stat statbuf; int stat_res; parse_blk pblk; plength *plen, pret; char buf1[MAX_FBUFF + 1]; /* buffer to hold translated name */ mval sub; mstr tn; lv_val *ind_tmp; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; ESTABLISH_RET(fnzsrch_ch, -1); TREF(fnzsearch_nullsubs_sav) = TREF(lv_null_subs); TREF(lv_null_subs) = LVNULLSUBS_OK; /* $ZSearch processing depends on this */ MV_FORCE_STR(file); if (file->str.len > MAX_FBUFF) rts_error(VARLSTCNT(4) ERR_INVSTRLEN, 2, file->str.len, MAX_FBUFF); MV_FORCE_MVAL(((mval *)TADR(fnzsearch_sub_mval)), indx); TREF(fnzsearch_lv_vars) = op_srchindx(VARLSTCNT(2) TREF(zsearch_var), (mval *)TADR(fnzsearch_sub_mval)); if (TREF(fnzsearch_lv_vars)) { assert((TREF(fnzsearch_lv_vars))->v.mvtype & MV_STR); if ((file->str.len != (TREF(fnzsearch_lv_vars))->v.str.len) || memcmp(file->str.addr, (TREF(fnzsearch_lv_vars))->v.str.addr, file->str.len)) { op_kill(TREF(fnzsearch_lv_vars)); TREF(fnzsearch_lv_vars) = NULL; } } if (TREF(fnzsearch_lv_vars)) { for (;;) { pret.p.pint = pop_top(TREF(fnzsearch_lv_vars), ret); /* get next element off the top */ if (!ret->str.len) break; memcpy(buf1, ret->str.addr, ret->str.len); buf1[ret->str.len] = 0; STAT_FILE(buf1, &statbuf, stat_res); if (-1 == stat_res) { if (errno == ENOENT) continue; rts_error(VARLSTCNT(1) errno); } break; } } else { memset(&pblk, 0, SIZEOF(pblk)); pblk.buffer = buf1; pblk.buff_size = MAX_FBUFF; if (!(parse_file(&file->str, &pblk) & 1)) { ret->mvtype = MV_STR; ret->str.len = 0; } else { assert(!TREF(fnzsearch_lv_vars)); buf1[pblk.b_esl] = 0; /* establish new search context */ TREF(fnzsearch_lv_vars) = op_putindx(VARLSTCNT(2) TREF(zsearch_var), TADR(fnzsearch_sub_mval)); (TREF(fnzsearch_lv_vars))->v = *file; /* zsearch_var(indx)=original spec */ if (!(pblk.fnb & F_WILD)) { sub.mvtype = MV_STR; sub.str.len = pblk.b_esl; sub.str.addr = buf1; s2pool(&sub.str); ind_tmp = op_putindx(VARLSTCNT(2) TREF(fnzsearch_lv_vars), &sub); ind_tmp->v.mvtype = MV_STR; ind_tmp->v.str.len = 0; plen = (plength *)&ind_tmp->v.m[1]; plen->p.pblk.b_esl = pblk.b_esl; plen->p.pblk.b_dir = pblk.b_dir; plen->p.pblk.b_name = pblk.b_name; plen->p.pblk.b_ext = pblk.b_ext; } else dir_srch(&pblk); for (;;) { pret.p.pint = pop_top(TREF(fnzsearch_lv_vars), ret); /* get next element off the top */ if (!ret->str.len) break; memcpy(buf1, ret->str.addr, ret->str.len); buf1[ret->str.len] = 0; STAT_FILE(buf1, &statbuf, stat_res); if (-1 == stat_res) { if (errno == ENOENT) continue; rts_error(VARLSTCNT(1) errno); } break; } } } assert((0 == ret->str.len) || (pret.p.pblk.b_esl == ret->str.len)); TREF(lv_null_subs) = TREF(fnzsearch_nullsubs_sav); REVERT; return pret.p.pint; }