freem/src/expr.c - diff

Return to expr.c CVS log

Up to [Coherent Logic Development] / freem / src

Diff for /freem/src/expr.c between versions 1.6 and 1.17

version 1.6, 2025/03/22 03:05:19	version 1.17, 2025/05/01 03:56:29
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.17 2025/05/01 03:56:29 snw
	* -m
	*
	* Revision 1.16 2025/04/30 20:03:09 snw
	* Work on entryref parser
	*
	* Revision 1.15 2025/04/30 14:41:03 snw
	* Further debugger work
	*
	* Revision 1.14 2025/04/14 23:20:23 snw
	* Restore support for any 8-bit character in
	*
	* Revision 1.13 2025/04/13 04:22:43 snw
	* Fix snprintf calls
	*
	* Revision 1.12 2025/04/10 01:24:38 snw
	* Remove C++ style comments
	*
	* Revision 1.11 2025/03/30 01:36:58 snw
	* Make it easier to bring back fma_gedit, fix double-free in global handler, limit $CHAR to 7-bit ASCII
	*
	* Revision 1.10 2025/03/24 04:13:11 snw
	* Replace action macro dat with fra_dat to avoid symbol conflict on OS/2
	*
	* Revision 1.9 2025/03/24 01:32:22 snw
	* Guard declaration of time function in expr.c for portability
	*
	* Revision 1.8 2025/03/22 04:47:18 snw
	* Silently truncate long names in STRING exprs when evaluates to an obsolete MDC standard
	*
	* Revision 1.7 2025/03/22 03:39:23 snw
	* Fix reverse query polyfill call-in from C side and make NAME exprs silently truncate long names in obsolete MDC dialects
	*
* Revision 1.6 2025/03/22 03:05:19 snw	* Revision 1.6 2025/03/22 03:05:19 snw
* Comply with X11-96/13 portable length of names	* Comply with X11-96/13 portable length of names
*	*
Line 132	Line 165
#define GET 'Y'	#define GET 'Y'
#define GETX ':'	#define GETX ':'

#if !defined(__OpenBSD__) && !defined(_AIX) && !defined(__osf__) && !defined(MSDOS) && !defined(__vax__)	#if !defined(__OpenBSD__) && !defined(_AIX) && !defined(__osf__) && !defined(MSDOS) && !defined(__vax__) && !defined(__OS2__)
long time ();	long time ();
#endif	#endif
void cond_round (char *a, int digits);	void cond_round (char *a, int digits);
Line 218 void expr (short extyp)	Line 251 void expr (short extyp)
varnam[i++] = ch;	varnam[i++] = ch;
}	}
else {	else {
merr_raise (M56);	if ((rtn_dialect () == D_M77) \|\|
return;	(rtn_dialect () == D_M84) \|\|
	(rtn_dialect () == D_M90) \|\|
	(rtn_dialect () == D_M95)) {
	/* silently truncate... yeah, the standard is stupid af */
	continue;
	}
	else {
	merr_raise (M56);
	return;
	}
}	}

}	}

varnam[i] = EOL;	varnam[i] = EOL;

	#if 0
	{
	char gooby[256];
	stcpy (gooby, varnam);
	stcnv_m2c (gooby);
	printf ("name = '%s'\r\n", gooby);
	}
	#endif

if (ch == '(') { /* it's an array */	if (ch == '(') { /* it's an array */

Line 345 scan_name:	Line 396 scan_name:
merr_raise (INVEXPR);	merr_raise (INVEXPR);
return;	return;
}	}

varnam[i++] = ch;	if ((i + 1) <= max_namlen) {
	varnam[i++] = ch;
	}
	else {
	if ((rtn_dialect () == D_M77) \|\|
	(rtn_dialect () == D_M84) \|\|
	(rtn_dialect () == D_M90) \|\|
	(rtn_dialect () == D_M95)) {
	/* silently truncate... yeah, the standard is stupid af */
	continue;
	}
	else {
	merr_raise (M56);
	return;
	}
	}

