4.1cBSD/usr/doc/lisp/ch8aux.shout

% \fBcat ch8auxc.c\fP
/* demonstration of c coded foreign integer-function */

/* the following will be used to extract fixnums out of a list of fixnums */
struct listoffixnumscell
{    struct listoffixnumscell *cdr;
     int *fixnum;
};

struct listcell
{	struct listcell *cdr;
	int car;
};

cfoo(a,b,c,d)
int *a;
double b[];
int *c[];
struct listoffixnumscell *d;
{
    printf("a: %d, b[0]: %f, b[1]: %f\n", *a, b[0], b[1]);
    printf(" c (first): %d   c (second): %d\n",
	       *c[0],*c[1]);
    printf(" ( %d %d ... )\n ", *(d->\fBfixnum), *(d->cdr->fixnum));\fP
    b[1] = 3.1415926;
    return(3);
}

struct listcell *
cmemq(element,list)
int element;
struct listcell *list;
{   
   for( ; list && element != list->\fBcar ;  list = list->cdr);\fP
   return(list);
}
% \fBcat ch8auxp.p\fP
type 	pinteger = ^integer;
	realarray = array[0..10] of real;
	pintarray = array[0..10] of pinteger;
	listoffixnumscell = record  
				cdr  : ^listoffixnumscell;
				fixnum : pinteger;
			    end;
	plistcell = ^listcell;
	listcell = record
		      cdr : plistcell;
		      car : integer;
		   end;

function pfoo ( var a : integer ; 
		var b : realarray;
		var c : pintarray;
		var d : listoffixnumscell) : integer;
begin
   writeln(' a:',a, ' b[0]:', b[0], ' b[1]:', b[1]);
   writeln(' c (first):', c[0]^,' c (second):', c[1]^);
   writeln(' ( ', d.fixnum^, d.cdr^.fixnum^, ' ...) ');
   b[1] := 3.1415926;
   pfoo := 3
end ;

{ the function pmemq looks for the lisp pointer given as the first argument
  in the list pointed to by the second argument.
  Note that we declare " a : integer " instead of " var a : integer " since
  we are interested in the pointer value instead of what it points to (which
  could be any lisp object)
}
function pmemq( a : integer; list : plistcell) : plistcell;
begin
 while (list <> nil) and (list^.car <> a) do list := list^.cdr;
 pmemq := list;
end ;
% \fBcc -c ch8auxc.c\fP
1.0u 1.2s 0:15 14% 30+39k 33+20io 147pf+0w
% \fBpc -c ch8auxp.p\fP
3.0u 1.7s 0:37 12% 27+32k 53+32io 143pf+0w
% \fBlisp\fP
Franz Lisp, Opus 33b
->\fB (cfasl 'ch8auxc.o '_cfoo 'cfoo "integer-function")\fP
/usr/lib/lisp/nld -N -A /usr/local/lisp -T 63000 ch8auxc.o -e _cfoo -o /tmp/Li7055.0  -lc
#63000-"integer-function"
->\fB (cfasl 'ch8auxp.o '_pfoo 'pfoo "integer-function" "-lpc")\fP
/usr/lib/lisp/nld -N -A /tmp/Li7055.0 -T 63200 ch8auxp.o -e _pfoo -o /tmp/Li7055.1 -lpc -lc
#63200-"integer-function"
->\fB (getaddress '_cmemq 'cmemq "function" '_pmemq 'pmemq "function")\fP
#6306c-"function"
->\fB (setq testarr (array nil flonum-block 2))\fP
array[2]
->\fB (store (funcall testarr 0) 1.234)\fP
1.234
->\fB (store (funcall testarr 1) 5.678)\fP
5.678
->\fB (cfoo 385 testarr (hunk 10 11 13 14) '(15 16 17))\fP
a: 385, b[0]: 1.234000, b[1]: 5.678000
 c (first): 10   c (second): 11
 ( 15 16 ... )
 3
->\fB (funcall testarr 1)\fP
3.1415926
->\fB (array test flonum-block 2)\fP
array[2]
->\fB (store (test 0) 1.234)\fP
1.234
->\fB (store (test 1) 5.678)\fP
5.678
->\fB (pfoo 385 (getd 'test) (hunk 10 11 13 14) '(15 16 17))\fP
 a:       385 b[0]:  1.23400000000000E+00 b[1]:  5.67800000000000E+00
 c (first):        10 c (second):        11
 (         15        16 ...) 
3
->\fB (test 1)\fP
3.1415926
->\fB 3.5u 3.0s 1:44 6% 22+61k 262+92io 210pf+0w\fP
%