[Ecls-list] A christmas gift of unboxed functions, etc (experimental)

[Brian Spilsbury]

Hello, included is a patch which probably should be broken up into
smaller pieces, but I thought it might make for nice christmas
viewing.

Consider this 'for review', it has not been tested too extensively.

Regards,
Brian

===============

(i) supports unboxed function interfaces for top-level functions with
declared arguments and/or returns.
(ii) produces a boxed alternative for such functions.
(iii) extends si::c-export-fname to support ("c-name" lisp-name) -- in
which case "c-name" is used without mangling.

This probably contains bugs, so be careful... but it does manage to compile ecl.

Also included is SI::MAKE-FOREIGN-ARRAY, which works like MAKE-ARRAY,
but has the form (make-foreign-array dimensions foreign-pointer &key
element-type initial-element initial-contents fill-pointer), which you
can think of as being an array displaced onto foreign data.

Also included is an extension to FFI:DO-LOAD-FOREIGN-LIBRARY which now
accepts an optional SYSTEM-LIBRARY flag (maybe it should be a
keyword).

This allows
(ffi:load-foreign-library "termcap"  :system-library t)
(ffi:load-foreign-library "readline" :system-library t)
to work correctly, linking with -ltermcap with -lreadline, rather than
trying to link to a local .so file.

================

; a test file to show unboxed functions
(declaim (si::c-export-fname ("fxtosf" fixnum->short-float)
                             ("sftofx" short-float->fixnum)
                             ("sttofx" string->fixnum)
                             ("fxtost" fixnum->string)))

(declaim (ftype (function (fixnum) short-float) fixnum->short-float))
(declaim (ftype (function (short-float) fixnum) short-float->fixnum))
(declaim (ftype (function (string) fixnum) string->fixnum))
(declaim (ftype (function (fixnum) string) fixnum->string))

(defun fixnum->short-float (x)
  (declare (type fixnum x))
  (coerce x 'short-float))

(defun short-float->fixnum (x)
  (declare (type short-float x))
  (floor x))

(defun string->fixnum (x)
  (declare (type string x))
  (the fixnum (parse-int x)))

(defun fixnum->string (x)
  (declare (type fixnum x))
  (format nil "~D" x))

(defun indirect (x v)
  (funcall x v))

(defun test-1 ()
  (fixnum->string (short-float->fixnum (fixnum->short-float 10))))

(defun test-2 (v)
  (indirect #'fixnum->short-float v))

; produces

#include <ecl/ecl-cmp.h>
#include "/info/lisp/ecl/d.h"
/*      function definition for FIXNUM->SHORT-FLOAT                   */
cl_object GENERIC_fxtosf(cl_object V1) { /* NVALUES=1; */
        return(make_singlefloat(fxtosf(object_to_fixnum(V1)) /*
FIXNUM->SHORT-FLOAT */)); }
float fxtosf(cl_fixnum V1)
{ VT2 VLEX2 CLSR2
        cl_object value0;
        {
        cl_fixnum V2;
        V2= V1;
TTL:
        return(object_to_double(cl_float(2,MAKE_FIXNUM(V2),VV[0]) /*
FLOAT */));
        }
}
/*      function definition for SHORT-FLOAT->FIXNUM                   */
cl_object GENERIC_sftofx(cl_object V1) { /* NVALUES=1; */
        return(MAKE_FIXNUM(sftofx(object_to_double(V1)) /*
SHORT-FLOAT->FIXNUM */)); }
cl_fixnum sftofx(float V1)
{ VT3 VLEX3 CLSR3
        cl_object value0;
        {
        float V2;
        V2= V1;
TTL:
        return(object_to_fixnum(cl_floor(1,make_singlefloat(V2)) /*  FLOOR */));
        }
}
/*      function definition for STRING->FIXNUM                        */
cl_object GENERIC_sttofx(cl_object V1) { /* NVALUES=1; */
        return(MAKE_FIXNUM(sttofx(V1)             /*  STRING->FIXNUM
                */)); }
cl_fixnum sttofx(cl_object V1)
{ VT4 VLEX4 CLSR4
        cl_object value0;
        {
TTL:
        return(object_to_fixnum((*LK0common_lisp_user__parse_int)(1,V1)
/*  PARSE-INT */));
        }
}
; etc
-------------- next part --------------
A non-text attachment was scrubbed...
Name: patch.txt.gz
Type: application/x-gzip
Size: 17081 bytes
Desc: not available
URL: <https://mailman.common-lisp.net/pipermail/ecl-devel/attachments/20061225/ef6fb8df/attachment.bin>