int UNIX_ONLY(main)VMS_ONLY(dbcertify)(int argc, char **argv)
{
DCL_THREADGBL_ACCESS;
/* Initialization of scaffolding we run on */
GTM_THREADGBL_INIT;
gtm_imagetype_init(DBCERTIFY_IMAGE);
gtm_env_init();
gtm_utf8_mode = FALSE; /* Only ever runs in V4 database so NO utf8 mode -- ever */
psa_gbl = malloc(SIZEOF(*psa_gbl));
memset(psa_gbl, 0, SIZEOF(*psa_gbl));
UNIX_ONLY(err_init(dbcertify_base_ch));
UNIX_ONLY(sig_init(dbcertify_signal_handler, dbcertify_signal_handler, NULL));
VMS_ONLY(util_out_open(0));
VMS_ONLY(SET_EXIT_HANDLER(exi_blk, dbcertify_exit_handler, exi_condition)); /* Establish exit handler */
VMS_ONLY(ESTABLISH(dbcertify_base_ch));
process_id = getpid();
/* Structure checks .. */
assert((24 * 1024) == SIZEOF(v15_sgmnt_data)); /* Verify V4 file header hasn't suddenly increased for some odd reason */
/* Platform dependent method to get the option scan going and invoke necessary driver routine */
dbcertify_parse_and_dispatch(argc, argv);
return SS_NORMAL;
}
/* ------------------------------------------------------------------
* Timer handler (Set -> Expired)
*
* - Sets flag to indicate timeout has occurred.
* - Should only happen if a timeout has been started (and not cancelled),
* and has not yet expired.
* - Static because it's for internal use only.
* ------------------------------------------------------------------
*/
STATICFNDEF void tp_expire_now(void)
{
DBGWTIME((stderr, "%s tp_expire_now: Driving xfer_set_handlers\n" VMS_ONLY("\n"),
asccurtime));
assert(in_timed_tn);
tp_timeout_set_xfer = xfer_set_handlers(outofband_event, &tptimeout_set, 0);
}
void jnl_send_oper(jnl_private_control *jpc, uint4 status)
{
sgmnt_addrs *csa;
sgmnt_data_ptr_t csd;
jnl_buffer_ptr_t jb;
uint4 now_writer, fsync_pid;
int4 io_in_prog, fsync_in_prog;
boolean_t ok_to_log; /* TRUE except when we avoid flooding operator log due to ENOSPC error */
error_def(ERR_CALLERID);
error_def(ERR_JNLBUFINFO);
error_def(ERR_JNLPVTINFO);
error_def(ERR_JNLSENDOPER);
switch(jpc->region->dyn.addr->acc_meth)
{
case dba_mm:
case dba_bg:
csa = &FILE_INFO(jpc->region)->s_addrs;
break;
default:
GTMASSERT;
}
csd = csa->hdr;
jb = jpc->jnl_buff;
UNIX_ONLY(assert((ENOSPC != jpc->status) || jb->enospc_errcnt || WBTEST_ENABLED(WBTEST_RECOVER_ENOSPC)));
UNIX_ONLY(assert((SS_NORMAL == jpc->status) || (ENOSPC == jpc->status) || !jb->enospc_errcnt));
VMS_ONLY(assert(!jb->enospc_errcnt)); /* currently not updated in VMS, so should be 0 */
ok_to_log = (jb->enospc_errcnt ? (1 == (jb->enospc_errcnt % ENOSPC_LOGGING_PERIOD)) : TRUE);
caller_id_flag = FALSE;
if (ok_to_log)
{
SEND_CALLERID("jnl_send_oper()");
if (0 != status)
{
if (SS_NORMAL != jpc->status)
{
if (SS_NORMAL != jpc->status2)
{
send_msg(VARLSTCNT(14)
ERR_JNLSENDOPER, 5, process_id, status, jpc->status, jpc->status2, jb->iosb.cond,
status, 2, JNL_LEN_STR(csd), jpc->status, 0, jpc->status2);
} else
send_msg(VARLSTCNT(12)
ERR_JNLSENDOPER, 5, process_id, status, jpc->status, jpc->status2, jb->iosb.cond,
status, 2, JNL_LEN_STR(csd), jpc->status);
} else
send_msg(VARLSTCNT(11) ERR_JNLSENDOPER, 5, process_id, status, jpc->status, jpc->status2,
jb->iosb.cond, status, 2, JNL_LEN_STR(csd));
}
}
jpc->status = SS_NORMAL;
jpc->status2 = SS_NORMAL;
UNIX_ONLY(
io_in_prog = (jb->io_in_prog_latch.u.parts.latch_pid ? TRUE : FALSE);
now_writer = jb->io_in_prog_latch.u.parts.latch_pid;
)
/* Select aNd Receive */
ssize_t iosocket_snr(socket_struct *socketptr, void *buffer, size_t maxlength, int flags, ABS_TIME *time_for_read)
{
int status;
ssize_t bytesread, recvsize;
void *recvbuff;
DBGSOCK((stdout, "socsnr: socketptr: 0x"lvaddr" buffer: 0x"lvaddr" maxlength: %d, flags: %d\n",
socketptr, buffer, maxlength, flags));
/* ====================== use leftover from the previous read, if there is any ========================= */
assert(maxlength > 0);
if (socketptr->buffered_length > 0)
{
DBGSOCK2((stdout, "socsnr: read from buffer - buffered_length: %d\n", socketptr->buffered_length));
bytesread = MIN(socketptr->buffered_length, maxlength);
memcpy(buffer, (void *)(socketptr->buffer + socketptr->buffered_offset), bytesread);
socketptr->buffered_offset += bytesread;
socketptr->buffered_length -= bytesread;
DBGSOCK2((stdout, "socsnr: after buffer read - buffered_offset: %d buffered_length: %d\n",
socketptr->buffered_offset, socketptr->buffered_length));
return bytesread;
}
/* ===================== decide on which buffer to use and the size of the recv ======================== */
if (socketptr->buffer_size > maxlength)
{
recvbuff = socketptr->buffer;
recvsize = socketptr->buffer_size;
} else
{
recvbuff = buffer;
recvsize = maxlength;
}
VMS_ONLY(recvsize = MIN(recvsize, VMS_MAX_TCP_IO_SIZE));
DBGSOCK2((stdout, "socsnr: recvsize set to %d\n", recvsize));
/* =================================== select and recv ================================================= */
assert(0 == socketptr->buffered_length);
socketptr->buffered_length = 0;
bytesread = (int)iosocket_snr_io(socketptr, recvbuff, recvsize, flags, time_for_read);
DBGSOCK2((stdout, "socsnr: bytes read from recv: %d timeout: %d\n", bytesread, out_of_time));
if (0 < bytesread)
{ /* -------- got something this time ----------- */
if (recvbuff == socketptr->buffer)
{
if (bytesread <= maxlength)
memcpy(buffer, socketptr->buffer, bytesread);
else
{ /* -------- got some stuff for future recv -------- */
memcpy(buffer, socketptr->buffer, maxlength);
socketptr->buffered_length = bytesread - maxlength;
bytesread = socketptr->buffered_offset = maxlength;
DBGSOCK2((stdout, "socsnr: Buffer updated post read - buffered_offset: %d "
"buffered_length: %d\n", socketptr->buffered_offset, socketptr->buffered_length));
}
}
}
return bytesread;
}
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);
ASSERT_SAFE_TO_UPDATE_THREAD_GBLS;
TREF(util_outbuff_ptr) = TADR(util_outbuff); /* Point util_outbuff_ptr to the beginning of util_outbuff at first. */
TREF(util_outptr) = TREF(util_outbuff_ptr);
(TREF(source_buffer)).addr = (char *)&aligned_source_buffer;
(TREF(source_buffer)).len = MAX_SRCLINE;
}
uint4 jnl_file_lost(jnl_private_control *jpc, uint4 jnl_stat)
{ /* Notify operator and terminate journaling */
unsigned int status;
sgmnt_addrs *csa;
seq_num reg_seqno, jnlseqno;
boolean_t was_lockid = FALSE, instfreeze_environ;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
switch(jpc->region->dyn.addr->acc_meth)
{
case dba_mm:
case dba_bg:
csa = &FILE_INFO(jpc->region)->s_addrs;
break;
default:
assertpro(FALSE && jpc->region->dyn.addr->acc_meth);
}
# ifdef VMS
/* The following assert has been removed as it could be FALSE if the caller is "jnl_file_extend"
* assert(0 != memcmp(csa->nl->jnl_file.jnl_file_id.fid, zero_fid, SIZEOF(zero_fid)));
*/
# endif
assert(csa->now_crit);
/* We issue an rts_error (instead of shutting off journaling) in the following cases : {BYPASSOK}
* 1) $gtm_error_on_jnl_file_lost is set to issue runtime error (if not already issued) in case of journaling issues.
* 2) The process has the given message set in $gtm_custom_errors (indicative of instance freeze on error setup)
* in which case the goal is to never shut-off journaling
*/
UNIX_ONLY(assert(jnlpool.jnlpool_ctl == jnlpool_ctl));
UNIX_ONLY(instfreeze_environ = INST_FREEZE_ON_MSG_ENABLED(csa, jnl_stat));
VMS_ONLY(instfreeze_environ = FALSE);
if ((JNL_FILE_LOST_ERRORS == TREF(error_on_jnl_file_lost)) || instfreeze_environ)
{
VMS_ONLY(assert(FALSE)); /* Not fully implemented / supported on VMS. */
if (!process_exiting || instfreeze_environ || !csa->jnl->error_reported)
{
csa->jnl->error_reported = TRUE;
in_wcs_recover = FALSE; /* in case we're called in wcs_recover() */
if (SS_NORMAL != jpc->status)
rts_error_csa(CSA_ARG(csa) VARLSTCNT(7) jnl_stat, 4, JNL_LEN_STR(csa->hdr),
DB_LEN_STR(gv_cur_region), jpc->status);
else
rts_error_csa(CSA_ARG(csa) VARLSTCNT(6) jnl_stat, 4, JNL_LEN_STR(csa->hdr),
DB_LEN_STR(gv_cur_region));
}
return jnl_stat;
}
if (0 != jnl_stat)
jnl_send_oper(jpc, jnl_stat);
csa->hdr->jnl_state = jnl_closed;
jpc->jnl_buff->cycle++; /* increment shared cycle so all future callers of jnl_ensure_open recognize journal switch */
assert(jpc->cycle < jpc->jnl_buff->cycle);
if (REPL_ENABLED(csa->hdr))
{
csa->hdr->repl_state = repl_was_open;
reg_seqno = csa->hdr->reg_seqno;
jnlseqno = (NULL != jnlpool.jnlpool_ctl) ? jnlpool.jnlpool_ctl->jnl_seqno : MAX_SEQNO;
send_msg_csa(CSA_ARG(csa) VARLSTCNT(8) ERR_REPLJNLCLOSED, 6, DB_LEN_STR(jpc->region), ®_seqno, ®_seqno,
&jnlseqno, &jnlseqno);
} else
send_msg_csa(CSA_ARG(csa) VARLSTCNT(5) ERR_JNLCLOSED, 3, DB_LEN_STR(jpc->region), &csa->ti->curr_tn);
#ifdef VMS
/* We can get a jnl_file_lost before the file is even created, so locking is done only if the lock exist */
if (0 != csa->jnl->jnllsb->lockid)
{
was_lockid = TRUE;
status = gtm_enqw(EFN$C_ENF, LCK$K_EXMODE, csa->jnl->jnllsb, LCK$M_CONVERT | LCK$M_NODLCKBLK,
NULL, 0, NULL, 0, NULL, PSL$C_USER, 0);
if (SS$_NORMAL == status)
status = csa->jnl->jnllsb->cond;
}
jnl_file_close(jpc->region, FALSE, FALSE);
if (was_lockid)
{
if (SS$_NORMAL == status)
status = gtm_deq(csa->jnl->jnllsb->lockid, NULL, PSL$C_USER, 0);
assertpro(SS$_NORMAL == status);
}
# else
jnl_file_close(jpc->region, FALSE, FALSE);
#endif
return EXIT_NRM;
}
void dse_crit(void)
{
int util_len, dse_crit_count;
char util_buff[MAX_UTIL_LEN];
boolean_t crash = FALSE, cycle = FALSE, owner = FALSE;
gd_region *save_region, *r_local, *r_top;
crash = ((cli_present("CRASH") == CLI_PRESENT) || (cli_present("RESET") == CLI_PRESENT));
cycle = (CLI_PRESENT == cli_present("CYCLE"));
if (cli_present("SEIZE") == CLI_PRESENT || cycle)
{
if (gv_cur_region->read_only && !cycle)
rts_error_csa(CSA_ARG(cs_addrs) VARLSTCNT(4) ERR_DBRDONLY, 2, DB_LEN_STR(gv_cur_region));
if (cs_addrs->now_crit)
{
util_out_print("!/Write critical section already seized.!/", TRUE);
return;
}
crash_count = cs_addrs->critical->crashcnt;
grab_crit_encr_cycle_sync(gv_cur_region);
cs_addrs->hold_onto_crit = TRUE; /* need to do this AFTER grab_crit */
cs_addrs->dse_crit_seize_done = TRUE;
util_out_print("!/Seized write critical section.!/", TRUE);
if (!cycle)
return;
}
if (cli_present("RELEASE") == CLI_PRESENT || cycle)
{
if (gv_cur_region->read_only && !cycle)
rts_error_csa(CSA_ARG(cs_addrs) VARLSTCNT(4) ERR_DBRDONLY, 2, DB_LEN_STR(gv_cur_region));
if (!cs_addrs->now_crit)
{
util_out_print("!/Critical section already released.!/", TRUE);
return;
}
crash_count = cs_addrs->critical->crashcnt;
if (cs_addrs->now_crit)
{ /* user wants crit to be released unconditionally so "was_crit" not checked like everywhere else */
assert(cs_addrs->hold_onto_crit && cs_addrs->dse_crit_seize_done);
cs_addrs->dse_crit_seize_done = FALSE;
cs_addrs->hold_onto_crit = FALSE; /* need to do this before the rel_crit */
rel_crit(gv_cur_region);
util_out_print("!/Released write critical section.!/", TRUE);
}
# ifdef DEBUG
else
assert(!cs_addrs->hold_onto_crit && !cs_addrs->dse_crit_seize_done);
# endif
return;
}
if (cli_present("INIT") == CLI_PRESENT)
{
if (gv_cur_region->read_only)
rts_error_csa(CSA_ARG(cs_addrs) VARLSTCNT(4) ERR_DBRDONLY, 2, DB_LEN_STR(gv_cur_region));
cs_addrs->hdr->image_count = 0;
UNIX_ONLY(gtm_mutex_init(gv_cur_region, NUM_CRIT_ENTRY(cs_addrs->hdr), crash));
VMS_ONLY(mutex_init(cs_addrs->critical, NUM_CRIT_ENTRY(cs_addrs->hdr), crash));
cs_addrs->nl->in_crit = 0;
cs_addrs->now_crit = FALSE;
util_out_print("!/Reinitialized critical section.!/", TRUE);
return;
}
if (cli_present("REMOVE") == CLI_PRESENT)
{
if (gv_cur_region->read_only)
rts_error_csa(CSA_ARG(cs_addrs) VARLSTCNT(4) ERR_DBRDONLY, 2, DB_LEN_STR(gv_cur_region));
if (cs_addrs->nl->in_crit == 0)
{
util_out_print("!/The write critical section is unowned!/", TRUE);
return;
}
UNIX_ONLY(assert(LOCK_AVAILABLE != cs_addrs->critical->semaphore.u.parts.latch_pid);)
VMS_ONLY(assert(cs_addrs->critical->semaphore >= 0);)
/* ------------------------------------------------------------------
* *** INTERRUPT HANDLER ***
* Sets up transfer table changes needed for:
* - Synchronous handling of asynchronous events.
* - Single-stepping and breakpoints
* Note:
* - Call here from a routine specific to each event type.
* - Pass in a single value to pass on to xfer_table set function
* for that type. Calling routine should record any other event
* info, if needed, in volatile global variables.
* - If this is first event logged, will call back to the function
* provided and pass along parameter.
* Future:
* - mdb_condition_handler does not call here -- should change it.
* - Ditto for routines related to zbreak and zstep.
* - Should put handler prototypes in a header file & include it here,
* if can use with some way to ensure type checking.
* - A higher-level interface (e.g. change sets) might be better.
* ------------------------------------------------------------------
*/
boolean_t xfer_set_handlers(int4 event_type, void (*set_fn)(int4 param), int4 param_val)
{
boolean_t is_first_event = FALSE;
/* ------------------------------------------------------------
* Keep track of what event types have come in.
* - Get and set value atomically in case of concurrent
* events and/or resetting while setting.
* ------------------------------------------------------------------
* Use interlocked operations to prevent races between set and reset,
* and to avoid missing overlapping sets.
* On HPUX-HPPA:
* OK only if there's no a risk a conflicting operation is
* in progress (can deadlock in micro-lock).
* On all platforms:
* Don't want I/O from a sensitive area.
* Avoid both by testing fast_lock_count, and doing interlocks and
* I/O only if it is non-zero. Can't be resetting then, so worst
* risk is missing an event when there's already one happening.
* ------------------------------------------------------------------
*/
VMS_ONLY(assert(lib$ast_in_prog()));
if (fast_lock_count == 0)
{
DBGDFRDEVNT((stderr, "xfer_set_handlers: Before interlocked operations: "
"xfer_table_events[%d]=%d, first_event=%s, num_deferred=%d\n",
event_type, xfer_table_events[event_type], (is_first_event ? "TRUE" : "FALSE"),
num_deferred));
if (1 == INCR_CNT_SP(&xfer_table_events[event_type], &defer_latch))
/* Concurrent events can collide here, too */
is_first_event = (1 == INCR_CNT_SP(&num_deferred, &defer_latch));
DBGDFRDEVNT((stderr, "xfer_set_handlers: After interlocked operations: "
"xfer_table_events[%d]=%d, first_event=%s, num_deferred=%d\n",
event_type,xfer_table_events[event_type], (is_first_event ? "TRUE" : "FALSE"),
num_deferred));
} else if (1 == ++xfer_table_events[event_type])
is_first_event = (1 == ++num_deferred);
if (is_first_event)
{
first_event = event_type;
# ifdef DEBUG_DEFERRED_EVENT
if (0 != fast_lock_count)
DBGDFRDEVNT((stderr, "xfer_set_handlers: Setting xfer_table for event type %d\n",
event_type));
# endif
/* -------------------------------------------------------
* If table changed, it was not synchronized.
* (Assumes these entries are all that would be changed)
* Note asserts bypassed for Itanium due to nature of the
* fixed up addresses making direct comparisions non-trivial.
* --------------------------------------------------------
*/
# ifndef __ia64
assert((xfer_table[xf_linefetch] == op_linefetch) ||
(xfer_table[xf_linefetch] == op_zstepfetch) ||
(xfer_table[xf_linefetch] == op_zst_fet_over) ||
(xfer_table[xf_linefetch] == op_mproflinefetch));
assert((xfer_table[xf_linestart] == op_linestart) ||
(xfer_table[xf_linestart] == op_zstepstart) ||
(xfer_table[xf_linestart] == op_zst_st_over) ||
(xfer_table[xf_linestart] == op_mproflinestart));
assert((xfer_table[xf_zbfetch] == op_zbfetch) ||
(xfer_table[xf_zbfetch] == op_zstzb_fet_over) ||
(xfer_table[xf_zbfetch] == op_zstzbfetch));
assert((xfer_table[xf_zbstart] == op_zbstart) ||
(xfer_table[xf_zbstart] == op_zstzb_st_over) ||
(xfer_table[xf_zbstart] == op_zstzbstart));
assert((xfer_table[xf_forchk1] == op_forchk1) ||
(xfer_table[xf_forchk1] == op_mprofforchk1));
assert((xfer_table[xf_forloop] == op_forloop));
assert(xfer_table[xf_ret] == opp_ret ||
xfer_table[xf_ret] == opp_zst_over_ret ||
xfer_table[xf_ret] == opp_zstepret);
assert(xfer_table[xf_retarg] == op_retarg ||
xfer_table[xf_retarg] == opp_zst_over_retarg ||
xfer_table[xf_retarg] == opp_zstepretarg);
# endif /* !IA64 */
/* -----------------------------------------------
* Now call the specified set function to swap in
* the desired handlers (and set flags or whatever).
* -----------------------------------------------
*/
DBGDFRDEVNT((stderr, "xfer_set_handlers: Driving event setup handler\n"));
set_fn(param_val);
}
# ifdef DEBUG_DEFERRED_EVENT
else if (0 != fast_lock_count)
{
DBGDFRDEVNT((stderr, "xfer_set_handlers: ---Multiple deferred events---\n"
"Event type %d occurred while type %d was pending\n", event_type, first_event));
} else
{
DBGDFRDEVNT((stderr, "xfer_set_handlers: Event bypassed -- was not first event\n"));
}
# endif
assert(no_event != first_event);
return is_first_event;
}
int m_set(void)
{
/* Some comment on "parse_warn". It is set to TRUE whenever the parse encounters an
invalid setleft target.
* Note that even if "parse_warn" is TRUE, we should not return FALSE right away but need to continue the parse
* until the end of the current SET command. This way any remaining commands in the current parse line will be
* parsed and triples generated for them. This is necessary just in case the currently parsed invalid SET command
* does not get executed at runtime (due to postconditionals etc.)
*
* Some comment on the need for "first_setleft_invalid". This variable is needed only in the
* case we encounter an invalid-SVN/invalid-FCN/unsettable-SVN as a target of the SET. We need to evaluate the
* right-hand-side of the SET command only if at least one valid setleft target is parsed before an invalid setleft
* target is encountered. This is because we still need to execute the valid setlefts at runtime before triggering
* a runtime error for the invalid setleft. If the first setleft target is an invalid one, then there is no need
* to evaluate the right-hand-side. In fact, in this case, adding triples (corresponding to the right hand side)
* to the execution chain could cause problems with emit_code later in the compilation as the destination
* for the right hand side triples could now be undefined (for example a valid SVN on the left side of the
* SET would have generated an OC_SVPUT triple with one of its operands holding the result of the right
* hand side evaluation, but an invalid SVN on the left side which would have instead caused an OC_RTERROR triple
* to have been generated leaving no triple to receive the result of the right hand side evaluation thus causing
* emit_code to be confused and GTMASSERT). Therefore discard all triples generated by the right hand side in this case.
* By the same reasoning, discard all triples generated by setleft targets AFTER this invalid one as well.
* "first_setleft_invalid" is set to TRUE if the first setleft target is invalid and set to FALSE if the first setleft
* target is valid. It is initialized to -1 before the start of the parse.
*/
int index, setop, delimlen;
int first_val_lit, last_val_lit, nakedzalias;
boolean_t first_is_lit, last_is_lit, got_lparen, delim1char, is_extract, valid_char;
boolean_t alias_processing, have_lh_alias;
opctype put_oc;
oprtype v, delimval, firstval, lastval, *result, resptr;
triple *curtargchain, *delimiter, discardcurtchain, *first, *get, *jmptrp1, *jmptrp2, *last, *obp, *put;
triple *s, *s0, *s1, save_targchain, *save_curtchain, *save_curtchain1, *sub, targchain, *tmp;
mint delimlit;
mval *delim_mval;
mvar *mvarptr;
boolean_t parse_warn; /* set to TRUE in case of an invalid SVN etc. */
boolean_t curtchain_switched; /* set to TRUE if a setcurtchain was done */
int first_setleft_invalid; /* set to TRUE if the first setleft target is invalid */
boolean_t temp_subs_was_FALSE;
union
{
uint4 unichar_val;
unsigned char unibytes_val[4];
} unichar;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
TREF(temp_subs) = FALSE;
dqinit(&targchain, exorder);
result = (oprtype *)mcalloc(SIZEOF(oprtype));
resptr = put_indr(result);
delimiter = sub = last = NULL;
/* A SET clause must be entirely alias related or a normal set. Parenthized multiple sets of aliases are not allowed
* and will trigger an error. This is because the source and targets of aliases require different values and references
* than normal sets do and thus cannot be mixed.
*/
if (alias_processing = (TK_ASTERISK == window_token))
advancewindow();
if (got_lparen = (TK_LPAREN == window_token))
{
if (alias_processing)
stx_error(ERR_NOALIASLIST);
advancewindow();
TREF(temp_subs) = TRUE;
}
/* Some explanation: The triples from the left hand side of the SET expression that are
* expressly associated with fetching (in case of set $piece/$extract) and/or storing of
* the target value are removed from curtchain and placed on the targchain. Later, these
* triples will be added to the end of curtchain to do the finishing store of the target
* after the righthand side has been evaluated. This is per the M standard.
*
* Note that SET $PIECE/$EXTRACT have special conditions in which the first argument is not referenced at all.
* (e.g. set $piece(^a," ",3,2) in this case 3 > 2 so this should not evaluate ^a and therefore should not
* modify the naked indicator). That is, the triples that do these conditional checks need to be inserted
* ahead of the OC_GVNAME of ^a, all of which need to be inserted on the targchain. But the conditionalization
* can be done only after parsing the first argument of the SET $PIECE and examining the remaining arguments.
* Therefore we maintain the "curtargchain" variable which stores the value of the "targchain" at the beginning
* of the iteration (at the start of the $PIECE parsing) and all the conditionalization will be inserted right
* here which is guaranteed to be ahead of where the OC_GVNAME gets inserted.
*
* For example, SET $PIECE(^A(x,y),delim,first,last)=RHS will generate a final triple chain as follows
*
* A - Triples to evaluate subscripts (x,y) of the global ^A
* A - Triples to evaluate delim
* A - Triples to evaluate first
* A - Triples to evaluate last
* B - Triples to evaluate RHS
* C - Triples to do conditional check (e.g. first > last etc.)
* C - Triples to branch around if the checks indicate this is a null operation SET $PIECE
* D - Triple that does OC_GVNAME of ^A
* D - Triple that does OC_SETPIECE to determine the new value
* D - Triple that does OC_GVPUT of the new value into ^A(x,y)
* This is the point where the conditional check triples will branch around to if they chose to.
*
* A - triples that evaluates the arguments/subscripts in the left-hand-side of the SET command
* These triples are built in "curtchain"
* B - triples that evaluates the arguments/subscripts in the right-hand-side of the SET command
* These triples are built in "curtchain"
* C - triples that do conditional check for any $PIECE/$EXTRACT in the left side of the SET command.
* These triples are built in "curtargchain"
* D - triples that generate the reference to the target of the SET and the store into the target.
* These triples are built in "targchain"
*
* Note alias processing does not support the SET *(...)=.. type syntax because the type of argument
* created for RHS processing is dependent on the LHS receiver type and we do not support more than one
* type of source argument in a single SET.
*/
first_setleft_invalid = FIRST_SETLEFT_NOTSEEN;
curtchain_switched = FALSE;
nakedzalias = have_lh_alias = FALSE;
save_curtchain = NULL;
assert(FIRST_SETLEFT_NOTSEEN != TRUE);
assert(FIRST_SETLEFT_NOTSEEN != FALSE);
for (parse_warn = FALSE; ; parse_warn = FALSE)
{
curtargchain = targchain.exorder.bl;
jmptrp1 = jmptrp2 = NULL;
delim1char = is_extract = FALSE;
allow_dzwrtac_as_mident(); /* Allows $ZWRTACxxx as target to be treated as an mident */
switch (window_token)
{
case TK_IDENT:
/* A slight diversion first. If this is a $ZWRTAC set (indication of $ in first char
* is currently enough to signify that), then we need to check a few conditions first.
* If this is a "naked $ZWRTAC", meaning no numeric suffix, then this is a flag that
* all the $ZWRTAC vars in the local variable tree need to be kill *'d which will not
* be generating a SET instruction. First we need to verify that fact and make sure
* we are not in PARENs and not doing alias processing. Note *any* value can be
* specified as the source but while it will be evaluated, it is NOT stored anywhere.
*/
if ('$' == *window_ident.addr)
{ /* We have a $ZWRTAC<xx> target */
if (got_lparen)
/* We don't allow $ZWRTACxxx to be specified in a parenthesized list.
* Verify that first
*/
SYNTAX_ERROR(ERR_DZWRNOPAREN);
if (STR_LIT_LEN(DOLLAR_ZWRTAC) == window_ident.len)
{ /* Ok, this is a naked $ZWRTAC targeted set */
if (alias_processing)
SYNTAX_ERROR(ERR_DZWRNOALIAS);
nakedzalias = TRUE;
/* This opcode doesn't really need args but it is easier to fit in with the rest
* of m_set processing to pass it the result arg, which there may actually be
* a use for someday..
*/
put = maketriple(OC_CLRALSVARS);
put->operand[0] = resptr;
dqins(targchain.exorder.bl, exorder, put);
advancewindow();
break;
}
}
/* If we are doing alias processing, there are two possibilities:
* 1) LHS is unsubscripted - it is an alias variable being created or replaced. Need to parse
* the varname as if this were a regular set.
* 2) LHS is subscripted - it is an alias container variable being created or replaced. The
* processing here is to pass the base variable index to the store routine so bypass the
* lvn() call.
*/
if (!alias_processing || TK_LPAREN == director_token)
{ /* Normal variable processing or we have a lh alias container */
if (!lvn(&v, OC_PUTINDX, 0))
SYNTAX_ERROR_NOREPORT_HERE;
if (OC_PUTINDX == v.oprval.tref->opcode)
{
dqdel(v.oprval.tref, exorder);
dqins(targchain.exorder.bl, exorder, v.oprval.tref);
sub = v.oprval.tref;
put_oc = OC_PUTINDX;
if (TREF(temp_subs))
m_set_create_temporaries(sub, put_oc);
}
} else
{ /* Have alias variable. Argument is index into var table rather than pointer to var */
have_lh_alias = TRUE;
/* We only want the variable index in this case. Since the entire hash structure to which
* this variable is going to be pointing to is changing, doing anything that calls fetch()
* is somewhat pointless so we avoid it by just accessing the variable information
* directly.
*/
mvarptr = get_mvaddr(&window_ident);
v = put_ilit(mvarptr->mvidx);
advancewindow();
}
/* Determine correct storing triple */
put = maketriple((!alias_processing ? OC_STO :
(have_lh_alias ? OC_SETALS2ALS : OC_SETALSIN2ALSCT)));
put->operand[0] = v;
put->operand[1] = resptr;
dqins(targchain.exorder.bl, exorder, put);
break;
case TK_CIRCUMFLEX:
if (alias_processing)
SYNTAX_ERROR(ERR_ALIASEXPECTED);
s1 = curtchain->exorder.bl;
if (!gvn())
SYNTAX_ERROR_NOREPORT_HERE;
for (sub = curtchain->exorder.bl; sub != s1; sub = sub->exorder.bl)
{
put_oc = sub->opcode;
if (OC_GVNAME == put_oc || OC_GVNAKED == put_oc || OC_GVEXTNAM == put_oc)
break;
}
assert(OC_GVNAME == put_oc || OC_GVNAKED == put_oc || OC_GVEXTNAM == put_oc);
dqdel(sub, exorder);
dqins(targchain.exorder.bl, exorder, sub);
if (TREF(temp_subs))
m_set_create_temporaries(sub, put_oc);
put = maketriple(OC_GVPUT);
put->operand[0] = resptr;
dqins(targchain.exorder.bl, exorder, put);
break;
case TK_ATSIGN:
if (alias_processing)
SYNTAX_ERROR(ERR_ALIASEXPECTED);
if (!indirection(&v))
SYNTAX_ERROR_NOREPORT_HERE;
if (!got_lparen && TK_EQUAL != window_token)
{
assert(!curtchain_switched);
put = newtriple(OC_COMMARG);
put->operand[0] = v;
put->operand[1] = put_ilit(indir_set);
return TRUE;
}
put = maketriple(OC_INDSET);
put->operand[0] = v;
put->operand[1] = resptr;
dqins(targchain.exorder.bl, exorder, put);
break;
case TK_DOLLAR:
if (alias_processing)
SYNTAX_ERROR(ERR_ALIASEXPECTED);
advancewindow();
if (TK_IDENT != window_token)
SYNTAX_ERROR(ERR_VAREXPECTED);
if (TK_LPAREN != director_token)
{ /* Look for intrinsic special variables */
s1 = curtchain->exorder.bl;
if (0 > (index = namelook(svn_index, svn_names, window_ident.addr, window_ident.len)))
{
STX_ERROR_WARN(ERR_INVSVN); /* sets "parse_warn" to TRUE */
} else if (!svn_data[index].can_set)
{
STX_ERROR_WARN(ERR_SVNOSET); /* sets "parse_warn" to TRUE */
}
advancewindow();
if (!parse_warn)
{
if (SV_ETRAP != svn_data[index].opcode && SV_ZTRAP != svn_data[index].opcode)
{ /* Setting of $ZTRAP or $ETRAP must go through opp_svput because they
* may affect the stack pointer. All others directly to op_svput().
*/
put = maketriple(OC_SVPUT);
} else
put = maketriple(OC_PSVPUT);
put->operand[0] = put_ilit(svn_data[index].opcode);
put->operand[1] = resptr;
dqins(targchain.exorder.bl, exorder, put);
} else
{ /* OC_RTERROR triple would have been inserted in curtchain by ins_errtriple
* (invoked by stx_error). To maintain consistency with the "if" portion of
* this code, we need to move this triple to the "targchain".
*/
tmp = curtchain->exorder.bl; /* corresponds to put_ilit(FALSE) in ins_errtriple */
tmp = tmp->exorder.bl; /* corresponds to put_ilit(in_error) in ins_errtriple */
tmp = tmp->exorder.bl; /* corresponds to newtriple(OC_RTERROR) in ins_errtriple */
assert(OC_RTERROR == tmp->opcode);
dqdel(tmp, exorder);
dqins(targchain.exorder.bl, exorder, tmp);
CHKTCHAIN(&targchain);
}
break;
}
/* Only 4 function names allowed on left side: $[Z]Piece and $[Z]Extract */
index = namelook(fun_index, fun_names, window_ident.addr, window_ident.len);
if (0 > index)
{
STX_ERROR_WARN(ERR_INVFCN); /* sets "parse_warn" to TRUE */
/* OC_RTERROR triple would have been inserted in "curtchain" by ins_errtriple
* (invoked by stx_error). We need to switch it to "targchain" to be consistent
* with every other codepath in this module.
*/
tmp = curtchain->exorder.bl; /* corresponds to put_ilit(FALSE) in ins_errtriple */
tmp = tmp->exorder.bl; /* corresponds to put_ilit(in_error) in ins_errtriple */
tmp = tmp->exorder.bl; /* corresponds to newtriple(OC_RTERROR) in ins_errtriple */
assert(OC_RTERROR == tmp->opcode);
dqdel(tmp, exorder);
dqins(targchain.exorder.bl, exorder, tmp);
CHKTCHAIN(&targchain);
advancewindow(); /* skip past the function name */
advancewindow(); /* skip past the left paren */
/* Parse the remaining arguments until corresponding RIGHT-PAREN/SPACE/EOL is reached */
if (!parse_until_rparen_or_space())
SYNTAX_ERROR_NOREPORT_HERE;
} else
{
switch(fun_data[index].opcode)
{
case OC_FNPIECE:
setop = OC_SETPIECE;
break;
case OC_FNEXTRACT:
is_extract = TRUE;
setop = OC_SETEXTRACT;
break;
case OC_FNZPIECE:
setop = OC_SETZPIECE;
break;
case OC_FNZEXTRACT:
is_extract = TRUE;
setop = OC_SETZEXTRACT;
break;
default:
SYNTAX_ERROR(ERR_VAREXPECTED);
}
advancewindow();
advancewindow();
/* Although we see the get (target) variable first, we need to save it's processing
* on another chain -- the targchain -- because the retrieval of the target is bypassed
* and the naked indicator is not reset if the first/last parameters are not set in a
* logical manner (must be > 0 and first <= last). So the evaluation order is
* delimiter (if $piece), first, last, RHS of the set and then the target if applicable.
* Set up primary action triple now since it is ref'd by the put triples generated below.
*/
s = maketriple(setop);
/* Even for SET[Z]PIECE and SET[Z]EXTRACT, the SETxxxxx opcodes
* do not do the final store, they only create the final value TO be
* stored so generate the triples that will actually do the store now.
* Note we are still building triples on the original curtchain.
*/
switch (window_token)
{
case TK_IDENT:
if (!lvn(&v, OC_PUTINDX, 0))
SYNTAX_ERROR(ERR_VAREXPECTED);
if (OC_PUTINDX == v.oprval.tref->opcode)
{
dqdel(v.oprval.tref, exorder);
dqins(targchain.exorder.bl, exorder, v.oprval.tref);
sub = v.oprval.tref;
put_oc = OC_PUTINDX;
if (TREF(temp_subs))
m_set_create_temporaries(sub, put_oc);
}
get = maketriple(OC_FNGET);
get->operand[0] = v;
put = maketriple(OC_STO);
put->operand[0] = v;
put->operand[1] = put_tref(s);
break;
case TK_ATSIGN:
if (!indirection(&v))
SYNTAX_ERROR(ERR_VAREXPECTED);
get = maketriple(OC_INDGET);
get->operand[0] = v;
get->operand[1] = put_str(0, 0);
put = maketriple(OC_INDSET);
put->operand[0] = v;
put->operand[1] = put_tref(s);
break;
case TK_CIRCUMFLEX:
s1 = curtchain->exorder.bl;
if (!gvn())
SYNTAX_ERROR_NOREPORT_HERE;
for (sub = curtchain->exorder.bl; sub != s1 ; sub = sub->exorder.bl)
{
put_oc = sub->opcode;
if ((OC_GVNAME == put_oc) || (OC_GVNAKED == put_oc)
|| (OC_GVEXTNAM == put_oc))
break;
}
assert((OC_GVNAME == put_oc) || (OC_GVNAKED == put_oc)
|| (OC_GVEXTNAM == put_oc));
dqdel(sub, exorder);
dqins(targchain.exorder.bl, exorder, sub);
if (TREF(temp_subs))
m_set_create_temporaries(sub, put_oc);
get = maketriple(OC_FNGVGET);
get->operand[0] = put_str(0, 0);
put = maketriple(OC_GVPUT);
put->operand[0] = put_tref(s);
break;
default:
SYNTAX_ERROR(ERR_VAREXPECTED);
}
s->operand[0] = put_tref(get);
/* Code to fetch args for target triple are on targchain. Put get there now too. */
dqins(targchain.exorder.bl, exorder, get);
CHKTCHAIN(&targchain);
if (!is_extract)
{ /* Set $[z]piece */
delimiter = newtriple(OC_PARAMETER);
s->operand[1] = put_tref(delimiter);
first = newtriple(OC_PARAMETER);
delimiter->operand[1] = put_tref(first);
/* Process delimiter string ($[z]piece only) */
if (TK_COMMA != window_token)
SYNTAX_ERROR(ERR_COMMA);
advancewindow();
if (!strexpr(&delimval))
SYNTAX_ERROR_NOREPORT_HERE;
assert(TRIP_REF == delimval.oprclass);
} else
{ /* Set $[Z]Extract */
first = newtriple(OC_PARAMETER);
s->operand[1] = put_tref(first);
}
/* Process first integer value */
if (window_token != TK_COMMA)
firstval = put_ilit(1);
else
{
advancewindow();
if (!intexpr(&firstval))
SYNTAX_ERROR(ERR_COMMA);
assert(firstval.oprclass == TRIP_REF);
}
first->operand[0] = firstval;
if (first_is_lit = (OC_ILIT == firstval.oprval.tref->opcode))
{
assert(ILIT_REF ==firstval.oprval.tref->operand[0].oprclass);
first_val_lit = firstval.oprval.tref->operand[0].oprval.ilit;
}
if (TK_COMMA != window_token)
{ /* There is no "last" value. Only if 1 char literal delimiter and
* no "last" value can we generate shortcut code to op_set[z]p1 entry
* instead of op_set[z]piece. Note if UTF8 mode is in effect, then this
* optimization applies if the literal is one unicode char which may in
* fact be up to 4 bytes but will still be passed as a single unsigned
* integer.
*/
if (!is_extract)
{
delim_mval = &delimval.oprval.tref->operand[0].oprval.mlit->v;
valid_char = TRUE; /* Basic assumption unles proven otherwise */
if (delimval.oprval.tref->opcode == OC_LIT &&
(1 == (gtm_utf8_mode ?
MV_FORCE_LEN(delim_mval) : delim_mval->str.len)))
{ /* Single char delimiter for set $piece */
UNICODE_ONLY(
if (gtm_utf8_mode)
{ /* We have a supposed single char delimiter but it
* must be a valid utf8 char to be used by
* op_setp1() and MV_FORCE_LEN won't tell us that.
*/
valid_char = UTF8_VALID(delim_mval->str.addr,
(delim_mval->str.addr
+ delim_mval->str.len),
delimlen);
if (!valid_char && !badchar_inhibit)
UTF8_BADCHAR(0, delim_mval->str.addr,
(delim_mval->str.addr
+ delim_mval->str.len),
0, NULL);
}
);
if (valid_char || 1 == delim_mval->str.len)
{ /* This reference to a one character literal or a single
* byte invalid utf8 character that needs to be turned into
* an explict formated integer literal instead
*/
unichar.unichar_val = 0;
if (!gtm_utf8_mode)
{ /* Single byte delimiter */
assert(1 == delim_mval->str.len);
UNIX_ONLY(s->opcode = OC_SETZP1);
VMS_ONLY(s->opcode = OC_SETP1);
unichar.unibytes_val[0] = *delim_mval->str.addr;
}
UNICODE_ONLY(
else
{ /* Potentially multiple bytes in one int */
assert(SIZEOF(int) >= delim_mval->str.len);
memcpy(unichar.unibytes_val,
delim_mval->str.addr,
delim_mval->str.len);
s->opcode = OC_SETP1;
}
);
delimlit = (mint)unichar.unichar_val;
delimiter->operand[0] = put_ilit(delimlit);
delim1char = TRUE;
}
}
}
void preemptive_db_clnup(int preemptive_severe)
{
sgmnt_addrs *csa;
sgm_info *si;
gd_region *r_top, *reg;
gd_addr *addr_ptr;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
/* Clear "inctn_opcode" global variable now that any in-progress transaction is aborted at this point.
* Not doing so would cause future calls to "t_end" to get confused and skip writing logical jnl recs
* and instead incorrectly write an INCTN record (GTM-8425).
*/
if (bml_save_dollar_tlevel)
{
assert(!dollar_tlevel);
dollar_tlevel = bml_save_dollar_tlevel;
bml_save_dollar_tlevel = 0;
}
assert(!dollar_tlevel || (inctn_invalid_op == inctn_opcode) || (inctn_bmp_mark_free_gtm == inctn_opcode));
assert(dollar_tlevel || update_trans || (inctn_invalid_op == inctn_opcode));
inctn_opcode = inctn_invalid_op;
if (!dollar_tlevel && update_trans)
{ /* It's possible we hit an error in the middle of an update, at which point we have
* a valid clue and non-NULL cse. However, this causes problems for subsequent
* transactions (see comment in t_begin). In particular we could end up pinning buffers
* unnecessarily. So clear the cse of any histories that may have been active during the update.
*/
CLEAR_CSE(gv_target);
if ((NULL != gv_target) && (NULL != gv_target->gd_csa))
{
CLEAR_CSE(gv_target->gd_csa->dir_tree);
GTMTRIG_ONLY(CLEAR_CSE(gv_target->gd_csa->hasht_tree));
}
/* Resetting this is necessary to avoid blowing an assert in t_begin that it is 0 at the start of a transaction. */
update_trans = 0;
}
if (INVALID_GV_TARGET != reset_gv_target)
{
if (SUCCESS != preemptive_severe && INFO != preemptive_severe)
{
/* We know of a few cases in Unix where gv_target and gv_currkey could be out of sync at this point.
* a) If we are inside trigger code which in turn does an update that does
* reads of ^#t global and ends up in a restart. This restart would
* in turn do a rts_error_csa(TPRETRY) which would invoke mdb_condition_handler
* that would in turn invoke preemptive_db_clnup which invokes this macro.
* In this tp restart case though, it is ok for gv_target and gv_currkey
* to be out of sync because they are going to be reset by tp_clean_up anyways.
* So skip the dbg-only in-sync check.
* b) If we are in gvtr_init reading the ^#t global and detect an error (e.g. TRIGINVCHSET)
* gv_target after the reset would be pointing to a regular global whereas gv_currkey
* would be pointing to ^#t. It is ok to be out-of-sync since in this case, we expect
* mdb_condition_handler to be calling us. That has code to reset gv_currkey (and
* cs_addrs/cs_data etc.) to reflect gv_target (i.e. get them back in sync).
* Therefore in Unix we pass SKIP_GVT_GVKEY_CHECK to skip the gvtarget/gvcurrkey out-of-sync check
* in RESET_GV_TARGET. In VMS we pass DO_GVT_GVKEY_CHECK as we dont yet know of an out-of-sync situation.
*/
RESET_GV_TARGET(UNIX_ONLY(SKIP_GVT_GVKEY_CHECK) VMS_ONLY(DO_GVT_GVKEY_CHECK));
}
}
need_kip_incr = FALSE; /* in case we got an error in t_end (e.g. GBLOFLOW), dont want this global variable to get
* carried over to the next non-TP transaction that this process does (e.g. inside an error trap).
*/
TREF(expand_prev_key) = FALSE; /* reset global (in case it is TRUE) so it does not get carried over to future operations */
if (dollar_tlevel)
{
for (si = first_sgm_info; si != NULL; si = si->next_sgm_info)
{
if (NULL != si->kip_csa)
{
csa = si->tp_csa;
assert(si->tp_csa == si->kip_csa);
PROBE_DECR_KIP(csa->hdr, csa, si->kip_csa);
}
}
} else if (NULL != kip_csa && (NULL != kip_csa->hdr) && (NULL != kip_csa->nl))
PROBE_DECR_KIP(kip_csa->hdr, kip_csa, kip_csa);
if (IS_DSE_IMAGE)
{ /* Release crit on any region that was obtained for the current erroring DSE operation.
* Take care NOT to release crits obtained by a previous CRIT -SEIZE command.
*/
for (addr_ptr = get_next_gdr(NULL); addr_ptr; addr_ptr = get_next_gdr(addr_ptr))
{
for (reg = addr_ptr->regions, r_top = reg + addr_ptr->n_regions; reg < r_top; reg++)
{
if (reg->open && !reg->was_open)
{
csa = &FILE_INFO(reg)->s_addrs;
assert(csa->hold_onto_crit || !csa->dse_crit_seize_done);
assert(!csa->hold_onto_crit || csa->now_crit);
if (csa->now_crit && (!csa->hold_onto_crit || !csa->dse_crit_seize_done))
{
rel_crit(reg);
csa->hold_onto_crit = FALSE;
t_abort(reg, csa); /* cancel mini-transaction if any in progress */
}
}
}
}
}
}
void op_fnzdate(mval *src, mval *fmt, mval *mo_str, mval *day_str, mval *dst)
{
unsigned char ch, *fmtptr, *fmttop, *i, *outptr, *outtop, *outpt1;
int cent, day, dow, month, nlen, outlen, time, year;
unsigned int n;
mval temp_mval;
static readonly unsigned char montab[] = {31,28,31,30,31,30,31,31,30,31,30,31};
static readonly unsigned char default1[] = DEFAULT1;
static readonly unsigned char default2[] = DEFAULT2;
static readonly unsigned char default3[] = DEFAULT3;
static readonly unsigned char defmonlst[] = "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC";
static readonly unsigned char defdaylst[] = "SUNMONTUEWEDTHUFRISAT";
#if defined(BIGENDIAN)
static readonly int comma = (((int)',') << 24);
#else
static readonly int comma = ',';
#endif
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
MV_FORCE_NUM(src);
MV_FORCE_STR(fmt);
MV_FORCE_STR(mo_str);
MV_FORCE_STR(day_str);
ENSURE_STP_FREE_SPACE(ZDATE_MAX_LEN);
time = 0;
outlen = src->str.len;
if ((src->mvtype & MV_STR) && (src->mvtype & MV_NUM_APPROX))
{
for (outptr = (unsigned char *)src->str.addr, outtop = outptr + outlen; outptr < outtop; )
{
if (',' == *outptr++)
{
outlen = outptr - (unsigned char *)src->str.addr - 1;
temp_mval.mvtype = MV_STR;
temp_mval.str.addr = (char *)outptr;
temp_mval.str.len = INTCAST(outtop - outptr);
s2n(&temp_mval);
time = MV_FORCE_INTD(&temp_mval);
if ((0 > time) || (MAX_TIME < time))
rts_error(VARLSTCNT(4) ERR_ZDATEBADTIME, 2, temp_mval.str.len, temp_mval.str.addr);
break;
}
}
}
day = (int)MV_FORCE_INTD(src);
if ((MAX_DATE < day) || (MIN_DATE > day))
{
MV_FORCE_STR(src);
rts_error(VARLSTCNT(4) ERR_ZDATEBADDATE, 2, outlen, src->str.addr);
}
day += DAYS_MOST_YEARS;
dow = ((day + ADJUST_TO_1900) % DAYS_IN_WEEK) + 1;
for (cent = DAYS_BASE_TO_1900, n = ADJUST_TO_1900; cent < day; cent += DAYS_IN_CENTURY, n++)
day += (0 < (n % COMMON_LEAP_CYCLE));
year = day / DAYS_IN_FOUR_YEARS;
day = day - (year * DAYS_IN_FOUR_YEARS);
year = (year * COMMON_LEAP_CYCLE) + BASE_YEAR;
if (DAYS_BEFORE_LEAP == day)
{
day = MIN_DAYS_IN_MONTH + 1;
month = 2;
} else
{
if (DAYS_BEFORE_LEAP < day)
day--;
month = day / DAYS_MOST_YEARS;
year += month;
day -= (month * DAYS_MOST_YEARS);
for (i = montab; day >= *i; day -= *i++)
;
month = (int)((i - montab)) + 1;
day++;
assert((0 < month) && (MONTHS_IN_YEAR >= month));
}
if ((0 == fmt->str.len) || ((1 == fmt->str.len) && ('1' == *fmt->str.addr)))
{
if (!TREF(zdate_form) || ((1 == TREF(zdate_form)) && (PIVOT_MILLENIUM > year)))
{
fmtptr = default1;
fmttop = fmtptr + STR_LIT_LEN(DEFAULT1);
} else
{
fmtptr = default3;
fmttop = fmtptr + STR_LIT_LEN(DEFAULT3);
}
} else if ((1 == fmt->str.len) && ('2' == *fmt->str.addr))
{
fmtptr = default2;
fmttop = fmtptr + STR_LIT_LEN(DEFAULT2);
} else
{
fmtptr = (unsigned char *)fmt->str.addr;
fmttop = fmtptr + fmt->str.len;
}
outlen = (int)(fmttop - fmtptr);
if (outlen >= ZDATE_MAX_LEN)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
outptr = stringpool.free;
outtop = outptr + ZDATE_MAX_LEN;
temp_mval.mvtype = MV_STR;
assert(0 <= time);
nlen = 0;
while (fmtptr < fmttop)
{
switch (ch = *fmtptr++) /* NOTE assignment */
{
case '/':
case ':':
case '.':
case ',':
case '-':
case ' ':
case '*':
case '+':
case ';':
*outptr++ = ch;
continue;
case 'M':
ch = *fmtptr++;
if ('M' == ch)
{
n = month;
nlen = 2;
break;
}
if (('O' != ch) || ('N' != *fmtptr++))
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
if (0 == mo_str->str.len)
{
temp_mval.str.addr = (char *)&defmonlst[(month - 1) * LEN_OF_3_CHAR_ABBREV];
temp_mval.str.len = LEN_OF_3_CHAR_ABBREV;
nlen = -LEN_OF_3_CHAR_ABBREV;
} else
{
UNICODE_ONLY(gtm_utf8_mode ? op_fnp1(mo_str, comma, month, &temp_mval) :
op_fnzp1(mo_str, comma, month, &temp_mval));
VMS_ONLY(op_fnzp1(mo_str, comma, month, &temp_mval, TRUE));
nlen = -temp_mval.str.len;
outlen += - LEN_OF_3_CHAR_ABBREV - nlen;
if (outlen >= ZDATE_MAX_LEN)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
}
break;
case 'D':
ch = *fmtptr++;
if ('D' == ch)
{
n = day;
nlen = 2;
break;
}
if (('A' != ch) || ('Y' != *fmtptr++))
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
if (0 == day_str->str.len)
{
temp_mval.str.addr = (char *)&defdaylst[(dow - 1) * LEN_OF_3_CHAR_ABBREV];
temp_mval.str.len = LEN_OF_3_CHAR_ABBREV;
nlen = -LEN_OF_3_CHAR_ABBREV;
} else
{
UNICODE_ONLY(gtm_utf8_mode ? op_fnp1(day_str, comma, dow, &temp_mval)
: op_fnzp1(day_str, comma, dow, &temp_mval));
VMS_ONLY(op_fnzp1(day_str, comma, dow, &temp_mval, TRUE));
nlen = -temp_mval.str.len;
outlen += - LEN_OF_3_CHAR_ABBREV - nlen;
if (outlen >= ZDATE_MAX_LEN)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
}
break;
case 'Y':
ch = *fmtptr++;
n = year;
if ('Y' == ch)
{
for (nlen = 2; (MAX_YEAR_DIGITS >=nlen) && fmtptr < fmttop; ++nlen, fmtptr++)
if ('Y' != *fmtptr)
break;
} else
{
if (('E' != ch) || ('A' != *fmtptr++) || ('R' != *fmtptr++))
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
nlen = 4;
}
break;
case '1':
if ('2' != *fmtptr++)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
nlen = 2;
n = time / SECONDS_PER_HOUR;
n = ((n + HOURS_PER_AM_OR_PM - 1) % HOURS_PER_AM_OR_PM) + 1;
break;
case '2':
if ('4' != *fmtptr++)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
nlen = 2;
n = time / SECONDS_PER_HOUR;
break;
case '6':
if ('0' != *fmtptr++)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
nlen = 2;
n = time;
n /= MINUTES_PER_HOUR;
n %= MINUTES_PER_HOUR;
break;
case 'S':
if ('S' != *fmtptr++)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
nlen = 2;
n = time % SECONDS_PER_MINUTE;
break;
case 'A':
if ('M' != *fmtptr++)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
*outptr++ = (time < (HOURS_PER_AM_OR_PM * SECONDS_PER_HOUR)) ? 'A' : 'P';
*outptr++ = 'M';
continue;
default:
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
}
if (nlen > 0)
{
outptr += nlen;
outpt1 = outptr;
while (nlen-- > 0)
{
*--outpt1 = '0' + (n % 10);
n /= 10;
}
} else
{
outpt1 = (unsigned char *)temp_mval.str.addr;
while (nlen++ < 0)
*outptr++ = *outpt1++;
}
}
if (fmtptr > fmttop)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
dst->mvtype = MV_STR;
dst->str.addr = (char *)stringpool.free;
dst->str.len = INTCAST((char *)outptr - dst->str.addr);
stringpool.free = outptr;
return;
}
void gtcmd_rundown(connection_struct *cnx, bool clean_exit)
{
int4 link;
cm_region_list *ptr, *last, *que_next, *que_last;
cm_region_head *region;
uint4 jnl_status;
jnl_private_control *jpc;
jnl_buffer_ptr_t jbp;
int refcnt;
boolean_t was_crit;
int4 rundown_status = EXIT_NRM; /* if gds_rundown went smoothly */
for (ptr = cnx->region_root; ptr;)
{
region = ptr->reghead;
TP_CHANGE_REG(region->reg);
jpc = cs_addrs->jnl;
if (ptr->pini_addr && clean_exit && JNL_ENABLED(cs_data) && (NOJNL != jpc->channel))
{
was_crit = cs_addrs->now_crit;
if (!was_crit)
grab_crit(gv_cur_region);
if (JNL_ENABLED(cs_data))
{
jpc->pini_addr = ptr->pini_addr;
SET_GBL_JREC_TIME; /* jnl_ensure_open/jnl_put_jrt_pfin needs this to be set */
jbp = jpc->jnl_buff;
/* Before writing to jnlfile, adjust jgbl.gbl_jrec_time if needed to maintain time order
* of jnl records. This needs to be done BEFORE the jnl_ensure_open as that could write
* journal records (if it decides to switch to a new journal file).
*/
ADJUST_GBL_JREC_TIME(jgbl, jbp);
jnl_status = jnl_ensure_open();
if (0 == jnl_status)
{
if (0 != jpc->pini_addr)
jnl_put_jrt_pfin(cs_addrs);
} else
send_msg(VARLSTCNT(6) jnl_status, 4, JNL_LEN_STR(cs_data), DB_LEN_STR(gv_cur_region));
}
if (!was_crit)
rel_crit(gv_cur_region);
}
refcnt = --region->refcnt;
/* Dont know how refcnt can become negative but in pro handle it by bypassing this region. The reason is the
* following. refcnt should have originally been a positive value. Every time this function is invoked, it would
* be decremented by one. There should have been one invocation that saw refcnt to be zero. That would have
* done the rundown of the region or if it is still in the stack the rundown is still in progress. Therefore
* it is not a good idea to try running down this region when we see refcnt to be negative (as otherwise we
* will get confused and could potentially end up with SIG-11 or ACCVIO errors). The worst case is that we
* would not have rundown the region in which case an externally issued MUPIP RUNDOWN would be enough.
*/
assert(0 <= refcnt);
if (0 == refcnt)
{ /* free up only as little as needed to facilitate structure reuse when the region is opened again */
assert(region->head.fl == region->head.bl);
VMS_ONLY(gtcm_ast_avail++);
if (JNL_ALLOWED(cs_data))
jpc->pini_addr = 0;
UNIX_ONLY(rundown_status |=) gds_rundown();
gd_ht_kill(region->reg_hash, TRUE); /* TRUE to free up the table and the gv_targets it holds too */
FREE_CSA_DIR_TREE(cs_addrs);
cm_del_gdr_ptr(gv_cur_region);
}
que_next = (cm_region_list *)((unsigned char *)ptr + ptr->regque.fl);
que_last = (cm_region_list *)((unsigned char *)ptr + ptr->regque.bl);
link = (int4)((unsigned char *)que_next - (unsigned char *)que_last);
que_last->regque.fl = link;
que_next->regque.bl = -link;
last = ptr;
ptr = ptr->next;
free(last);
}
