===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/comp.c,v
retrieving revision 1.2
retrieving revision 1.11
diff -u -p -r1.2 -r1.11
--- OpenXM_contrib2/asir2000/parse/comp.c	2000/08/21 08:31:46	1.2
+++ OpenXM_contrib2/asir2000/parse/comp.c	2018/03/29 01:32:54	1.11
@@ -23,7 +23,7 @@
  * shall be made on your publication or presentation in any form of the
  * results obtained by use of the SOFTWARE.
  * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
- * e-mail at risa-admin@flab.fujitsu.co.jp of the detailed specification
+ * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
  * for such modification or the source code of the modified part of the
  * SOFTWARE.
  * 
@@ -45,12 +45,12 @@
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *
- * $OpenXM: OpenXM_contrib2/asir2000/parse/comp.c,v 1.1.1.1 1999/12/03 07:39:11 noro Exp $ 
+ * $OpenXM: OpenXM_contrib2/asir2000/parse/comp.c,v 1.10 2015/08/14 13:51:56 fujimoto Exp $ 
 */
 #include "ca.h"
 #include "parse.h"
 #include "comp.h"
-#if defined(THINK_C) || defined(VISUAL)
+#if defined(__GNUC__) || defined(VISUAL) || defined(__MINGW32__) || (defined(__MACH__) && defined(__ppc__)) || defined(__FreeBSD__)
 #include <stdarg.h>
 #else
 #include <varargs.h>
@@ -58,50 +58,64 @@
 
 extern f_return;
 
-#if defined(THINK_C) || defined(VISUAL)
+#if defined(__GNUC__) || defined(VISUAL) || defined(__MINGW32__) || (defined(__MACH__) && defined(__ppc__)) || defined(__FreeBSD__)
 void call_usrf(FUNC f,...)
 {
-	va_list ap;
-	int ac,i;
-	pointer *c;
-	NODE tn;
+  va_list ap;
+  int ac,i;
+  pointer *c;
+  VS prev_mpvs;
+  NODE tn;
 
-	va_start(ap,f);
-	if ( !f )
-		notdef(0,0,0,0);
-	else {
-		pushpvs(f);
-		ac = va_arg(ap,int);
-		for ( i = 0, tn = f->f.usrf->args; i < ac;
-			i++, tn = NEXT(tn) )
-			ASSPV((int)FA0((FNODE)BDY(tn)),va_arg(ap,pointer));
-		c = va_arg(ap,pointer *); *c = evalstat(BDY(f->f.usrf));
-		va_end(ap);
-		f_return = 0; poppvs();
-	}
+  va_start(ap,f);
+  if ( !f )
+    notdef(0,0,0,0);
+  else {
+    pushpvs(f);
+    if ( f->f.usrf->module ) {
+      prev_mpvs = MPVS;
+      MPVS = f->f.usrf->module->pvs;
+    }
+    ac = va_arg(ap,int);
+    for ( i = 0, tn = f->f.usrf->args; i < ac;
+      i++, tn = NEXT(tn) )
+      ASSPV((int)FA0((FNODE)BDY(tn)),va_arg(ap,pointer));
+    c = va_arg(ap,pointer *); *c = evalstat(BDY(f->f.usrf));
+    va_end(ap);
+    f_return = 0; poppvs();
+    if ( f->f.usrf->module )
+      MPVS = prev_mpvs;
+  }
 }
 #else
 void call_usrf(va_alist)
 va_dcl
 {
-	va_list ap;
-	int ac,i;
-	FUNC f;
-	pointer a,b,*c;
-	NODE tn;
+  va_list ap;
+  int ac,i;
+  FUNC f;
+  pointer a,b,*c;
+  VS prev_mpvs;
+  NODE tn;
 
-	va_start(ap); f = va_arg(ap,FUNC);
-	if ( !f )
-		notdef(0,0,0,0);
-	else {
-		pushpvs(f);
-		ac = va_arg(ap,int);
-		for ( i = 0, tn = f->f.usrf->args; i < ac;
-			i++, tn = NEXT(tn) )
-			ASSPV((int)FA0((FNODE)BDY(tn)),va_arg(ap,pointer));
-		c = va_arg(ap,pointer *); *c = evalstat(BDY(f->f.usrf));
-		f_return = 0; poppvs();
-	}
+  va_start(ap); f = va_arg(ap,FUNC);
+  if ( !f )
+    notdef(0,0,0,0);
+  else {
+    pushpvs(f);
+    if ( f->f.usrf->module ) {
+      prev_mpvs = MPVS;
+      MPVS = f->f.usrf->module->pvs;
+    }
+    ac = va_arg(ap,int);
+    for ( i = 0, tn = f->f.usrf->args; i < ac;
+      i++, tn = NEXT(tn) )
+      ASSPV((int)FA0((FNODE)BDY(tn)),va_arg(ap,pointer));
+    c = va_arg(ap,pointer *); *c = evalstat(BDY(f->f.usrf));
+    f_return = 0; poppvs();
+    if ( f->f.usrf->module )
+      MPVS = prev_mpvs;
+  }
 }
 #endif
 
