% \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 %