lastch = ch;	lastch = ch;
}	}
Line 362 scan_name:	Line 428 scan_name:
else { /* local variable name */	else { /* local variable name */

while (isalnum (ch = *++codptr)) {	while (isalnum (ch = *++codptr)) {
varnam[i++] = ch;
	if ((i + 1) <= max_namlen) {
	varnam[i++] = ch;
	}
	else {
	if ((rtn_dialect () == D_M77) \|\|
	(rtn_dialect () == D_M84) \|\|
	(rtn_dialect () == D_M90) \|\|
	(rtn_dialect () == D_M95)) {
	/* silently truncate... yeah, the standard is stupid af */
	continue;
	}
	else {
	merr_raise (M56);
	return;
	}
	}

}	}

varnam[i] = EOL;	varnam[i] = EOL;
Line 502 var1:	Line 585 var1:

case 'd': /* $DATA */	case 'd': /* $DATA */

ch = dat;	ch = fra_dat;

glv_fcn:	glv_fcn:

Line 704 d_o_n:	Line 787 d_o_n:

if (merr () == UNDEF) {	if (merr () == UNDEF) {

//smw 15 nov 2023 merr_raise (ierr < 0 ? OK - CTRLB : OK);	/* smw 15 nov 2023 merr_raise (ierr < 0 ? OK - CTRLB : OK); */
merr_clear ();	merr_clear ();

if (*++codptr == ',') {	if (*++codptr == ',') {
Line 889 undefglvn:	Line 972 undefglvn:
stcpy (refsav[refsx], zref);	stcpy (refsav[refsx], zref);
stcpy (refsav[refsx++] + 256, zloc);	stcpy (refsav[refsx++] + 256, zloc);

ierr -= M7; //smw TODO HUH??	ierr -= M7;
arg--;	arg--;

goto nextchr;	goto nextchr;
Line 1616 uparrow:	Line 1699 uparrow:

case 'c': /* $CHARACTER */	case 'c': /* $CHARACTER */

{	{
short l, l1, m, n;	short l, l1, m, n;

l1 = f;	l1 = f;
Line 1627 uparrow:	Line 1710 uparrow:
n = 1;	n = 1;
l = 0;	l = 0;


for (;;) {	for (;;) {

if ((ch = a[i++]) == EOL) {	if ((ch = a[i++]) == EOL) {
Line 2235 f20:	Line 2319 f20:
stcnv_c2m (qryarg_ext);	stcnv_c2m (qryarg_ext);

/* put the $QUERY argument into the local variable %INT.REVQ */	/* put the $QUERY argument into the local variable %INT.REVQ */
symtab (set_sym, "%INT.REVQ\201\201", qryarg_ext);	symtab (set_sym, "%INTREVQ\201\201", qryarg_ext);

/* set up for calling into polyfill wrapper */	/* set up for calling into polyfill wrapper */
code[0] = '\201';	code[0] = '\201';
Line 2910 f20:	Line 2994 f20:
long l1, rouoldc;	long l1, rouoldc;
short reload = FALSE;	short reload = FALSE;

	/*
	printf ("a = %s f = %d arg = %d\r\n", a, f, arg);
	for (i = arg; i < arg + f; i++) {
	printf ("argstck[%d] = '%s'\r\n", i, argstck[i]);
	}

	for (i = 0; i < strlen (a); i++)
	printf ("%c = %d\r\n", a[i], (unsigned char) a[i]);
	*/

if (f > 3) {	if (f > 3) {
merr_raise (FUNARG);	merr_raise (FUNARG);
return;	return;
Line 4514 extra_fun:	Line 4608 extra_fun:


if (obj_field) {	if (obj_field) {
char t_objf[255];	char t_objf[STRLEN];

snprintf (t_objf, 254, "%s\201", object_instance);	snprintf (t_objf, STRLEN - 1, "%s\201", object_instance);

dofram0 = dofrmptr;	dofram0 = dofrmptr;
*dofrmptr++ = DELIM;	*dofrmptr++ = DELIM;
Line 4531 extra_fun:	Line 4625 extra_fun:
obj_field = FALSE;	obj_field = FALSE;


//dofram0 = dofrmptr;	/* dofram0 = dofrmptr; */

i = 0;	i = 0;
codptr++;	codptr++;
Line 4593 extra_fun:	Line 4687 extra_fun:

obj_field = FALSE;	obj_field = FALSE;

//dofram0 = 0;	/* dofram0 = 0; */
if (*codptr == '(') codptr += 2;	if (*codptr == '(') codptr += 2;

}	}
Line 4669 extra_fun:	Line 4763 extra_fun:
/* save off the return type to be checked by QUIT code */	/* save off the return type to be checked by QUIT code */
extr_types[nstx + 1] = ret_type;	extr_types[nstx + 1] = ret_type;

//printf ("return_type = '%s' reg = '%c'\r\n", return_type, reg);	/* printf ("return_type = '%s' reg = '%c'\r\n", return_type, reg); */
}	}

if (reg == TAB \|\| reg == SP) goto off;	if (reg == TAB \|\| reg == SP) goto off;
Line 4804 off:	Line 4898 off:
else {	else {
/* PARSE FORMALLIST */	/* PARSE FORMALLIST */
short fl_type;	short fl_type;
short fl_mandatory;	/* re-enable following 3 later */
short fl_byref;	/short fl_mandatory;/
	/short fl_byref;/
	/short lastparm;/
char fl_typestr[255];	char fl_typestr[255];
char fl_mand;	char fl_mand;
short dtcheck_result;	short dtcheck_result;
register short typei;	register short typei;
short lastparm;
short gotparm;	short gotparm;
int paramct;	int paramct;

fl_type = DT_AUTO;	fl_type = DT_AUTO;
fl_mandatory = TRUE;	/* re-enable following 3 later */
fl_byref = FALSE;	/fl_mandatory = TRUE;/
	/fl_byref = FALSE;/
	/lastparm = FALSE;/
dtcheck_result = FALSE;	dtcheck_result = FALSE;
lastparm = FALSE;
gotparm = FALSE;	gotparm = FALSE;
paramct = 0;	paramct = 0;

Line 4841 off:	Line 4937 off:
fl_typestr[typei] = '\0';	fl_typestr[typei] = '\0';
fl_mand = *(reg + 1);	fl_mand = *(reg + 1);

	/*
if ((fl_mand == 'o') \|\| (fl_mand == 'O')) {	if ((fl_mand == 'o') \|\| (fl_mand == 'O')) {
fl_mandatory = FALSE;	fl_mandatory = FALSE;
}	}
Line 4855 off:	Line 4952 off:

goto errexfun;	goto errexfun;
}	}
	*/

	if ((fl_mand != 'o') && (fl_mand != 'O')) {
	merr_raise (INVLIBOPT);
	dofrmptr = dofram0;

	errex = TRUE;

	nstx--;
	estack--;

	goto errexfun;
	}


}	}
else if ((ch == ',') \|\| (ch == ')')) {	else if ((ch == ',') \|\| (ch == ')')) {

	/* re-enable later
if (ch == ')') {	if (ch == ')') {
lastparm = TRUE;	lastparm = TRUE;
}	}
	*/

gotparm = TRUE;	gotparm = TRUE;
paramct++;	paramct++;
Line 4897 off:	Line 5011 off:

if (dtcheck_result == FALSE) {	if (dtcheck_result == FALSE) {
merr_raise (TYPMISMATCH);	merr_raise (TYPMISMATCH);
dofrmptr = dofram0; // reset frame pointer	dofrmptr = dofram0; /* reset frame pointer */

errex = TRUE;	errex = TRUE;

Line 5418 errexfun:	Line 5532 errexfun:
ilong = ilong1 - (ilong * 86400);	ilong = ilong1 - (ilong * 86400);

lintstr (&a[i], ilong);	lintstr (&a[i], ilong);

// printf ("unix epoch = %d\r\n", horolog_to_unix (a));

goto exec;	goto exec;

Line 5462 errexfun:	Line 5574 errexfun:
{	{
char doggie_bag[50];	char doggie_bag[50];

snprintf (doggie_bag, 49, ".%ld\201", ilong);	snprintf (doggie_bag, sizeof (doggie_bag) - 1, ".%ld\201", ilong);
stcat (a, doggie_bag);	stcat (a, doggie_bag);
}	}
}	}
Line 5471 errexfun:	Line 5583 errexfun:

case SVNsystem:	case SVNsystem:

snprintf (a, 512, "%d,\"%s\"\201", MDC_VENDOR_ID, jour_hostid);	sprintf (a, "%d,\"%s\"\201", MDC_VENDOR_ID, jour_hostid);
goto exec;	goto exec;


Line 5483 errexfun:	Line 5595 errexfun:

case SVNtlevel:	case SVNtlevel:

snprintf (a, 255, "%d\201", tp_level);	sprintf (a, "%d\201", tp_level);
goto exec;	goto exec;


Line 5496 errexfun:	Line 5608 errexfun:

case SVNecode:	case SVNecode:

//write_m ("in SVNecode\r\n\201");	/* write_m ("in SVNecode\r\n\201"); */

if (stlen (user_ecode)) {	if (stlen (user_ecode)) {
stcpy (a, user_ecode);	stcpy (a, user_ecode);
Line 5511 errexfun:	Line 5623 errexfun:
case SVNestack:	case SVNestack:
{	{
char esbuf[256];	char esbuf[256];
snprintf (esbuf, 255, "%d\201", estack);	sprintf (esbuf, "%d\201", estack);

stcpy (a, esbuf);	stcpy (a, esbuf);
goto exec;	goto exec;
Line 5520 errexfun:	Line 5632 errexfun:


case SVNetrap:	case SVNetrap:
// write_m ("in SVNetrap\r\n\201");	/* write_m ("in SVNetrap\r\n\201"); */
stcpy (a, etrap);	stcpy (a, etrap);
goto exec;	goto exec;

Line 5544 errexfun:	Line 5656 errexfun:
/* $DEVICE */	/* $DEVICE */
case 'd':	case 'd':
if (devstat[io].mdc_err == 0) {	if (devstat[io].mdc_err == 0) {
snprintf (a, 3, "0\201\0");	sprintf (a, "0\201\0");
}	}
else {	else {
snprintf (a, 120, "%d,%d,%s\201\0", devstat[io].mdc_err, devstat[io].frm_err, devstat[io].err_txt);	sprintf (a, "%d,%d,%s\201\0", devstat[io].mdc_err, devstat[io].frm_err, devstat[io].err_txt);
}	}

goto exec;	goto exec;

/* $STORAGE */	/* $STORAGE */
case 's':	case 's':
snprintf (a, 255 , "%ld\201", DEFPSIZE);	sprintf (a, "%ld\201", DEFPSIZE);
goto exec;	goto exec;

/* $WITH */	/* $WITH */
Line 5604 errexfun:	Line 5716 errexfun:
goto exec;	goto exec;


///* $ZX (number of columns) */	/* $ZX (number of columns) */
//case 'X':	case 'X':
//intstr (a, n_columns);	intstr (a, n_columns);
// goto exec;	goto exec;

///* $ZY (number of rows) */	/* $ZY (number of rows) */
//case 'Y':	case 'Y':
//intstr (a, n_lines);	intstr (a, n_lines);
//goto exec;	goto exec;

/* $ZERROR */	/* $ZERROR */
case 'E':	case 'E':
Line 5675 errexfun:	Line 5787 errexfun:
char zdf_key[50];	char zdf_key[50];
char fmt_string[128];	char fmt_string[128];

snprintf (zdf_key, 49, "^$JOB\202%d\202ZDATE_FORMAT\201", pid);	snprintf (zdf_key, sizeof (zdf_key) - 1, "^$JOB\202%d\202ZDATE_FORMAT\201", pid);
ssvn (get_sym, zdf_key, fmt_string);	ssvn (get_sym, zdf_key, fmt_string);
stcnv_c2m (fmt_string);	stcnv_c2m (fmt_string);

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

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