void util_spawn(void) { char *cmd; int rc; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; assert(1 >= TREF(parms_cnt)); if (0 == TREF(parms_cnt)) { cmd = GETENV("SHELL"); if (!cmd) cmd = "/bin/sh"; rc = SYSTEM(cmd); if (-1 == rc) PERROR("system : "); } else { assert(TAREF1(parm_ary, TREF(parms_cnt) - 1)); assert((char *)-1L != (TAREF1(parm_ary, TREF(parms_cnt) - 1))); rc = SYSTEM((TAREF1(parm_ary, TREF(parms_cnt) - 1))); if (-1 == rc) PERROR("system : "); } }
void util_help(void) { int rc; char *help_option; char help_cmd_string[HELP_CMD_STRING_SIZE]; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; assert(1 >= TREF(parms_cnt)); assert(GTM_IMAGE < image_type && UTIL_HELP_IMAGES > image_type); if (0 == TREF(parms_cnt)) help_option = utilImageGLDs[INVALID_IMAGE]; else { assert(TAREF1(parm_ary, TREF(parms_cnt) - 1)); assert((char *)-1L != (TAREF1(parm_ary, TREF(parms_cnt) - 1))); help_option = (TAREF1(parm_ary, TREF(parms_cnt) - 1)); } SNPRINTF(help_cmd_string, SIZEOF(help_cmd_string), "$gtm_dist/mumps -run %%XCMD 'do ^GTMHELP(\"%s\",\"$gtm_dist/%shelp.gld\")'", help_option, utilImageGLDs[image_type]); rc = SYSTEM(help_cmd_string); if (0 != rc) rts_error_csa(NULL, VARLSTCNT(5) ERR_TEXT, 2, RTS_ERROR_TEXT("HELP command error"), rc); }
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; }
/* * ----------------------------------------------- * Maintain in parallel with op_zalloc2 * Arguments: * timeout - max. time to wait for locks before giving up * laflag - passed to gvcmx* routines as "laflag" argument; * originally indicated the request was a Lock or * zAllocate request (hence the name "laflag"), but * now capable of holding more values signifying * additional information * * Return: * 1 - if not timeout specified * if timeout specified: * != 0 - all the locks int the list obtained, or * 0 - blocked * The return result is suited to be placed directly into * the $T variable by the caller if timeout is specified. * ----------------------------------------------- */ int op_lock2(int4 timeout, unsigned char laflag) /* timeout is in seconds */ { boolean_t blocked, timer_on; signed char gotit; unsigned short locks_bckout, locks_done; int4 msec_timeout; /* timeout in milliseconds */ mlk_pvtblk *pvt_ptr1, *pvt_ptr2, **prior; unsigned char action; ABS_TIME cur_time, end_time, remain_time; mv_stent *mv_zintcmd; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; gotit = -1; cm_action = laflag; out_of_time = FALSE; if (timeout < 0) timeout = 0; else if (TREF(tpnotacidtime) < timeout) TPNOTACID_CHECK(LOCKTIMESTR); if (!(timer_on = (NO_M_TIMEOUT != timeout))) /* NOTE assignment */ msec_timeout = NO_M_TIMEOUT; else { msec_timeout = timeout2msec(timeout); if (0 == msec_timeout) { out_of_time = TRUE; timer_on = FALSE; } else { mv_zintcmd = find_mvstent_cmd(ZINTCMD_LOCK, restart_pc, restart_ctxt, FALSE); if (mv_zintcmd) { remain_time = mv_zintcmd->mv_st_cont.mvs_zintcmd.end_or_remain; if (0 <= remain_time.at_sec) msec_timeout = (int4)(remain_time.at_sec * 1000 + remain_time.at_usec / 1000); else msec_timeout = 0; TAREF1(zintcmd_active, ZINTCMD_LOCK).restart_pc_last = mv_zintcmd->mv_st_cont.mvs_zintcmd.restart_pc_prior; TAREF1(zintcmd_active, ZINTCMD_LOCK).restart_ctxt_last = mv_zintcmd->mv_st_cont.mvs_zintcmd.restart_ctxt_prior; TAREF1(zintcmd_active, ZINTCMD_LOCK).count--; assert(0 <= TAREF1(zintcmd_active, ZINTCMD_LOCK).count); if (mv_chain == mv_zintcmd) POP_MV_STENT(); /* just pop if top of stack */ else { /* flag as not active */ mv_zintcmd->mv_st_cont.mvs_zintcmd.command = ZINTCMD_NOOP; mv_zintcmd->mv_st_cont.mvs_zintcmd.restart_pc_check = NULL; } } if (0 < msec_timeout) { sys_get_curr_time(&cur_time); add_int_to_abs_time(&cur_time, msec_timeout, &end_time); start_timer((TID)&timer_on, msec_timeout, wake_alarm, 0, NULL); } else { out_of_time = TRUE; timer_on = FALSE; } } } lckclr(); for (blocked = FALSE; !blocked;) { /* if this is a request for a remote node */ if (remlkreq) { if (gotit >= 0) gotit = gvcmx_resremlk(cm_action); else gotit = gvcmx_reqremlk(cm_action, msec_timeout); /* REQIMMED if 2nd arg == 0 */ if (!gotit) { /* only REQIMMED returns false */ blocked = TRUE; break; } } for (pvt_ptr1 = mlk_pvt_root, locks_done = 0; locks_done < lks_this_cmd; pvt_ptr1 = pvt_ptr1->next, locks_done++) { /* Go thru the list of all locks to be obtained attempting to lock * each one. If any lock could not be obtained, break out of the loop */ if (!mlk_lock(pvt_ptr1, 0, TRUE)) { /* If lock is obtained */ pvt_ptr1->granted = TRUE; switch (laflag) { case CM_LOCKS: pvt_ptr1->level = 1; break; case INCREMENTAL: if (pvt_ptr1->level < 511) /* The same lock can not be incremented more than 511 times. */ pvt_ptr1->level += pvt_ptr1->translev; else level_err(pvt_ptr1); break; default: GTMASSERT; break; } } else { blocked = TRUE; break; } } /* If we did not get blocked, we are all done */ if (!blocked) break; /* We got blocked and need to keep retrying after some time interval */ if (remlkreq) gvcmx_susremlk(cm_action); switch (cm_action) { case CM_LOCKS: action = LOCKED; break; case INCREMENTAL: action = INCREMENTAL; break; default: GTMASSERT; break; } for (pvt_ptr2 = mlk_pvt_root, locks_bckout = 0; locks_bckout < locks_done; pvt_ptr2 = pvt_ptr2->next, locks_bckout++) { assert(pvt_ptr2->granted && (pvt_ptr2 != pvt_ptr1)); mlk_bckout(pvt_ptr2, action); } if (dollar_tlevel && (CDB_STAGNATE <= t_tries)) { /* upper TPNOTACID_CHECK conditioned on no short timeout; this one rel_crits to avoid potential deadlock */ assert(TREF(tpnotacidtime) >= timeout); TPNOTACID_CHECK(LOCKTIMESTR); } for (;;) { if (out_of_time || outofband) { /* if time expired || control-c, tptimeout, or jobinterrupt encountered */ if (outofband || !lk_check_own(pvt_ptr1)) { /* If CTL-C, check lock owner */ if (pvt_ptr1->nodptr) /* Get off pending list to be sent a wake */ mlk_unpend(pvt_ptr1); /* Cancel all remote locks obtained so far */ if (remlkreq) { gvcmx_canremlk(); gvcmz_clrlkreq(); remlkreq = FALSE; } if (outofband) { if (timer_on && !out_of_time) { cancel_timer((TID)&timer_on); timer_on = FALSE; } if (!out_of_time && (NO_M_TIMEOUT != timeout)) { /* get remain = end_time - cur_time */ sys_get_curr_time(&cur_time); remain_time = sub_abs_time(&end_time, &cur_time); if (0 <= remain_time.at_sec) msec_timeout = (int4)(remain_time.at_sec * 1000 + remain_time.at_usec / 1000); else msec_timeout = 0; /* treat as out_of_time */ if (0 >= msec_timeout) { out_of_time = TRUE; timer_on = FALSE; /* as if LOCK :0 */ break; } PUSH_MV_STENT(MVST_ZINTCMD); mv_chain->mv_st_cont.mvs_zintcmd.end_or_remain = remain_time; mv_chain->mv_st_cont.mvs_zintcmd.restart_ctxt_check = restart_ctxt; mv_chain->mv_st_cont.mvs_zintcmd.restart_pc_check = restart_pc; /* save current information from zintcmd_active */ mv_chain->mv_st_cont.mvs_zintcmd.restart_ctxt_prior = TAREF1(zintcmd_active, ZINTCMD_LOCK).restart_ctxt_last; mv_chain->mv_st_cont.mvs_zintcmd.restart_pc_prior = TAREF1(zintcmd_active, ZINTCMD_LOCK).restart_pc_last; TAREF1(zintcmd_active, ZINTCMD_LOCK).restart_pc_last = restart_pc; TAREF1(zintcmd_active, ZINTCMD_LOCK).restart_ctxt_last = restart_ctxt; TAREF1(zintcmd_active, ZINTCMD_LOCK).count++; mv_chain->mv_st_cont.mvs_zintcmd.command = ZINTCMD_LOCK; outofband_action(FALSE); /* no return */ } } break; } } if (!mlk_lock(pvt_ptr1, 0, FALSE)) { /* If we got the lock, break out of timer loop */ blocked = FALSE; if (pvt_ptr1 != mlk_pvt_root) { rel_quant(); /* attempt to get a full timeslice for maximum chance to get all */ mlk_unlock(pvt_ptr1); } break; } if (pvt_ptr1->nodptr) lk_check_own(pvt_ptr1); /* clear an abandoned owner */ hiber_start_wait_any(LOCK_SELF_WAKE); } if (blocked && out_of_time) break; } if (remlkreq) { gvcmz_clrlkreq(); remlkreq = FALSE; } if (NO_M_TIMEOUT != timeout) { /* was timed or immediate */ if (timer_on && !out_of_time) cancel_timer((TID)&timer_on); if (blocked) { for (prior = &mlk_pvt_root; *prior;) { if (!(*prior)->granted) { /* if entry was never granted, delete list entry */ mlk_pvtblk_delete(prior); } else prior = &((*prior)->next); } mlk_stats.n_user_locks_fail++; return (FALSE); } } mlk_stats.n_user_locks_success++; return (TRUE); }
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; }
/* * ------------------------------------------ * Hang the process for a specified time. * * Goes to sleep for a positive value. * Any caught signal will terminate the sleep * following the execution of that signal's catching routine. * * Arguments: * num - time to sleep * * Return: * none * ------------------------------------------ */ void op_hang(mval* num) { int ms; mv_stent *mv_zintcmd; ABS_TIME cur_time, end_time; # ifdef VMS uint4 time[2]; int4 efn_mask, status; # endif DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; ms = 0; MV_FORCE_NUM(num); if (num->mvtype & MV_INT) { if (0 < num->m[1]) { assert(MV_BIAS >= 1000); /* if formats change overflow may need attention */ ms = num->m[1] * (1000 / MV_BIAS); } } else if (0 == num->sgn) /* if sign is not 0 it means num is negative */ ms = mval2i(num) * 1000; /* too big to care about fractional amounts */ if (ms) { if (TREF(tpnotacidtime) * 1000 < ms) TPNOTACID_CHECK(HANGSTR); # if defined(DEBUG) && defined(UNIX) if (gtm_white_box_test_case_enabled && (WBTEST_DEFERRED_TIMERS == gtm_white_box_test_case_number) && (3 > gtm_white_box_test_case_count) && (123000 == ms)) { DEFER_INTERRUPTS(INTRPT_NO_TIMER_EVENTS); DBGFPF((stderr, "OP_HANG: will sleep for 20 seconds\n")); LONG_SLEEP(20); DBGFPF((stderr, "OP_HANG: done sleeping\n")); ENABLE_INTERRUPTS(INTRPT_NO_TIMER_EVENTS); return; } if (gtm_white_box_test_case_enabled && (WBTEST_BREAKMPC == gtm_white_box_test_case_number) && (0 == gtm_white_box_test_case_count) && (999 == ms)) { frame_pointer->old_frame_pointer->mpc = (unsigned char *)GTM64_ONLY(0xdeadbeef12345678) NON_GTM64_ONLY(0xdead1234); return; } /* Upon seeing a .999s hang this white-box test launches a timer that pops with a period of UTIL_OUT_SYSLOG_INTERVAL * and prints a long message via util_out_ptr. */ if (gtm_white_box_test_case_enabled && (WBTEST_UTIL_OUT_BUFFER_PROTECTION == gtm_white_box_test_case_number) && (0 == gtm_white_box_test_case_count) && (999 == ms)) { start_timer((TID)&util_out_syslog_dump, UTIL_OUT_SYSLOG_INTERVAL, util_out_syslog_dump, 0, NULL); return; } # endif sys_get_curr_time(&cur_time); mv_zintcmd = find_mvstent_cmd(ZINTCMD_HANG, restart_pc, restart_ctxt, FALSE); if (!mv_zintcmd) add_int_to_abs_time(&cur_time, ms, &end_time); else { end_time = mv_zintcmd->mv_st_cont.mvs_zintcmd.end_or_remain; cur_time = sub_abs_time(&end_time, &cur_time); /* get remaing time to sleep */ if (0 <= cur_time.at_sec) ms = (int4)(cur_time.at_sec * 1000 + cur_time.at_usec / 1000); else ms = 0; /* all done */ /* restore/pop previous zintcmd_active[ZINTCMD_HANG] hints */ TAREF1(zintcmd_active, ZINTCMD_HANG).restart_pc_last = mv_zintcmd->mv_st_cont.mvs_zintcmd.restart_pc_prior; TAREF1(zintcmd_active, ZINTCMD_HANG).restart_ctxt_last = mv_zintcmd->mv_st_cont.mvs_zintcmd.restart_ctxt_prior; TAREF1(zintcmd_active, ZINTCMD_HANG).count--; assert(0 <= TAREF1(zintcmd_active, ZINTCMD_HANG).count); if (mv_chain == mv_zintcmd) POP_MV_STENT(); /* just pop if top of stack */ else { /* flag as not active */ mv_zintcmd->mv_st_cont.mvs_zintcmd.command = ZINTCMD_NOOP; mv_zintcmd->mv_st_cont.mvs_zintcmd.restart_pc_check = NULL; } if (0 == ms) return; /* done HANGing */ } UNIX_ONLY(hiber_start(ms);) VMS_ONLY( time[0] = -time_low_ms(ms); time[1] = -time_high_ms(ms) - 1; efn_mask = (1 << efn_outofband | 1 << efn_timer); if (SS$_NORMAL != (status = sys$setimr(efn_timer, &time, NULL, &time, 0))) rts_error(VARLSTCNT(8) ERR_SYSCALL, 5, RTS_ERROR_LITERAL("$setimr"), CALLFROM, status); if (SS$_NORMAL != (status = sys$wflor(efn_outofband, efn_mask))) rts_error(VARLSTCNT(8) ERR_SYSCALL, 5, RTS_ERROR_LITERAL("$wflor"), CALLFROM, status); ) if (outofband)
/* * ------------------------------------------ * Hang the process for a specified time. * * Goes to sleep for a positive value. * Any caught signal will terminate the sleep * following the execution of that signal's catching routine. * * The actual hang duration should be NO LESS than the specified * duration for specified durations greater than .001 seconds. * Certain applications depend on this assumption. * * Arguments: * num - time to sleep * * Return: * none * ------------------------------------------ */ void op_hang(mval* num) { int ms; double tmp; mv_stent *mv_zintcmd; ABS_TIME cur_time, end_time; # ifdef VMS uint4 time[2]; int4 efn_mask, status; # endif DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; ms = 0; MV_FORCE_NUM(num); if (num->mvtype & MV_INT) { if (0 < num->m[1]) { assert(MV_BIAS >= 1000); /* if formats change overflow may need attention */ ms = num->m[1] * (1000 / MV_BIAS); } } else if (0 == num->sgn) /* if sign is not 0 it means num is negative */ { tmp = mval2double(num) * (double)1000; ms = ((double)MAXPOSINT4 >= tmp) ? (int)tmp : (int)MAXPOSINT4; } if (ms) { if (TREF(tpnotacidtime) * 1000 < ms) TPNOTACID_CHECK(HANGSTR); # if defined(DEBUG) && defined(UNIX) if (WBTEST_ENABLED(WBTEST_DEFERRED_TIMERS) && (3 > gtm_white_box_test_case_count) && (123000 == ms)) { DEFER_INTERRUPTS(INTRPT_NO_TIMER_EVENTS); DBGFPF((stderr, "OP_HANG: will sleep for 20 seconds\n")); LONG_SLEEP(20); DBGFPF((stderr, "OP_HANG: done sleeping\n")); ENABLE_INTERRUPTS(INTRPT_NO_TIMER_EVENTS); return; } if (WBTEST_ENABLED(WBTEST_BREAKMPC)&& (0 == gtm_white_box_test_case_count) && (999 == ms)) { frame_pointer->old_frame_pointer->mpc = (unsigned char *)GTM64_ONLY(0xdeadbeef12345678) NON_GTM64_ONLY(0xdead1234); return; } if (WBTEST_ENABLED(WBTEST_UTIL_OUT_BUFFER_PROTECTION) && (0 == gtm_white_box_test_case_count) && (999 == ms)) { /* Upon seeing a .999s hang this white-box test launches a timer that pops with a period of * UTIL_OUT_SYSLOG_INTERVAL and prints a long message via util_out_ptr. */ start_timer((TID)&util_out_syslog_dump, UTIL_OUT_SYSLOG_INTERVAL, util_out_syslog_dump, 0, NULL); return; } # endif sys_get_curr_time(&cur_time); mv_zintcmd = find_mvstent_cmd(ZINTCMD_HANG, restart_pc, restart_ctxt, FALSE); if (!mv_zintcmd) add_int_to_abs_time(&cur_time, ms, &end_time); else { end_time = mv_zintcmd->mv_st_cont.mvs_zintcmd.end_or_remain; cur_time = sub_abs_time(&end_time, &cur_time); /* get remaing time to sleep */ if (0 <= cur_time.at_sec) ms = (int4)(cur_time.at_sec * 1000 + cur_time.at_usec / 1000); else ms = 0; /* all done */ /* restore/pop previous zintcmd_active[ZINTCMD_HANG] hints */ TAREF1(zintcmd_active, ZINTCMD_HANG).restart_pc_last = mv_zintcmd->mv_st_cont.mvs_zintcmd.restart_pc_prior; TAREF1(zintcmd_active, ZINTCMD_HANG).restart_ctxt_last = mv_zintcmd->mv_st_cont.mvs_zintcmd.restart_ctxt_prior; TAREF1(zintcmd_active, ZINTCMD_HANG).count--; assert(0 <= TAREF1(zintcmd_active, ZINTCMD_HANG).count); if (mv_chain == mv_zintcmd) POP_MV_STENT(); /* just pop if top of stack */ else { /* flag as not active */ mv_zintcmd->mv_st_cont.mvs_zintcmd.command = ZINTCMD_NOOP; mv_zintcmd->mv_st_cont.mvs_zintcmd.restart_pc_check = NULL; } if (0 == ms) return; /* done HANGing */ } # ifdef UNIX if (ms < 10) SLEEP_USEC(ms * 1000, TRUE); /* Finish the sleep if it is less than 10ms. */ else hiber_start(ms); # elif defined(VMS) time[0] = -time_low_ms(ms); time[1] = -time_high_ms(ms) - 1; efn_mask = (1 << efn_outofband | 1 << efn_timer); if (SS$_NORMAL != (status = sys$setimr(efn_timer, &time, NULL, &time, 0))) rts_error_csa(CSA_ARG(NULL) VARLSTCNT(8) ERR_SYSCALL, 5, RTS_ERROR_LITERAL("$setimr"), CALLFROM, status); if (SS$_NORMAL != (status = sys$wflor(efn_outofband, efn_mask))) rts_error_csa(CSA_ARG(NULL) VARLSTCNT(8) ERR_SYSCALL, 5, RTS_ERROR_LITERAL("$wflor"), CALLFROM, status); if (outofband) { if (SS$_WASCLR == (status = sys$readef(efn_timer, &efn_mask))) { if (SS$_NORMAL != (status = sys$cantim(&time, 0))) rts_error_csa(CSA_ARG(NULL) VARLSTCNT(8) ERR_SYSCALL, 5, RTS_ERROR_LITERAL("$cantim"), CALLFROM, status); } else assertpro(SS$_WASSET == status); } # endif } else rel_quant(); if (outofband) { PUSH_MV_STENT(MVST_ZINTCMD); mv_chain->mv_st_cont.mvs_zintcmd.end_or_remain = end_time; mv_chain->mv_st_cont.mvs_zintcmd.restart_ctxt_check = restart_ctxt; mv_chain->mv_st_cont.mvs_zintcmd.restart_pc_check = restart_pc; /* save current information from zintcmd_active */ mv_chain->mv_st_cont.mvs_zintcmd.restart_ctxt_prior = TAREF1(zintcmd_active, ZINTCMD_HANG).restart_ctxt_last; mv_chain->mv_st_cont.mvs_zintcmd.restart_pc_prior = TAREF1(zintcmd_active, ZINTCMD_HANG).restart_pc_last; TAREF1(zintcmd_active, ZINTCMD_HANG).restart_pc_last = restart_pc; TAREF1(zintcmd_active, ZINTCMD_HANG).restart_ctxt_last = restart_ctxt; TAREF1(zintcmd_active, ZINTCMD_HANG).count++; mv_chain->mv_st_cont.mvs_zintcmd.command = ZINTCMD_HANG; outofband_action(FALSE); } return; }
bool cli_get_parm(char *entry, char val_buf[]) { char *sp; int ind; int match_ind, res; char local_str[MAX_LINE]; int eof; char *gets_res; int parm_len; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; ind = 0; assert(0 != gpcmd_parm_vals); STRNCPY_STR(local_str, entry, SIZEOF(local_str) - 1); cli_strupper(local_str); match_ind = -1; while (0 < strlen(sp = (gpcmd_parm_vals + ind)->name)) /* implicit assignment intended */ { if (0 == (res = STRNCMP_STR(sp, local_str, MAX_OPT_LEN))) /* implicit assignment intended */ { if (-1 != match_ind) return (FALSE); else match_ind = ind; } else { if (0 < res) break; } ind++; } if (-1 != match_ind) { if (NULL == TAREF1(parm_ary, match_ind)) { if (!((gpcmd_parm_vals + match_ind)->parm_required)) /* Value not required */ return FALSE; /* If no value and required, prompt for it */ PRINTF("%s", (gpcmd_parm_vals + match_ind)->prompt); fflush(stdout); gets_res = cli_fgets(local_str, MAX_LINE, stdin, FALSE); if (gets_res) { parm_len = STRLEN(gets_res); /* chop off newline */ if (parm_len && (local_str[parm_len - 1] == '\n')) { local_str[parm_len - 1] = '\0'; --parm_len; } TAREF1(parm_str_len, match_ind) = parm_len + 1; GROW_HEAP_IF_NEEDED(match_ind); if (parm_len) memcpy(TAREF1(parm_ary, match_ind), &local_str[0], parm_len); *(TAREF1(parm_ary, match_ind) + parm_len) = '\0'; } else { /* No string was returned so create a real ghost to point to. Note that this should be revisited since this is NOT what should be happening. We should be returning FALSE here but need to instead return a null parm since current behaviors have a dependency on it SE 10/2003 */ TAREF1(parm_str_len, match_ind) = 1; GROW_HEAP_IF_NEEDED(match_ind); *TAREF1(parm_ary, match_ind) = '\0'; } } else if (-1 == *TAREF1(parm_ary, match_ind) && 1 == TAREF1(parm_str_len, match_ind)) return (FALSE); strcpy(val_buf, TAREF1(parm_ary, match_ind)); if (!cli_look_next_token(&eof) || (0 == cli_gettoken(&eof))) { TAREF1(parm_str_len, match_ind) = 1; GROW_HEAP_IF_NEEDED(match_ind); *TAREF1(parm_ary, match_ind) = -1; } else { parm_len = STRLEN(cli_token_buf) + 1; if (MAX_LINE < parm_len) { PRINTF("Parameter string too long\n"); fflush(stdout); return (FALSE); } TAREF1(parm_str_len, match_ind) = parm_len; GROW_HEAP_IF_NEEDED(match_ind); memcpy(TAREF1(parm_ary, match_ind), cli_token_buf, parm_len); } } else { /* ----------------- * check qualifiers * ----------------- */ if (!cli_get_value(local_str, val_buf)) return (FALSE); } return (TRUE); }
/* * --------------------------------------------------------- * Parse one option. * Read tokens from the input. * Check if it is a valid qualifier or parameter. * If it is a parameter, get it, and save it in the * global parameter array. * If it is a qualifier, get its value and save it in a value table, * corresponding to this option. * * Arguments: * pcmd_parms - pointer to command parameter table * eof - pointer to end of file flag * * Return: * 1 - option parsed OK * -1 - failure to parse option * 0 - no more tokens, in which case * the eof flag is set on end of file. * --------------------------------------------------------- */ int parse_arg(CLI_ENTRY *pcmd_parms, int *eof) { CLI_ENTRY *pparm; char *opt_str, *val_str; int neg_flg; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; /* ----------------------------------------- * get qualifier marker, or parameter token * ----------------------------------------- */ if (VAL_LIST == gpcmd_verb->val_type && TREF(parms_cnt) == gpcmd_verb->max_parms) return (0); if (!cli_look_next_token(eof)) return (0); /* ------------------------------------------------------------------- * here cli_token_buf is set by the previous cli_look_next_token(eof) * call itself since it in turn calls cli_gettoken() * ------------------------------------------------------------------- */ if (!cli_is_qualif(cli_token_buf) && !cli_is_assign(cli_token_buf)) { /* ---------------------------------------------------- * If token is not a qualifier, it must be a parameter * * No need to check for eof on cli_get_string_token(eof) since * already checked that on the previous cli_look_next_token. * now you have to skip initial white spaces before reading * the string since cli_get_string_token considers a space * as a blank token. hence the need for the skip_white_space() * call. * ------------------------------------------------------------ */ skip_white_space(); cli_get_string_token(eof); if (TREF(parms_cnt) >= gpcmd_verb->max_parms) { SNPRINTF(cli_err_str, MAX_CLI_ERR_STR, "Too many parameters "); return (-1); } TAREF1(parm_str_len, TREF(parms_cnt)) = strlen(cli_token_buf) + 1; GROW_HEAP_IF_NEEDED(TREF(parms_cnt)); memcpy(TAREF1(parm_ary, TREF(parms_cnt)), cli_token_buf, TAREF1(parm_str_len, TREF(parms_cnt))); (TREF(parms_cnt))++; return (1); } /* --------------------------------------------------------------------- * cli_gettoken(eof) need not be checked for return value since earlier * itself we have checked for return value in cli_look_next_token(eof) * --------------------------------------------------------------------- */ cli_gettoken(eof); opt_str = cli_token_buf; if (!pcmd_parms) { SNPRINTF(cli_err_str, MAX_CLI_ERR_STR, "No qualifiers allowed for this command"); return (-1); } /* ------------------------------------------ * Qualifiers must start with qualifier token * ------------------------------------------ */ if (!cli_is_qualif(cli_token_buf)) { SNPRINTF(cli_err_str, MAX_CLI_ERR_STR, "Qualifier expected instead of : %s ", opt_str); return (-1); } /* ------------------------- * Get the qualifier string * ------------------------- */ if (!cli_look_next_token(eof) || 0 == cli_gettoken(eof)) { SNPRINTF(cli_err_str, MAX_CLI_ERR_STR, "Qualifier string missing %s ", opt_str); return (-1); } /* --------------------------------------- * Fold the qualifier string to upper case * --------------------------------------- */ cli_strupper(opt_str); /* ------------------------- * See if option is negated and update * ------------------------- */ if (-1 == (neg_flg = cli_check_negated(&opt_str, pcmd_parms, &pparm))) return (-1); /* ------------------------------------------------------------- * If value is disallowed for this qualifier, and an assignment * token is encounter, report error, values not allowed for * negated qualifiers * ------------------------------------------------------------- */ if (neg_flg || VAL_DISALLOWED == pparm->required) { if (cli_look_next_token(eof) && cli_is_assign(cli_token_buf)) { SNPRINTF(cli_err_str, MAX_CLI_ERR_STR, "Assignment is not allowed for this option : %s", pparm->name); return (-1); } } else { /* -------------------------------------------------- * Get Value either optional, or required. * In either case, there must be an assignment token * -------------------------------------------------- */ if (!cli_look_next_token(eof) || !cli_is_assign(cli_token_buf)) { if (VAL_REQ == pparm->required) { SNPRINTF(cli_err_str, MAX_CLI_ERR_STR, "Option : %s needs value", pparm->name); return (-1); } else { if (pparm->present) { /* The option was specified before, so clean up that one, * the last one overrides */ if (pparm->pval_str) free(pparm->pval_str); if (pparm->qual_vals) clear_parm_vals(pparm->qual_vals, FALSE); } /* ------------------------------- * Allocate memory and save value * ------------------------------- */ if (pparm->parm_values) { MALLOC_CPY_STR(pparm->pval_str, pparm->parm_values->prompt); if (!cli_get_sub_quals(pparm)) return (-1); } } } else { cli_gettoken(eof); /* --------------------------------- * Get the assignment token + value * --------------------------------- */ if (!cli_is_assign(cli_token_buf)) { SNPRINTF(cli_err_str, MAX_CLI_ERR_STR, "Assignment missing after option : %s", pparm->name); return (-1); } /* -------------------------------------------------------- * get the value token, "=" is NOT a token terminator here * -------------------------------------------------------- */ if (!cli_look_next_string_token(eof) || 0 == cli_get_string_token(eof)) { SNPRINTF(cli_err_str, MAX_CLI_ERR_STR, "Unrecognized option : %s, value expected but not found", pparm->name); cli_lex_in_ptr->tp = 0; return (-1); } val_str = cli_token_buf; if (!cli_numeric_check(pparm, val_str)) { cli_lex_in_ptr->tp = 0; return (-1); } if (pparm->present) { /* The option was specified before, so clean up that one, * the last one overrides */ if (pparm->pval_str) free(pparm->pval_str); if (pparm->qual_vals) clear_parm_vals(pparm->qual_vals, FALSE); } /* ------------------------------- * Allocate memory and save value * ------------------------------- */ MALLOC_CPY_STR(pparm->pval_str, cli_token_buf); if (!cli_get_sub_quals(pparm)) return (-1); } } if (pparm->present) pparm->negated = 0; pparm->negated = neg_flg; pparm->present = 1; if (NULL != pparm->func) func = pparm->func; /* ---------------------------------------------------------------------------------------------------------------------- * If there is another level, update global pointers * Notice that this global pointer updation should be done only at the end of this routine in order to ensure that the * check_disallow() function invoked below sees the currently parsed argument as present (i.e. pparm->present = 1) * ---------------------------------------------------------------------------------------------------------------------- */ if (pparm->parms) { /*------------------------------------------------------------------------------------------- * Check that the disallow conditions for this level are met before switching to next level *------------------------------------------------------------------------------------------- */ if (FALSE == check_disallow(gpcmd_verb)) return (-1); gpqual_root = pparm; clear_parm_vals(pparm->parms, TRUE); gpcmd_qual = pparm->parms; gpcmd_verb = pparm; /* this needs to be done in order for check_disallow() to do the proper disallow check. * an example that will not work otherwise is cli_disallow_mupip_replic_receive() */ } return (1); }
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; }