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.4 and 1.12

version 1.4, 2025/03/09 15:20:18	version 1.12, 2025/04/10 01:24:38
Line 1	Line 1
/*	/*
* *	* $Id$
* * *
* * *
* ***************
* * * * *
* * MUMPS *
* * * * *
* ***************
* * *
* * *
* *
*
* expr.c
* expression parser	* expression parser
*	*
*	*
* Author: Serena Willis <snw@coherent-logic.com>	* Author: Serena Willis <snw@coherent-logic.com>
* Copyright (C) 1998 MUG Deutschland	* Copyright (C) 1998 MUG Deutschland
* Copyright (C) 2020, 2023 Coherent Logic Development LLC	* Copyright (C) 2020, 2023, 2025 Coherent Logic Development LLC
*	*
*	*
* This file is part of FreeM.	* This file is part of FreeM.
Line 35	Line 23
* You should have received a copy of the GNU Affero Public License	* You should have received a copy of the GNU Affero Public License
* along with FreeM. If not, see <https://www.gnu.org/licenses/>.	* along with FreeM. If not, see <https://www.gnu.org/licenses/>.
*	*
	* $Log$
	* 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
	* Comply with X11-96/13 portable length of names
	*
	* Revision 1.5 2025/03/09 19:14:24 snw
	* First phase of REUSE compliance and header reformat
	*
	*
	* SPDX-FileCopyrightText: (C) 2025 Coherent Logic Development LLC
	* SPDX-License-Identifier: AGPL-3.0-or-later
**/	**/

#if !defined(__osf__)	#if !defined(__osf__)
Line 134	Line 150
#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 178 void expr (short extyp)	Line 194 void expr (short extyp)
volatile int ch = 0;	volatile int ch = 0;

short group; /* flag to scan grouped patterns */	short group; /* flag to scan grouped patterns */

	int max_namlen = 255;

	if ((rtn_dialect () == D_MDS) \|\| (rtn_dialect () == D_M5) \|\| (rtn_dialect () == D_FREEM)) {
	max_namlen = 255;
	}
	else {
	max_namlen = 8;
	}

#ifdef DEBUG_NEWPTR	#ifdef DEBUG_NEWPTR
int loop;	int loop;
Line 206 void expr (short extyp)	Line 231 void expr (short extyp)
(((ch == '/' && varnam[i - 1] != '/') \|\|	(((ch == '/' && varnam[i - 1] != '/') \|\|
(ch == '%' && varnam[i - 1] == '/')) &&	(ch == '%' && varnam[i - 1] == '/')) &&
(varnam[1] == '.' \|\| varnam[1] == '/'))))) \|\| (f != '^') && (ch == '.')) {	(varnam[1] == '.' \|\| varnam[1] == '/'))))) \|\| (f != '^') && (ch == '.')) {

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;

	#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 334 scan_name:	Line 381 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 351 scan_name:	Line 413 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 491 var1:	Line 570 var1:

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

ch = dat;	ch = fra_dat;

glv_fcn:	glv_fcn:

Line 693 d_o_n:	Line 772 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 878 undefglvn:	Line 957 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 1605 uparrow:	Line 1684 uparrow:

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

{	{
	char chrtmp[256];
	long pnum;
short l, l1, m, n;	short l, l1, m, n;

l1 = f;	l1 = f;
Line 1616 uparrow:	Line 1697 uparrow:
n = 1;	n = 1;
l = 0;	l = 0;

	stcpy (chrtmp, a);
	stcnv_m2c (chrtmp);
	pnum = atol (chrtmp);

	if (pnum > 127) {
	merr_raise (MXNUM);
	return;
	}

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

if ((ch = a[i++]) == EOL) {	if ((ch = a[i++]) == EOL) {
Line 2224 f20:	Line 2314 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 4520 extra_fun:	Line 4610 extra_fun:
obj_field = FALSE;	obj_field = FALSE;


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

i = 0;	i = 0;
codptr++;	codptr++;
Line 4582 extra_fun:	Line 4672 extra_fun:

obj_field = FALSE;	obj_field = FALSE;

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

}	}
Line 4658 extra_fun:	Line 4748 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 4793 off:	Line 4883 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 4830 off:	Line 4922 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 4844 off:	Line 4937 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 4886 off:	Line 4996 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 5407 errexfun:	Line 5517 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 5485 errexfun:	Line 5593 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 5509 errexfun:	Line 5617 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 5593 errexfun:	Line 5701 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':

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

Removed from v.1.4
changed lines
	Added in v.1.12