freem/src/xecline.c - diff

Return to xecline.c CVS log

Up to [Coherent Logic Development] / freem / src

Diff for /freem/src/xecline.c between versions 1.6 and 1.31

version 1.6, 2025/03/22 21:44:32	version 1.31, 2025/05/20 18:07:41
Line 24	Line 24
* along with FreeM. If not, see <https://www.gnu.org/licenses/>.	* along with FreeM. If not, see <https://www.gnu.org/licenses/>.
*	*
* $Log$	* $Log$
	* Revision 1.31 2025/05/20 18:07:41 snw
	* Add completion to debugger
	*
	* Revision 1.30 2025/05/20 16:20:42 snw
	* Update ROUTINE SSVN after ZEDIT and ZSAVE
	*
	* Revision 1.29 2025/05/20 14:56:56 snw
	* Fix direct-mode interface to online help
	*
	* Revision 1.28 2025/05/20 14:36:06 snw
	* Documentation updates; raise ZCMMND instead of NOSTAND for restricted_mode restrictions
	*
	* Revision 1.27 2025/05/19 21:29:29 snw
	* Add basic tab completion to direct mode
	*
	* Revision 1.26 2025/05/19 02:03:31 snw
	* Reverse-engineer and document argumented ZPRINT (thanks to D. Wicksell)
	*
	* Revision 1.25 2025/05/18 18:15:38 snw
	* Add ZEDIT command for editing routines
	*
	* Revision 1.24 2025/05/14 12:22:04 snw
	* Further work on shared memory
	*
	* Revision 1.23 2025/05/06 16:10:06 snw
	* Add extra blank before readline call on NetBSD
	*
	* Revision 1.22 2025/05/05 14:53:17 snw
	* Modify rpm spec to include documentation TODO
	*
	* Revision 1.21 2025/05/01 17:02:30 snw
	* Further debugging improvements
	*
	* Revision 1.20 2025/04/30 17:19:16 snw
	* Improve backtraces in debugger
	*
	* Revision 1.19 2025/04/30 14:41:03 snw
	* Further debugger work
	*
	* Revision 1.18 2025/04/29 18:46:17 snw
	* Begin work on interactive debugger
	*
	* Revision 1.17 2025/04/28 19:38:55 snw
	* Add trace mode
	*
	* Revision 1.16 2025/04/28 14:52:54 snw
	* Temporarily revert global handler refactor and fix reference regression in xecline
	*
	* Revision 1.15 2025/04/15 16:49:36 snw
	* Make use of logprintf throughout codebase
	*
	* Revision 1.14 2025/04/13 04:22:43 snw
	* Fix snprintf calls
	*
	* Revision 1.13 2025/04/10 01:24:39 snw
	* Remove C++ style comments
	*
	* Revision 1.12 2025/04/09 19:52:02 snw
	* Eliminate as many warnings as possible while building with -Wall
	*
	* Revision 1.11 2025/04/02 03:02:42 snw
	* Stop requiring users to pass -e to fmadm when -u or -g are passed
	*
	* Revision 1.10 2025/03/27 03:27:35 snw
	* Install init scripts to share/freem/examples/init and fix regression in method dispatch
	*
	* Revision 1.9 2025/03/24 04:13:12 snw
	* Replace action macro dat with fra_dat to avoid symbol conflict on OS/2
	*
	* Revision 1.8 2025/03/24 04:05:36 snw
	* Replace crlf with frm_crlf to avoid symbol conflict with readline on OS/2
	*
	* Revision 1.7 2025/03/22 22:52:24 snw
	* Add STRLEN_GBL macro to manage global string length
	*
