lang/pc/test/cmod.c

   1 /*
   2  * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
   3  * See the copyright notice in the ACK home directory, in the file "Copyright".
   4  */
   5 #include <stdio.h>
   6 char rcs_id[] = "$Id: cmod.c,v 2.4 1994/06/24 12:36:44 ceriel Exp $" ;
   7
   8 typedef struct {
   9         int     (*p_func)() ;
  10         char    *p_slink ;
  11 } p_fiptr ;
  12
  13 #ifndef NOFLOAT
  14 typedef struct {
  15         double  (*p_func)() ;
  16         char    *p_slink ;
  17 } p_ffptr ;
  18 #endif
  19
  20 int kwad(val) int val ; { return val*val ; }
  21 cmain() {
  22         p_fiptr p_kwad ;
  23
  24         /* Test calling pascal procedures */
  25         if ( twice(7)!=14 || twice(-9)!=-18 ) {
  26                 printf("Calling pascal from C doesn't work\n") ;
  27                 fflush(stdout) ;
  28                 }
  29         else
  30                 incs() ;
  31         /* Test passing C function pointers */
  32         p_kwad.p_slink= (char *)0 ; p_kwad.p_func= kwad ;
  33         cptr(p_kwad) ;
  34 }
  35 pptr(p_twice) p_fiptr p_twice ; {
  36         if ( p_twice.p_slink!=(char *)0 ) {
  37                 printf("Pascal outer procedure static link unequal to zero\n") ;
  38                 fflush(stdout) ;
  39                 }
  40
  41         if ( p_twice.p_func(-7)!=-14 || p_twice.p_func(9)!=18 ) {
  42                 printf("Passing pascal functions to C doesn't work\n") ;
  43                 fflush(stdout) ;
  44                 }
  45         else    incs() ;
  46 }
  47
  48 #ifndef NOFLOAT
  49 double callpas(pasfunc,par) p_ffptr pasfunc ; int par ; {
  50         /* Call a Pascal function, both inner block and outer block */
  51         /* Function must return a double, (In pascal terms: real) */
  52         /* and have one integer parameter */
  53         /* The static link - if present - must be the first parameter */
  54         if ( pasfunc.p_slink ) {
  55                 return (*pasfunc.p_func)(pasfunc.p_slink,par) ;
  56         } else {
  57                 return (*pasfunc.p_func)(par) ;
  58         }
  59 }
  60
  61 int ceval(p_inside) p_ffptr p_inside ; {
  62         double resval ;
  63         resval= callpas(p_inside,2) ;
  64         return resval>1.41 && resval<1.42 ;
  65 }
  66 #endif