@@ -109,46 +123,46 @@ void addcomp(vl,a,b,c)
 VL vl;
 COMP a,b,*c;
 {
-	if ( a->type != b->type )
-		error("addcomp : types different");
-	else
-		call_usrf(LSS->sa[a->type].arf.add,2,a,b,c);
+  if ( a->type != b->type )
+    error("addcomp : types different");
+  else
+    call_usrf(LSS->sa[a->type].arf.add,2,a,b,c);
 }
 
 void subcomp(vl,a,b,c)
 VL vl;
 COMP a,b,*c;
 {
-	if ( a->type != b->type )
-		error("subcomp : types different");
-	else
-		call_usrf(LSS->sa[a->type].arf.sub,2,a,b,c);
+  if ( a->type != b->type )
+    error("subcomp : types different");
+  else
+    call_usrf(LSS->sa[a->type].arf.sub,2,a,b,c);
 }
 
 void mulcomp(vl,a,b,c)
 VL vl;
 COMP a,b,*c;
 {
-	if ( a->type != b->type )
-		error("mulcomp : types different");
-	else
-		call_usrf(LSS->sa[a->type].arf.mul,2,a,b,c);
-}	
+  if ( a->type != b->type )
+    error("mulcomp : types different");
+  else
+    call_usrf(LSS->sa[a->type].arf.mul,2,a,b,c);
+}  
 
 void divcomp(vl,a,b,c)
 VL vl;
 COMP a,b,*c;
 {
-	if ( a->type != b->type )
-		error("divcomp : types different");
-	else
-		call_usrf(LSS->sa[a->type].arf.div,2,a,b,c);
-}	
+  if ( a->type != b->type )
+    error("divcomp : types different");
+  else
+    call_usrf(LSS->sa[a->type].arf.div,2,a,b,c);
+}  
 
 void chsgncomp(a,b)
 COMP a,*b;
 {
-	call_usrf(LSS->sa[a->type].arf.chsgn,1,a,b);
+  call_usrf(LSS->sa[a->type].arf.chsgn,1,a,b);
 }
 
 void pwrcomp(vl,a,r,c)
@@ -157,28 +171,28 @@ COMP a;
 Obj r;
 COMP *c;
 {
-	call_usrf(LSS->sa[a->type].arf.pwr,2,a,r,c);
+  call_usrf(LSS->sa[a->type].arf.pwr,2,a,r,c);
 }
 
 int compcomp(vl,a,b)
 VL vl;
 COMP a,b;
 {
-	Q c;
-	int s;
+  Q c;
+  int s;
 
-	if ( a->type > b->type )
-		return 1;
-	else if ( a->type < b->type )
-		return -1;
-	else {
-		call_usrf(LSS->sa[a->type].arf.comp,2,a,b,&c);
-		s = QTOS(c);
-		if ( s > 0 )
-			return 1;
-		else if ( s < 0 )
-			return -1;
-		else
-			return 0;
-	}
+  if ( a->type > b->type )
+    return 1;
+  else if ( a->type < b->type )
+    return -1;
+  else {
+    call_usrf(LSS->sa[a->type].arf.comp,2,a,b,&c);
+    s = QTOS(c);
+    if ( s > 0 )
+      return 1;
+    else if ( s < 0 )
+      return -1;
+    else
+      return 0;
+  }
 }