* Revision 1.6 2025/03/22 21:44:32 snw	* Revision 1.6 2025/03/22 21:44:32 snw
* Make the startup messages fewer and add environment name to direct-mode prompt	* Make the startup messages fewer and add environment name to direct-mode prompt
*	*
Line 123 void rbuf_dump(void);	Line 198 void rbuf_dump(void);
short rbuf_slot_from_name(char *);	short rbuf_slot_from_name(char *);
short is_standard(void);	short is_standard(void);

	#ifdef HAVE_LIBREADLINE
	char *m_commands[] = {
	"?",
	"@",
	"!<",
	"!>",
	"!!",
	"ablock",
	"astart",
	"astop",
	"aunblock",
	"break",
	"close",
	"do",
	"else",
	"events",
	"for",
	"goto",
	"halt",
	"hang",
	"history",
	"if",
	"job",
	"jobtab",
	"kill",
	"ksubscripts",
	"kvalue",
	"lock",
	"locktab",
	"merge",
	"new",
	"open",
	"quit",
	"rbuf",
	"rcl",
	"read",
	"set",
	"shmpages",
	"shmstat",
	"tcommit",
	"then",
	"trantab",
	"trollback",
	"tstart",
	"use",
	"view",
	"wh",
	"write",
	"xecute",
	"zassert",
	"zbreak",
	"zconst",
	"zedit",
	"zgoto",
	"zhalt",
	"zinsert",
	"zjob",
	"zload",
	"zmap",
	"znew",
	"zprint",
	"zquit",
	"zremove",
	"zsave",
	"zthrow",
	"ztrap",
	"zunmap",
	"zwatch",
	"zwith",
	"zwrite",
	"ABLOCK",
	"ASTART",
	"ASTOP",
	"AUNBLOCK",
	"BREAK",
	"CLOSE",
	"DO",
	"ELSE",
	"FOR",
	"GOTO",
	"HALT",
	"HANG",
	"IF",
	"JOB",
	"KILL",
	"KSUBSCRIPTS",
	"KVALUE",
	"LOCK",
	"MERGE",
	"NEW",
	"OPEN",
	"QUIT",
	"READ",
	"SET",
	"TCOMMIT",
	"THEN",
	"TROLLBACK",
	"TSTART",
	"USE",
	"VIEW",
	"WRITE",
	"XECUTE",
	"ZASSERT",
	"ZBREAK",
	"ZCONST",
	"ZEDIT",
	"ZGOTO",
	"ZHALT",
	"ZINSERT",
	"ZJOB",
	"ZLOAD",
	"ZMAP",
	"ZNEW",
	"ZPRINT",
	"ZQUIT",
	"ZREMOVE",
	"ZSAVE",
	"ZTHROW",
	"ZTRAP",
	"ZUNMAP",
	"ZWATCH",
	"ZWITH",
	"ZWRITE",
	NULL
	};

	char *command_completion(const char , int, int);
	char command_generator(const char , int);

	char *command_completion(const char text, int start, int end)
	{
	if (start > 0) return NULL;
	rl_attempted_completion_over = 1;
	return rl_completion_matches (text, command_generator);
	}

	char command_generator(const char text, int state)
	{
	static int list_index, len;
	char *name;

	if (!state) {
	list_index = 0;
	len = strlen (text);
	}

	while ((name = m_commands[list_index++])) {
	if (strncmp (name, text, len) == 0) {
	return strdup (name);
	}
	}

	return NULL;
	}
	#endif

/*	/*
* xecline():	* xecline():
* typ (where to go on function entry): 1 = restart	* typ (where to go on function entry): 1 = restart
Line 135 int xecline(int typ)	Line 366 int xecline(int typ)
short new_and_set = FALSE;	short new_and_set = FALSE;
short new_object = FALSE;	short new_object = FALSE;
short destructor_run = FALSE;	short destructor_run = FALSE;
short debug_mode = FALSE;
short libcall = FALSE;	short libcall = FALSE;
char *namold;	char *namold;
long rouoldc;	long rouoldc;
unsigned long jobtime;	unsigned long jobtime;
char label[256], routine[256];	char label[256], routine[256];

	char tracestr[512];

char *vn;	char *vn;
char *an;	char *an;
char *tmp;	char *tmp;
Line 156 int xecline(int typ)	Line 388 int xecline(int typ)

char *reeval_codptr;	char *reeval_codptr;
char reeval_code[512];	char reeval_code[512];
	char entryref[256];

int i;	int i;
int j;	int j;
Line 205 int xecline(int typ)	Line 438 int xecline(int typ)

next_line: /* entry point for next command line */	next_line: /* entry point for next command line */

	if (debug_mode) {
	debug_mode = debugger (DEBENTRY_LINE, entryref);
	}

job_set_status (pid, JSTAT_INTERPRETER);	job_set_status (pid, JSTAT_INTERPRETER);

