ack/lang/pc/test/cmod.c

/*
 * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
 * See the copyright notice in the ACK home directory, in the file "Copyright".
 */
#include <stdio.h>
char rcs_id[] = "$Header$" ;

typedef struct {
	int	(*p_func)() ;
	char	*p_slink ;
} p_fiptr ;

typedef struct {
	double	(*p_func)() ;
	char	*p_slink ;
} p_ffptr ;

int kwad(val) int val ; { return val*val ; }
cmain() {
	p_fiptr p_kwad ;

	/* Test calling pascal procedures */
	if ( twice(7)!=14 || twice(-9)!=-18 ) {
		printf("Calling pascal from C doesn't work\n") ;
		fflush(stdout) ;
		}
	else
		incs() ;
	/* Test passing C function pointers */
	p_kwad.p_slink= (char *)0 ; p_kwad.p_func= kwad ;
	cptr(p_kwad) ;
}
pptr(p_twice) p_fiptr p_twice ; {
	if ( p_twice.p_slink!=(char *)0 ) {
		printf("Pascal outer procedure static link unequal to zero\n") ;
		fflush(stdout) ;
		}
	
	if ( p_twice.p_func(-7)!=-14 || p_twice.p_func(9)!=18 ) {
		printf("Passing pascal functions to C doesn't work\n") ;
		fflush(stdout) ;
		}
	else	incs() ;
}

double callpas(pasfunc,par) p_ffptr pasfunc ; int par ; {
	/* Call a Pascal function, both inner block and outer block */
	/* Function must return a double, (In pascal terms: real) */
	/* and have one integer parameter */
	/* The static link - if present - must be the first parameter */
	if ( pasfunc.p_slink ) {
		return (*pasfunc.p_func)(pasfunc.p_slink,par) ;
	} else {
		return (*pasfunc.p_func)(par) ;
	}
}

int ceval(p_inside) p_ffptr p_inside ; {
	double resval ;
	resval= callpas(p_inside,2) ;
	return resval>1.41 && resval<1.42 ;
}