if (then_ctr > 0) {	if (then_ctr > 0) {
Line 253 next_line: /* entry point for n	Line 489 next_line: /* entry point for n
codptr = code;	codptr = code;

next_cmnd: /* continue line entry point */	next_cmnd: /* continue line entry point */
	getraddress (entryref, nstx);
	if (debug_mode) {
	debug_mode = debugger (DEBENTRY_CMD, entryref);
	}

if (sigint_in_for) goto for_quit;	if (sigint_in_for) goto for_quit;

if (forsw && (forpost[forx][0] != '\0')) {	if (forsw && (forpost[forx][0] != '\0')) {
Line 473 next0:	Line 714 next0:
if (ch == '!') { /* UNIXCALL */	if (ch == '!') { /* UNIXCALL */

if (restricted_mode) {	if (restricted_mode) {
merr_raise (NOSTAND);	merr_raise (CMMND);
goto err;	goto err;
}	}

Line 510 next0:	Line 751 next0:
else if (tmp2[0] == '<') { /* call write output to %-array */	else if (tmp2[0] == '<') { /* call write output to %-array */

FILE *pipdes;	FILE *pipdes;
char key[STRLEN + 1 /was 256 / ];	char key[STRLEN];
char data[STRLEN + 1 /was 256 / ];	char data[STRLEN];
char data_kill[256];	char data_kill[256];
data_kill[255] = EOL;	data_kill[255] = EOL;

for (i = 0; i < STRLEN + 1; i++) vn[i] = EOL;	for (i = 0; i < STRLEN - 1; i++) vn[i] = EOL;

snprintf (key, 255, "^$JOB\202%d\202PIPE_GLVN\201", pid);	snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid);
ssvn (get_sym, key, vn);	ssvn (get_sym, key, vn);

if (vn[0] == '^') {	if (vn[0] == '^') {
Line 535 next0:	Line 776 next0:
symtab (kill_sym, vn, data);	symtab (kill_sym, vn, data);
}	}

snprintf (key, 255, "^$JOB\202%d\202PIPE_GLVN\201", pid);	snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid);
ssvn (get_sym, key, vn);	ssvn (get_sym, key, vn);

data[0] = '0';	data[0] = '0';
Line 564 next0:	Line 805 next0:
int glvn_len = 0;	int glvn_len = 0;

while (fgets (data, STRLEN, pipdes)) {	while (fgets (data, STRLEN, pipdes)) {
snprintf (key, 255, "^$JOB\202%d\202PIPE_GLVN\201", pid);	snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid);
ssvn (get_sym, key, vn);	ssvn (get_sym, key, vn);

glvn_len = stlen (vn);	glvn_len = stlen (vn);
Line 625 next0:	Line 866 next0:

for (i = 0; i < STRLEN + 1; i++) vn[i] = EOL;	for (i = 0; i < STRLEN + 1; i++) vn[i] = EOL;

snprintf (key, 255, "^$JOB\202%d\202PIPE_GLVN\201", pid);	snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid);
ssvn (get_sym, key, vn);	ssvn (get_sym, key, vn);

if (vn[0] == '^') {	if (vn[0] == '^') {
Line 654 next0:	Line 895 next0:
int glvn_len = 0;	int glvn_len = 0;

for (i = 1; i <= k; i++) {	for (i = 1; i <= k; i++) {
snprintf (key, 255, "^$JOB\202%d\202PIPE_GLVN\201", pid);	snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid);
ssvn (get_sym, key, vn);	ssvn (get_sym, key, vn);

glvn_len = stlen (vn);	glvn_len = stlen (vn);
Line 824 again:	Line 1065 again:
}	}
}	}

	if (trace_mode) tracestr[0] = '\0';

switch (mcmnd) {	switch (mcmnd) {

case MAP:	case MAP:
Line 889 set0:	Line 1132 set0:

if (isalpha (vn[0]) && *(codptr + 1) == ':') {	if (isalpha (vn[0]) && *(codptr + 1) == ':') {
char sc_string[255];	char sc_string[255];
register int sci;

codptr += 2;	codptr += 2;
expr (NAME);	expr (NAME);

Line 926 set0:	Line 1168 set0:

if (*++codptr != '=') {	if (*++codptr != '=') {

/* SET A++ or SET A-- equivalent to SET A+=1 SET A-=1 currently disabled */	/* unary ++/-- */
//#ifdef NEVER
if ((ch == '+' \|\| ch == '-') && ch == *codptr) {	if ((ch == '+' \|\| ch == '-') && ch == *codptr) {
codptr++;	codptr++;
setop = ch;	setop = ch;
Line 936 set0:	Line 1177 set0:

goto set2;	goto set2;
}	}
//#endif /* NEVER */

merr_raise (ASSIGNER);	merr_raise (ASSIGNER);
break;	break;
Line 949 set0:	Line 1189 set0:

ch = *codptr;	ch = *codptr;

if (ch == '.') {	if (ch == '.') {
setref = TRUE;	if (!isdigit (*(codptr + 1))) {
codptr++;	setref = TRUE;
expr (NAME);	codptr++;
	expr (NAME);
	}
	else {
	expr (STRING);
	}
}	}
else {	else {
expr (STRING);	expr (STRING);
Line 1022 set2:	Line 1267 set2:

if (new_and_set == TRUE) new_and_set = FALSE;	if (new_and_set == TRUE) new_and_set = FALSE;
if (new_object == TRUE) new_object = FALSE;	if (new_object == TRUE) new_object = FALSE;
	/*
set1:	set1:
	*/
if (*codptr != ',') break;	if (*codptr != ',') break;

if (*++codptr == '@') goto again;	if (*++codptr == '@') goto again;
Line 1074 set:	Line 1321 set:
goto err;	goto err;
}	}

expr (STRING);	expr (STRING);

if (merr () > OK) goto err;	if (merr () > OK) goto err;

stcpy (tmp2, argptr);	stcpy (tmp2, argptr);
Line 1586 set10:	Line 1833 set10:
}	}

if (stcat (tmp2, &tmp3[arg4]) == 0) {	if (stcat (tmp2, &tmp3[arg4]) == 0) {
merr_raise (M56); //JPW	merr_raise (M56); /* snw */
goto err;	goto err;
}	}

Line 2333 s_end:	Line 2580 s_end:

case QUIT:	case QUIT:

	if (trace_mode) {
	fprintf (stderr, ">> TRACE: $STACK = %d QUIT CMD = %c\r\n", nstx, nestc[nstx]);
	}

if (tp_level > 0) {	if (tp_level > 0) {
merr_raise (M42);	merr_raise (M42);
goto err;	goto err;
Line 2362 s_end:	Line 2613 s_end:
if (nestc[nstx] == '$') { /* extrinsic function/variable */	if (nestc[nstx] == '$') { /* extrinsic function/variable */


	if (trace_mode) {
	fprintf (stderr, ">> TRACE: QUIT FROM EXTRINSIC\r\n");
	}

#ifdef DEBUG_NEWSTACK	#ifdef DEBUG_NEWSTACK
printf ("EXTRINSIC\r\n");	printf ("EXTRINSIC\r\n");
#endif	#endif
//printf (" extr_types[%d] = '%d'\r\n", nstx, extr_types[nstx]);
if (codptr == EOL \|\| codptr == SP) {	if (codptr == EOL \|\| codptr == SP) {

#ifdef DEBUG_NEWSTACK	#ifdef DEBUG_NEWSTACK
Line 2392 s_end:	Line 2646 s_end:
else {	else {

expr (STRING);	expr (STRING);

	if (trace_mode) {
	fprintf (stderr, ">> TRACE: QUIT FROM SUBROUTINE\r\n");
	}

if (ierr != OK - CTRLB && merr () != OK && merr () != INRPT) {	if (ierr != OK - CTRLB && merr () != OK && merr () != INRPT) {

Line 2558 quit0:	Line 2816 quit0:
printf ("CHECK 03 (Stack PUSH)\r\n");	printf ("CHECK 03 (Stack PUSH)\r\n");
#endif	#endif


if (++nstx > NESTLEVLS) {	if (++nstx > NESTLEVLS) {
nstx--;	nstx--;
merr_raise (STKOV);	merr_raise (STKOV);
Line 2584 quit0:	Line 2841 quit0:
nestn[nstx] = 0; /* no overring of routine */	nestn[nstx] = 0; /* no overring of routine */
nestr[nstx] = roucur - rouptr; /* save roucur: only for $V(26) needed */	nestr[nstx] = roucur - rouptr; /* save roucur: only for $V(26) needed */
ztrap[nstx][0] = EOL;	ztrap[nstx][0] = EOL;


forsw = TRUE;	forsw = TRUE;
ftyp = 0; /* no args is FOREVER */	ftyp = 0; /* no args is FOREVER */
Line 3028 do_xecute:	Line 3285 do_xecute:

do_goto:	do_goto:

	if (trace_mode) {
	char rn[256];
	stcpy (rn, rou_name);
	stcnv_m2c (rn);

	switch (mcmnd) {
	case DO:
	snprintf (tracestr, sizeof (tracestr) - 1, "rtn = %s $stack = %d do ", rn, nstx);
	break;
	case GOTO:
	snprintf (tracestr, sizeof (tracestr) - 1, "rtn = %s $stack = %d goto ", rn, nstx);
	break;
	}
	}

offset = 0;	offset = 0;
label[0] = routine[0] = EOL;	label[0] = routine[0] = EOL;
dofram0 = 0;	dofram0 = 0;
Line 3062 do_goto:	Line 3334 do_goto:

stcpy (label, varnam);	stcpy (label, varnam);

	if (trace_mode) {
	char ttt[256];
	stcpy (ttt, label);
	stcnv_m2c (ttt);

	strcat (tracestr, ttt);
	}

ch = *++codptr;	ch = *++codptr;
}	}

Line 3077 do_goto:	Line 3357 do_goto:

/* unless argument is numeric, expr returns wrong codptr */	/* unless argument is numeric, expr returns wrong codptr */
if ((ch = codptr) != SP && (ch != EOL) && (ch != ',') && (ch != '^')) ch = ++codptr;	if ((ch = codptr) != SP && (ch != EOL) && (ch != ',') && (ch != '^')) ch = ++codptr;

	if (trace_mode) {
	char ttt[256];
	snprintf (ttt, 255, "+%d", offset);
	strcat (tracestr, ttt);
	}
}	}

if (ch == '^') { /* parse routine */	if (ch == '^') { /* parse routine */
Line 3087 do_goto:	Line 3372 do_goto:
if (merr () > OK) goto err;	if (merr () > OK) goto err;

stcpy (routine, varnam);	stcpy (routine, varnam);

	if (trace_mode) {
	char ttt[256];
	char ttx[256];

	stcpy (ttt, routine);
	stcnv_m2c (ttt);
	snprintf (ttx, 255, "^%s", ttt);
	strcat (tracestr, ttx);
	}

dosave[0] = EOL;	dosave[0] = EOL;
ch = *++codptr;	ch = *++codptr;
loadsw = TRUE;	loadsw = TRUE;
}	}

	if (trace_mode) {
	fprintf (stderr, ">> TRACE: %s\r\n", tracestr);
	}

if (ch == '(' && mcmnd == DO) { /* parse parameter */	if (ch == '(' && mcmnd == DO) { /* parse parameter */

if (offset) {	if (offset) {
Line 3751 off3:	Line 4050 off3:
break;	break;

case KILL:	case KILL:

/* argumentless: KILL all local variables */	/* argumentless: KILL all local variables */
if (((ch = *codptr) == SP) \|\| ch == EOL) {	if (((ch = *codptr) == SP) \|\| ch == EOL) {
symtab (kill_all, "", "");	symtab (kill_all, "", "");
Line 3785 off3:	Line 4084 off3:
if (destructor_ct) {	if (destructor_ct) {

for (cd = 0; cd < destructor_ct; cd++) {	for (cd = 0; cd < destructor_ct; cd++) {
strcat (destc, destructors[cd]);	if (strlen (destructors[cd]) > 0) {
strcat (destc, ",");	strcat (destc, destructors[cd]);
	strcat (destc, ",");
	}
}	}

destructor_ct = 0;	destructor_ct = 0;
Line 3934 off3:	Line 4235 off3:

stcpy (objvar, vn);	stcpy (objvar, vn);

symtab (dat, objvar, datres);	symtab (fra_dat, objvar, datres);
dat_res = atoi (datres);	dat_res = atoi (datres);

if (dat_res > 0) {	if (dat_res > 0) {
Line 3968 off3:	Line 4269 off3:

if (merr () > OK) goto err;	if (merr () > OK) goto err;

	/* TODO: check this snprintf for proper sizing */
snprintf (&tmp3[1], 255, "%s\201", &constructor[1]);	snprintf (&tmp3[1], 255, "%s\201", &constructor[1]);
goto private;	goto private;

Line 3988 off3:	Line 4290 off3:
goto set2;	goto set2;
}	}

	/*
post_new:	post_new:
	*/
ch = nstx;	ch = nstx;

while (nestc[ch] == FOR) ch--; /* FOR does not define a NEW level */	while (nestc[ch] == FOR) ch--; /* FOR does not define a NEW level */
Line 4318 use0: /* entry point for proces	Line 4621 use0: /* entry point for proces
break;	break;

case 2:	case 2:
crlf[io] = tvexpr (argptr);	frm_crlf[io] = tvexpr (argptr);
break;	break;

case 3:	case 3:
Line 4414 use_socket:	Line 4717 use_socket:
if (k > MAXSEQ) goto open_socket;	if (k > MAXSEQ) goto open_socket;

if (restricted_mode) {	if (restricted_mode) {
merr_raise (NOSTAND);	merr_raise (CMMND);
goto err;	goto err;
}	}

/* need to evaluate the following 6 lines carefully - smw 2023-10-15 */	/* need to evaluate the following 6 lines carefully - smw 2023-10-15 */
if (k != HOME) {	if (k != HOME) {
crlf[k] = FALSE;	frm_crlf[k] = FALSE;
fm_nodelay[k] = FALSE;	fm_nodelay[k] = FALSE;
xpos[k] = 0;	xpos[k] = 0;
ypos[k] = 0;	ypos[k] = 0;
Line 4846 open_socket:	Line 5149 open_socket:
if (merr () > OK) break;	if (merr () > OK) break;
}	}
else {	else {
halt:i = 0;	halt:
	i = 0;
}	}

cleanup ();	cleanup ();
Line 5045 open_socket:	Line 5349 open_socket:
expr (STRING);	expr (STRING);
if (merr () > OK) break;	if (merr () > OK) break;

switch (intexpr (argptr)) {	{
	char brkstr[256];
case 2:
DSM2err = TRUE;	stcpy (brkstr, argptr);
break; /* enable DSM V 2 error processing */	stcnv_m2c (brkstr);

case -2:	if (strcmp (brkstr, "DEBUG") == 0) {
DSM2err = FALSE;	debug_mode = TRUE;
break; /* enable normal error processing */	}
	else {
case 0:	switch (intexpr (argptr)) {
breakon = FALSE;
break; /* disable CTRL/C */	case 2:
	DSM2err = TRUE;
default:	break; /* enable DSM V 2 error processing */
breakon = TRUE;
break; /* enable CTRL/C */	case -2:
	DSM2err = FALSE;
	break; /* enable normal error processing */

	case 0:
	breakon = FALSE;
	break; /* disable CTRL/C */

	default:
	breakon = TRUE;
	break; /* enable CTRL/C */
	}
	}
}	}

break;	break;

case VIEW:	case VIEW:
Line 5078 open_socket:	Line 5395 open_socket:
#endif	#endif

if (nestc[nstx] == BREAK) {	if (nestc[nstx] == BREAK) {
// printf ("nestc[nstx] was BREAK\r\n");
if (repQUIT) continue;	if (repQUIT) continue;
merr_raise (OK - CTRLB);	merr_raise (OK - CTRLB);

goto zgo; /cont. single step /	goto zgo; /cont. single step /
}	}
// else {
// printf ("nestc[nstx] was _not_ BREAK\r\n");
// }

if (nestc[nstx] == FOR) {	if (nestc[nstx] == FOR) {

Line 5156 open_socket:	Line 5469 open_socket:
break;	break;

/* Z-COMMANDS */	/* Z-COMMANDS */
	case ZEDIT:
	merr_raise (cmd_zedit (&ra));
	MRESCHECK(ra);
	break;

case ZGO:	case ZGO:

/* ZGO with arguments: same as GOTO but with BREAK on */	/* ZGO with arguments: same as GOTO but with BREAK on */
Line 5295 zgo:	Line 5613 zgo:
merr_raise (NOPGM);	merr_raise (NOPGM);

break;	break;
} /error /	} /* error */

stcpy (varnam, rou_name);	stcpy (varnam, rou_name);
}	}
Line 5313 zgo:	Line 5631 zgo:
}	}

zsave (varnam);	zsave (varnam);
	ssvn_routine_update ();
break;	break;


Line 5431 zgo:	Line 5750 zgo:
if (codptr == EOL \|\| codptr == SP) {	if (codptr == EOL \|\| codptr == SP) {
merr_raise (ARGLIST);	merr_raise (ARGLIST);
break;	break;
} /error /	} /* error */

dosave[0] = EOL;	dosave[0] = EOL;

/* parse stringlit */	/* parse strlit */
expr (STRING);	expr (STRING);

if (merr () > OK) break;	if (merr () > OK) break;
Line 5536 zgo:	Line 5855 zgo:

for (; beg < end; beg += UNSIGN (*beg) + 2) {	for (; beg < end; beg += UNSIGN (*beg) + 2) {

if (crlf[io]) {	if (frm_crlf[io]) {
write_m ("\012\201");	write_m ("\012\201");
}	}
else {	else {
Line 5544 zgo:	Line 5863 zgo:
}	}

if ((*(beg + 1)) == EOL) break;	if ((*(beg + 1)) == EOL) break;

write_m (beg + 1);	write_m (beg + 1);
if (merr () > OK) break;	if (merr () > OK) break;
}	}
Line 5552 zgo:	Line 5871 zgo:
rouins = beg;	rouins = beg;
}	}

if (crlf[io]) {	if (frm_crlf[io]) {
write_m ("\012\201");	write_m ("\012\201");
}	}
else {	else {
Line 5662 zgo:	Line 5981 zgo:
}	}

case ZWRITE:	case ZWRITE:


zwrite:
{	{
short k;	short k;
char w_tmp[512];	char w_tmp[512];
Line 5788 zwritep:	Line 6104 zwritep:

expr (NAME);	expr (NAME);

//if (varnam[0] == '^') merr_raise (GLOBER);
if (merr () > OK) goto err;	if (merr () > OK) goto err;

codptr++;	codptr++;
Line 5821 zwritep:	Line 6136 zwritep:
}	}

if (varnam[0] != '^') {	if (varnam[0] != '^') {
symtab (dat, varnam, tmp2);	symtab (fra_dat, varnam, tmp2);
zwmode = 'L';	zwmode = 'L';
}	}
else {	else {
if (varnam[1] == '$') {	if (varnam[1] == '$') {
ssvn (dat, varnam, tmp2);	ssvn (fra_dat, varnam, tmp2);
zwmode = '$';	zwmode = '$';
}	}
else {	else {
global (dat, varnam, tmp2);	global (fra_dat, varnam, tmp2);
zwmode = '^';	zwmode = '^';
}	}
}	}
Line 5941 zwritep:	Line 6256 zwritep:
switch (zwmode) {	switch (zwmode) {

case 'L':	case 'L':
symtab (dat, tmp, tmp3);	symtab (fra_dat, tmp, tmp3);
symtab (get_sym, tmp, &w_tmp[1]);	symtab (get_sym, tmp, &w_tmp[1]);

break;	break;


case '$':	case '$':
ssvn (dat, tmp, tmp3);	ssvn (fra_dat, tmp, tmp3);
ssvn (get_sym, tmp, &w_tmp[1]);	ssvn (get_sym, tmp, &w_tmp[1]);

break;	break;


case '^':	case '^':
global (dat, tmp, tmp3);	global (fra_dat, tmp, tmp3);
global (get_sym, tmp, &w_tmp[1]);	global (get_sym, tmp, &w_tmp[1]);

break;	break;
Line 6030 zwritep:	Line 6345 zwritep:
break;	break;


case ZALLOCATE:	/* user defined Z-COMMAND */

/* argumentless is not permitted */
if (codptr == SP \|\| codptr == EOL) {
merr_raise (ARGLIST);
break;
}

expr (NAME);

if (merr () > OK) goto err;

tmp[0] = SP;
stcpy (&tmp[1], varnam);
stcat (tmp, "\001\201");

frm_timeout = (-1L); /* no timeout */

if (*++codptr == ':') {
codptr++;

expr (STRING);

frm_timeout = intexpr (argptr);

if (merr () > OK) goto err;
if (frm_timeout < 0L) frm_timeout = 0L;
}

lock (tmp, frm_timeout, ZALLOCATE);
break;


case ZDEALLOCATE:

tmp[0] = SP;

if (codptr == SP \|\| codptr == EOL) {
tmp[1] = EOL;
}
else {
expr (NAME);

if (merr () > OK) goto err;

stcpy (&tmp[1], varnam);

codptr++;
}

lock (tmp, -1L, ZDEALLOCATE); /* -1: no timeout */
break;

/* user defined Z-COMMAND */


case PRIVATE:	case PRIVATE:

private: /* for in-MUMPS defined commands */	private: /* for in-MUMPS defined commands */
Line 6624 evthandler: /* for event hand	Line 6884 evthandler: /* for event hand


/* run the next iteration of GTK's event loop */	/* run the next iteration of GTK's event loop */
//TODO: replace with libXt event loop	/* TODO: replace with libXt event loop */
//gtk_main_iteration_do (TRUE);	/* gtk_main_iteration_do (TRUE); */

/* dequeue any events */	/* dequeue any events */
evt_count = mwapi_dequeue_events (syn_handlers);	evt_count = mwapi_dequeue_events (syn_handlers);

if (evt_count) {	if (evt_count) {
/* write them out */	/* write them out */
//printf ("event handlers = '%s'\r\n", syn_handlers);	/* printf ("event handlers = '%s'\r\n", syn_handlers); */

syn_event_entry_nstx = nstx;	syn_event_entry_nstx = nstx;

Line 6690 syn_evt_loop_bottom:	Line 6950 syn_evt_loop_bottom:
if (ch != ',' && merr () == OK) {	if (ch != ',' && merr () == OK) {
merr_raise (SPACER);	merr_raise (SPACER);
}	}
else if ((ierr <= OK) \|\| (debug_mode == TRUE)) {	else if (ierr <= OK) {
if (debug_mode) goto direct_mode;
if (++codptr != SP && codptr != EOL) goto again;	if (++codptr != SP && codptr != EOL) goto again;

merr_raise (ARGLIST);	merr_raise (ARGLIST);
Line 6733 err:	Line 6992 err:
}	}
}	}


if (merr () > OK ) {	if (merr () > OK ) {

char er_buf[ERRLEN];	char er_buf[ERRLEN];
Line 6742 err:	Line 7002 err:
stcpy (er_buf, errmes[merr ()]);	stcpy (er_buf, errmes[merr ()]);
stcnv_m2c (er_buf);	stcnv_m2c (er_buf);


#if !defined(MSDOS)	#if !defined(MSDOS)
m_log (LOG_ERR, er_buf);	logprintf (FM_LOG_DEBUG, "xecline: interpreter error %d [%s]", ierr, er_buf);
#endif	#endif

}	}
Line 7077 restart:	Line 7338 restart:

DSW &= ~BIT0; /* enable ECHO */	DSW &= ~BIT0; /* enable ECHO */

// print here	/* print here */
{	{
char *t_rtn;	char *t_rtn;
char t_nsn = (char ) malloc (STRLEN * sizeof (char));	char t_nsn = (char ) malloc (STRLEN * sizeof (char));
Line 7114 restart:	Line 7375 restart:


free (t_nsn);	free (t_nsn);

}	}


Line 7175 restore:	Line 7437 restore:

goto next_cmnd;	goto next_cmnd;
}	}
else {
if (debug_mode) goto direct_mode;
}

if (libcall == TRUE) { /* library mode: don't go to direct mode, just return */	if (libcall == TRUE) { /* library mode: don't go to direct mode, just return */
return merr ();	return merr ();
Line 7206 direct_mode:	Line 7465 direct_mode:
int hist_idx;	int hist_idx;
HIST_ENTRY *hist_ent;	HIST_ENTRY *hist_ent;

	rl_attempted_completion_function = command_completion;

if (quiet_mode == FALSE) {	if (quiet_mode == FALSE) {
if (tp_level == 0) {	if (tp_level == 0) {
snprintf (fmrl_prompt, 255, "\r\n%s.%s> ", shm_env, nsname);	snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1, "\r\n%s.%s> ", shm_env, nsname);
}	}
else {	else {
snprintf (fmrl_prompt, 255, "\r\nTL%d:%s.%s> ", tp_level, shm_env, nsname);	snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1 , "\r\nTL%d:%s.%s> ", tp_level, shm_env, nsname);
}	}
}	}
set_io (UNIX);	set_io (UNIX);

job_set_status (pid, JSTAT_DIRECTMODE);	job_set_status (pid, JSTAT_DIRECTMODE);

	#if defined(__NetBSD__)
	printf ("\r\n");
	#endif

/* readline() does its own malloc() */	/* readline() does its own malloc() */
fmrl_buf = readline (fmrl_prompt);	fmrl_buf = readline (fmrl_prompt);

Line 7228 direct_mode:	Line 7493 direct_mode:

goto halt;	goto halt;
}	}


if (strlen (fmrl_buf) > 0) {	if (strlen (fmrl_buf) > 0) {
add_history (fmrl_buf);	add_history (fmrl_buf);
Line 7236 direct_mode:	Line 7502 direct_mode:
if (fmrl_buf[0] == '?') {	if (fmrl_buf[0] == '?') {

char kb[20];	char kb[20];
char db[255];	char db[STRLEN];

snprintf (kb, 19, "%%SYS.HLP\201");	snprintf (kb, sizeof (kb) - 1, "%%SYSHLP\201");
snprintf (db, 19, "\201");	snprintf (db, STRLEN - 1, "\201");

symtab (kill_sym, kb, db);	symtab (kill_sym, kb, db);

Line 7249 direct_mode:	Line 7515 direct_mode:
stcpy (code, "DO ^%ZHELP\201");	stcpy (code, "DO ^%ZHELP\201");

if (strlen (fmrl_buf) > 1) {	if (strlen (fmrl_buf) > 1) {
snprintf (db, 254, "%s\201", &fmrl_buf[1]);	snprintf (db, STRLEN - 1, "%s\201", &fmrl_buf[1]);
symtab (set_sym, kb, db);	symtab (set_sym, kb, db);
}	}

}	}
else if (strcmp (fmrl_buf, "step") == 0) {
debug_mode = TRUE;
goto zgo;
}
else if ((strcmp (fmrl_buf, "cont") == 0) \|\| (strcmp (fmrl_buf, "continue") == 0)) {
debug_mode = FALSE;
}
else if (strcmp (fmrl_buf, "rbuf") == 0) {	else if (strcmp (fmrl_buf, "rbuf") == 0) {
rbuf_dump ();	rbuf_dump ();
}	}
Line 7318 direct_mode:	Line 7577 direct_mode:
}	}
else if (isdigit(fmrl_buf[0]) \|\| (fmrl_buf[0] == '(') \|\| (fmrl_buf[0] == '-') \|\| (fmrl_buf[0] == '\'') \|\| (fmrl_buf[0] == '+') \|\| (fmrl_buf[0] == '$') \|\| (fmrl_buf[0] == '^')) {	else if (isdigit(fmrl_buf[0]) \|\| (fmrl_buf[0] == '(') \|\| (fmrl_buf[0] == '-') \|\| (fmrl_buf[0] == '\'') \|\| (fmrl_buf[0] == '+') \|\| (fmrl_buf[0] == '$') \|\| (fmrl_buf[0] == '^')) {

snprintf (code, 255, "W %s", fmrl_buf);	snprintf (code, STRLEN - 1, "W %s", fmrl_buf);
stcnv_c2m (code);	stcnv_c2m (code);

set_io (MUMPS);	set_io (MUMPS);
Line 7400 direct_mode:	Line 7659 direct_mode:
char fmrl_prompt[256];	char fmrl_prompt[256];

if (tp_level == 0) {	if (tp_level == 0) {
snprintf (fmrl_prompt, 256, "\r\n%s> \201", nsname);	snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1, "\r\n%s> \201", nsname);
}	}
else {	else {
snprintf (fmrl_prompt, 256, "\r\nTL%d:%s> \201", tp_level, nsname);	snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1, "\r\nTL%d:%s> \201", tp_level, nsname);
}	}

write_m (fmrl_prompt);	write_m (fmrl_prompt);
Line 7415 direct_mode:	Line 7674 direct_mode:
#endif	#endif

if (merr () > OK) goto err;	if (merr () > OK) goto err;


// printf ("zbflag = %d\r\n", zbflag);

if (code[0] == EOL && zbflag && nestc[nstx] == BREAK) {	if (code[0] == EOL && zbflag && nestc[nstx] == BREAK) {

//printf ("cont single step\r\n");
debug_mode = TRUE;	debug_mode = TRUE;
merr_raise (OK - CTRLB);	merr_raise (OK - CTRLB);

//printf ("ierr now '%d'\r\n", ierr);
goto zgo;	goto zgo;
} /* single step */	} /* single step */
}	}
Line 7491 void rbuf_dump(void)	Line 7745 void rbuf_dump(void)

for (i = 0; i < NO_OF_RBUF; i++) {	for (i = 0; i < NO_OF_RBUF; i++) {

sprintf (flgs, "");	flgs[0] = '\0';

if (ages[i] == 0) {	if (ages[i] == 0) {
sprintf (rnam, "---------");	sprintf (rnam, "---------");

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.6
changed lines
	Added in v.1.31