From d71b83ab44449df4f3448cbda33c48edc8cf7f9b Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Tue, 2 Jun 2020 18:54:03 +0900 Subject: [PATCH 01/17] mv contrib/eus64-check to euslisp/test --- .travis.sh | 2 + contrib/eus64-check/Makefile | 34 --------------- test/Makefile | 42 +++++++++++++++++++ test/Makefile.Cygwin | 12 ++++++ test/Makefile.Darwin | 12 ++++++ test/Makefile.Linux | 33 +++++++++++++++ .../test-foreign-module.l | 4 +- .../eus64-test.l => test/test-foreign.l | 18 ++++---- {contrib/eus64-check => test}/test_foreign.c | 16 +++---- 9 files changed, 120 insertions(+), 53 deletions(-) delete mode 100644 contrib/eus64-check/Makefile create mode 100644 test/Makefile create mode 100644 test/Makefile.Cygwin create mode 100644 test/Makefile.Darwin create mode 100644 test/Makefile.Linux rename contrib/eus64-check/eus64-module.l => test/test-foreign-module.l (99%) rename contrib/eus64-check/eus64-test.l => test/test-foreign.l (88%) rename {contrib/eus64-check => test}/test_foreign.c (96%) diff --git a/.travis.sh b/.travis.sh index 9a2a737e1..5a5f94ff4 100755 --- a/.travis.sh +++ b/.travis.sh @@ -87,6 +87,7 @@ if [ "$QEMU" != "" ]; then export EXIT_STATUS=0; set +e # run test in EusLisp/test + make -C test for test_l in test/*.l; do travis_time_start euslisp.${test_l##*/}.test @@ -235,6 +236,7 @@ if [[ "`uname -m`" == "aarch"* ]]; then fi # run test in EusLisp/test + make -C $CI_SOURCE_PATH/test for test_l in $CI_SOURCE_PATH/test/*.l; do travis_time_start euslisp.${test_l##*/}.test diff --git a/contrib/eus64-check/Makefile b/contrib/eus64-check/Makefile deleted file mode 100644 index 3ec68ba24..000000000 --- a/contrib/eus64-check/Makefile +++ /dev/null @@ -1,34 +0,0 @@ - -all : test - -MARCH=$(shell uname -m) - -test_foreign.so : test_foreign.c -ifeq ($(ARCHDIR), Linux64) -## - gcc -O2 -g -falign-functions=8 -Dx86_64 -DLinux -fPIC -c $< - gcc -shared -fPIC -falign-functions=8 -o $@ test_foreign.o -else -ifeq ($(ARCHDIR), LinuxARM) -ifeq ($(MARCH), aarch64) -## arm 64bit - gcc -O2 -g -Wimplicit -falign-functions=8 -Daarch64 -Darmv8 -DARM -DLinux -fPIC -c $< - gcc -shared -fPIC -falign-functions=8 -o $@ test_foreign.o -else -## arm 32bit - gcc -O2 -g -falign-functions=4 -DARM -DLinux -fpic -c $< - gcc -shared -fpic -falign-functions=4 -o $@ test_foreign.o -endif -else -## Linux32 bit - gcc -m32 -O2 -g -falign-functions=4 -Di386 -Di486 -DLinux -fpic -c $< - gcc -m32 -shared -fpic -falign-functions=4 -o $@ test_foreign.o -endif -endif - -test: test_foreign.so - irteusgl eus64-test.l - -clean : - \rm -f *.o *.so - diff --git a/test/Makefile b/test/Makefile new file mode 100644 index 000000000..1fa5e144d --- /dev/null +++ b/test/Makefile @@ -0,0 +1,42 @@ +GCC_MACHINE=$(shell gcc -dumpmachine) +$(info "-- GCC_MACHINE = ${GCC_MACHINE}") +OS=$(shell uname -s | sed 's/[^A-Za-z1-9].*//') +$(info "-- OS = ${OS}") +ifeq ($(OS),Linux) + export MAKEFILE=Makefile.Linux +endif +ifeq ($(OS),CYGWIN) + export MAKEFILE=Makefile.Cygwin +endif +ifeq ($(OS),Darwin) + export MAKEFILE=Makefile.Darwin +endif + +$(info "-- MAKEFILE = ${MAKEFILE}") + +# set EUSDIR if not defined +export EUSDIR?=$(CURDIR)/.. +$(info "-- EUSDIR = ${EUSDIR}") + +include $(MAKEFILE) + +SRC=test_foreign.c +OBJ=$(basename $(SRC)).o +LIB=$(basename $(SRC)).$(LSFX) + +$(LIB): $(OBJ) + $(LD) $(SOFLAGS) $(OUTOPT)$(LIB) $(OBJ) $(LDFLAGS) + @echo "Try make test" + +$(OBJ): $(SRC) + $(CC) $(CFLAGS) -DCOMPILE_LIB -c $(SRC) $(OBJOPT)$(OBJ) + +clean: + rm -f $(LIB) $(OBJ) + +test: $(LIB) + teusgl eus64-test.l + +clean : + \rm -f *.o *.so + diff --git a/test/Makefile.Cygwin b/test/Makefile.Cygwin new file mode 100644 index 000000000..1f97214c5 --- /dev/null +++ b/test/Makefile.Cygwin @@ -0,0 +1,12 @@ +CC = c++ +CFLAGS = -O2 -falign-functions=4 -DCygwin -I$(EUSDIR)/include +LDFLAGS = +OBJOPT = -o +OUTOPT = -o +LD = c++ -shared -falign-functions=4 +EXELD = c++ -falign-functions=4 +SOFLAGS = +EXESFX = .exe +LSFX = dll +LPFX = lib +LIBS = -L$(ARCHDIR) -lRAPID diff --git a/test/Makefile.Darwin b/test/Makefile.Darwin new file mode 100644 index 000000000..111dcfcfa --- /dev/null +++ b/test/Makefile.Darwin @@ -0,0 +1,12 @@ +CC = c++ +CFLAGS = -O2 -falign-functions=8 -fPIC -DDarwin -DGCC -I$(EUSDIR)/include +LDFLAGS = +OBJOPT = -o +OUTOPT = -o +LD = c++ +SOFLAGS = -dynamiclib -flat_namespace -undefined suppress +EXELD = c++ +EXESFX = +LSFX = so +LPFX = lib +LIBS = -L$(ARCHDIR) -lRAPID diff --git a/test/Makefile.Linux b/test/Makefile.Linux new file mode 100644 index 000000000..fb6f0d689 --- /dev/null +++ b/test/Makefile.Linux @@ -0,0 +1,33 @@ +CC = c++ +CFLAGS = -O2 -DLinux -DGCC -I$(EUSDIR)/include +LDFLAGS = +OBJOPT = -o +OUTOPT = -o +LD = c++ +SOFLAGS = -shared +EXELD = c++ +EXESFX = +LSFX = so +LPFX = lib + +ifneq (,$(findstring 64,$(shell gcc -dumpmachine))) + CFLAGS+=-falign-functions=8 +else + CFLAGS+=-falign-functions=4 +endif + +ifneq ($(shell gcc -dumpmachine | egrep "^(arm|aarch)"),) + LDFLAGS+=-Wl,-z,execstack + CFLAGS+=-DARM -fPIC +endif +ifneq ($(shell gcc -dumpmachine | grep "^x86_64"),) + CFLAGS+=-fPIC +endif + +ifneq ($(shell gcc -dumpmachine | grep "i.*86-linux"),) +CC += -m32 +LD += -m32 +EXELD += -m32 +endif + + diff --git a/contrib/eus64-check/eus64-module.l b/test/test-foreign-module.l similarity index 99% rename from contrib/eus64-check/eus64-module.l rename to test/test-foreign-module.l index 922bcbc9e..008768aeb 100644 --- a/contrib/eus64-check/eus64-module.l +++ b/test/test-foreign-module.l @@ -15,7 +15,7 @@ (defforeign ret-float *testmod* "ret_float" () :float32) (defforeign ret-double *testmod* "ret_double" () :float) (defforeign ret-long *testmod* "ret_long" () :integer) - + (defforeign set-ifunc *testmod* "set_ifunc" (:integer) :integer) (defforeign set-ffunc *testmod* "set_ffunc" (:integer) :integer) @@ -34,5 +34,3 @@ (defforeign get-size-long *testmod* "get_size_of_long" () :integer) (defforeign get-size-int *testmod* "get_size_of_int" () :integer) ) - - diff --git a/contrib/eus64-check/eus64-test.l b/test/test-foreign.l similarity index 88% rename from contrib/eus64-check/eus64-test.l rename to test/test-foreign.l index 9cf1560b1..4320e62b3 100644 --- a/contrib/eus64-check/eus64-test.l +++ b/test/test-foreign.l @@ -1,4 +1,4 @@ -(load "eus64-module.l") +(load "test-foreign-module.l") (require :unittest "lib/llib/unittest.l") (init-unit-test) @@ -9,7 +9,7 @@ (format t "pointer size ~D ~D~%" lisp::sizeof-* (get-size-pointer)) (assert (= lisp::sizeof-* (get-size-pointer))) - + (format t "double size ~D ~D~%" lisp::sizeof-double (get-size-double)) (assert (= lisp::sizeof-double (get-size-double))) @@ -50,7 +50,7 @@ test-testd = 1.23456 (assert (eps= 1.23456 ret)) ;; - (setq f (piped-fork "irteusgl eus64-module.l '(progn (test-testd 100 101 102 103 104 105 1000.000000 1010.000000 1020.000000 1030.000000 1040.000000 1050.000000 1060.000000 1070.000000 2080.000000 2090.000000 206 207)(exit 0))'")) + (setq f (piped-fork "eusg test-foreign-module.l '(progn (test-testd 100 101 102 103 104 105 1000.000000 1010.000000 1020.000000 1030.000000 1040.000000 1050.000000 1060.000000 1070.000000 2080.000000 2090.000000 206 207)(exit 0))'")) (assert (string= (read-line f) "100 101 102")) (assert (string= (read-line f) "103 104 105")) (assert (string= (read-line f) "1000.000000 1010.000000 1020.000000 1030.000000")) @@ -74,7 +74,7 @@ test-testd = 1.23456 (float3-test 0 0.1 0.2 0.3 0.4) ;; - (setq f (piped-fork "irteusgl eus64-module.l '(progn (float-test 0 0.1 0.2 0.3 0.4)(exit 0))'")) + (setq f (piped-fork "eusg test-foreign-module.l '(progn (float-test 0 0.1 0.2 0.3 0.4)(exit 0))'")) (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.1)) ;; skip first 2 character (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.2)) (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.3)) @@ -96,12 +96,12 @@ test-testd = 1.23456 (double3-test 1 0.1 0.2 0.3 0.4) ;; - (setq f (piped-fork "irteusgl eus64-module.l '(progn (double-test 1 0.1 0.2 0.3 0.4)(exit 0))'")) + (setq f (piped-fork "eusg test-foreign-module.l '(progn (double-test 1 0.1 0.2 0.3 0.4)(exit 0))'")) (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.1)) ;; skip first 2 character (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.2)) (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.3)) (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.4)) - (setq f (piped-fork "irteusgl eus64-module.l '(progn (double3-test 1 0.1 0.2 0.3 0.4)(exit 0))'")) + (setq f (piped-fork "eusg test-foreign-module.l '(progn (double3-test 1 0.1 0.2 0.3 0.4)(exit 0))'")) (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.1)) ;; skip first 2 character (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.2)) (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.3)) @@ -128,7 +128,7 @@ test-testd = 1.23456 (lv-test (length iv) iv) ;; - (setq f (piped-fork "irteusgl eus64-module.l '(progn (setq iv (integer-vector 0 100 10000 1000000 100000000 10000000000))(lv-test (length iv) iv)(exit 0))'")) + (setq f (piped-fork "eusg test-foreign-module.l '(progn (setq iv (integer-vector 0 100 10000 1000000 100000000 10000000000))(lv-test (length iv) iv)(exit 0))'")) (assert (string= (read-line f) "size = 6")) (assert (string= (read-line f) "0: 0 0")) (assert (string= (read-line f) "1: 100 64")) @@ -157,7 +157,7 @@ test-testd = 1.23456 (dv-test (length fv) fv) ;; - (setq f (piped-fork "irteusgl eus64-module.l '(progn (setq fv (float-vector 0.1 0.2 0.3 0.5 0.7))(dv-test (length fv) fv)(exit 0))'")) + (setq f (piped-fork "eusg test-foreign-module.l '(progn (setq fv (float-vector 0.1 0.2 0.3 0.5 0.7))(dv-test (length fv) fv)(exit 0))'")) (assert (string= (read-line f) "size = 5")) (assert (string= (read-line f) "0: 1.000000e-01 3FB9999999999998")) (assert (string= (read-line f) "1: 2.000000e-01 3FC9999999999998")) @@ -174,7 +174,7 @@ test-testd = 1.23456 (format t "~%str-test(exec in eus)~%") (str-test (length str) str) ;; - (setq f (piped-fork "irteusgl eus64-module.l '(progn (setq str \"input : test64 string\")(str-test (length str) str)(exit 0))'")) + (setq f (piped-fork "eusg test-foreign-module.l '(progn (setq str \"input : test64 string\")(str-test (length str) str)(exit 0))'")) (assert (string= (read-line f) (format nil "size = ~d" (length str)))) (dotimes (i (length str)) (assert (string= (read-line f) (format nil "~d: ~c ~x" i (elt str i) (elt str i)))) diff --git a/contrib/eus64-check/test_foreign.c b/test/test_foreign.c similarity index 96% rename from contrib/eus64-check/test_foreign.c rename to test/test_foreign.c index f0af5255f..a53b2cb19 100644 --- a/contrib/eus64-check/test_foreign.c +++ b/test/test_foreign.c @@ -1,6 +1,7 @@ #include #include +extern "C" { int float_test(int n, float f1, float f2, float f3, float f4) { unsigned int ui; @@ -90,7 +91,7 @@ int int_test(long l, int i, short s) { printf("long = %ld(%lX)\n",l,l); printf("int = %d(%X)\n",i,i); printf("short = %d(%X)\n",s,s); - + return l + i + s; } @@ -119,7 +120,7 @@ long ret_long(long a, long b) { } double test_testd(long i0, long i1, long i2, - long i3, long i4, long i5, + long i3, long i4, long i5, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, double d8, double d9, @@ -132,12 +133,12 @@ double test_testd(long i0, long i1, long i2, printf("%lf %lf %lf %lf\n", d4, d5, d6, d7); printf("%lf %lf\n", d8, d9); printf("%ld %ld\n", i6, i7); - + //return 0x1234; return 1.23456; } double test_testd2(long i0, long i1, long i2, - long i3, long i4, long i5, + long i3, long i4, long i5, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, double d8, double d9, double d10, @@ -150,14 +151,14 @@ double test_testd2(long i0, long i1, long i2, printf("%lf %lf %lf %lf\n", d4, d5, d6, d7); printf("%lf %lf %lf\n", d8, d9, d10); printf("%ld %ld\n", i6, i7); - + //return 0x1234; return 1.23456; } static long (*g)(); static double (*gf) (long i0, long i1, long i2, - long i3, long i4, long i5, + long i3, long i4, long i5, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, double d8, double d9, @@ -172,7 +173,7 @@ long set_ifunc(long (*f) ()) long set_ffunc(double (*f) ()) { gf = (double (*) (long i0, long i1, long i2, - long i3, long i4, long i5, + long i3, long i4, long i5, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, double d8, double d9, @@ -214,3 +215,4 @@ long get_size_of_long() { long get_size_of_int() { return (sizeof(int)); } +} From 21ff8e4dc8945f319e9386e2f8265ca1b8cf0580 Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Tue, 2 Jun 2020 20:46:45 +0900 Subject: [PATCH 02/17] rename test-foreign-module.l to test-foreign.module_l, not to capture by test/*.l at test.sh --- .travis.sh | 9 -------- test/test-foreign.l | 21 ++++++++++--------- ...foreign-module.l => test-foreign.module_l} | 2 ++ 3 files changed, 13 insertions(+), 19 deletions(-) rename test/{test-foreign-module.l => test-foreign.module_l} (91%) diff --git a/.travis.sh b/.travis.sh index 5a5f94ff4..fc1373c96 100755 --- a/.travis.sh +++ b/.travis.sh @@ -301,15 +301,6 @@ fi [ $EXIT_STATUS == 0 ] || exit 1 -travis_time_start eus64.test - -if [[ "$TRAVIS_OS_NAME" == "osx" || "`uname -m`" == "arm"* ]]; then - uname -a -else - make -C eus/contrib/eus64-check/ || exit 1 # check eus64-check -fi -travis_time_end - if [ "$TRAVIS_OS_NAME" == "linux" -a "`uname -m`" == "x86_64" ]; then travis_time_start script.doc diff --git a/test/test-foreign.l b/test/test-foreign.l index 4320e62b3..18abb8ae1 100644 --- a/test/test-foreign.l +++ b/test/test-foreign.l @@ -1,4 +1,4 @@ -(load "test-foreign-module.l") +(eval-when (load eval) (load "test-foreign.module_l")) (require :unittest "lib/llib/unittest.l") (init-unit-test) @@ -50,7 +50,7 @@ test-testd = 1.23456 (assert (eps= 1.23456 ret)) ;; - (setq f (piped-fork "eusg test-foreign-module.l '(progn (test-testd 100 101 102 103 104 105 1000.000000 1010.000000 1020.000000 1030.000000 1040.000000 1050.000000 1060.000000 1070.000000 2080.000000 2090.000000 206 207)(exit 0))'")) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (test-testd 100 101 102 103 104 105 1000.000000 1010.000000 1020.000000 1030.000000 1040.000000 1050.000000 1060.000000 1070.000000 2080.000000 2090.000000 206 207)(exit 0))'" *eusdir*))) (assert (string= (read-line f) "100 101 102")) (assert (string= (read-line f) "103 104 105")) (assert (string= (read-line f) "1000.000000 1010.000000 1020.000000 1030.000000")) @@ -74,7 +74,7 @@ test-testd = 1.23456 (float3-test 0 0.1 0.2 0.3 0.4) ;; - (setq f (piped-fork "eusg test-foreign-module.l '(progn (float-test 0 0.1 0.2 0.3 0.4)(exit 0))'")) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (float-test 0 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.1)) ;; skip first 2 character (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.2)) (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.3)) @@ -96,12 +96,12 @@ test-testd = 1.23456 (double3-test 1 0.1 0.2 0.3 0.4) ;; - (setq f (piped-fork "eusg test-foreign-module.l '(progn (double-test 1 0.1 0.2 0.3 0.4)(exit 0))'")) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (double-test 1 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.1)) ;; skip first 2 character (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.2)) (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.3)) (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.4)) - (setq f (piped-fork "eusg test-foreign-module.l '(progn (double3-test 1 0.1 0.2 0.3 0.4)(exit 0))'")) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (double3-test 1 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.1)) ;; skip first 2 character (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.2)) (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.3)) @@ -128,7 +128,7 @@ test-testd = 1.23456 (lv-test (length iv) iv) ;; - (setq f (piped-fork "eusg test-foreign-module.l '(progn (setq iv (integer-vector 0 100 10000 1000000 100000000 10000000000))(lv-test (length iv) iv)(exit 0))'")) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (setq iv (integer-vector 0 100 10000 1000000 100000000 10000000000))(lv-test (length iv) iv)(exit 0))'" *eusdir*))) (assert (string= (read-line f) "size = 6")) (assert (string= (read-line f) "0: 0 0")) (assert (string= (read-line f) "1: 100 64")) @@ -157,7 +157,7 @@ test-testd = 1.23456 (dv-test (length fv) fv) ;; - (setq f (piped-fork "eusg test-foreign-module.l '(progn (setq fv (float-vector 0.1 0.2 0.3 0.5 0.7))(dv-test (length fv) fv)(exit 0))'")) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (setq fv (float-vector 0.1 0.2 0.3 0.5 0.7))(dv-test (length fv) fv)(exit 0))'" *eusdir*))) (assert (string= (read-line f) "size = 5")) (assert (string= (read-line f) "0: 1.000000e-01 3FB9999999999998")) (assert (string= (read-line f) "1: 2.000000e-01 3FC9999999999998")) @@ -174,7 +174,7 @@ test-testd = 1.23456 (format t "~%str-test(exec in eus)~%") (str-test (length str) str) ;; - (setq f (piped-fork "eusg test-foreign-module.l '(progn (setq str \"input : test64 string\")(str-test (length str) str)(exit 0))'")) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (setq str \"input : test64 string\")(str-test (length str) str)(exit 0))'" *eusdir*))) (assert (string= (read-line f) (format nil "size = ~d" (length str)))) (dotimes (i (length str)) (assert (string= (read-line f) (format nil "~d: ~c ~x" i (elt str i) (elt str i)))) @@ -245,5 +245,6 @@ test-testd = 1.23456 (format t "call-ffunc = ~A~%" (call-ffunc)) |# -(run-all-tests) -(exit) +(eval-when (load eval) + (run-all-tests) + (exit)) diff --git a/test/test-foreign-module.l b/test/test-foreign.module_l similarity index 91% rename from test/test-foreign-module.l rename to test/test-foreign.module_l index 008768aeb..bd7b310df 100644 --- a/test/test-foreign-module.l +++ b/test/test-foreign.module_l @@ -1,9 +1,11 @@ (unless (boundp '*testmod*) (setq *testmod* (load-foreign "test_foreign.so")) (defforeign float-test *testmod* "float_test" (:integer :float32 :float32 :float32 :float32) :integer) + (defforeign float1-test *testmod* "float_test" (:integer :float :float :float :float) :integer) (defforeign float2-test *testmod* "float_test" (:integer :double :double :double :double) :integer) (defforeign float3-test *testmod* "float_test" () :integer) (defforeign double-test *testmod* "double_test" (:integer :double :double :double :double) :integer) + (defforeign double1-test *testmod* "double_test" (:integer :float :float :float :float) :integer) (defforeign double2-test *testmod* "double_test" (:integer :float32 :float32 :float32 :float32) :integer) (defforeign double3-test *testmod* "double_test" () :integer) (defforeign iv-test *testmod* "iv_test" () :integer) From e0e2a282fec47481333766661a3d04a06738a4ef Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Wed, 3 Jun 2020 00:15:00 +0900 Subject: [PATCH 03/17] update more tests in test-foreign --- test/test-foreign.l | 364 ++++++++++++++++++++++++++++++++----- test/test-foreign.module_l | 18 +- test/test_foreign.c | 163 ++++++++++++++++- 3 files changed, 492 insertions(+), 53 deletions(-) diff --git a/test/test-foreign.l b/test/test-foreign.l index 18abb8ae1..bbdcf2955 100644 --- a/test/test-foreign.l +++ b/test/test-foreign.l @@ -3,6 +3,29 @@ (init-unit-test) +(defun check-func (f) + (warning-message 3 "~A [paramtypes] ~A, [result] ~A~%" + (send f :pname) + (cdr (assoc 'paramtypes (send (send f :func) :slots))) + (cdr (assoc 'resulttype (send (send f :func) :slots))))) + +(defun assert-read-line-eps= (s ret) + (let (l) + (setq l (read-line s)) + (warning-message 2 "check read-line ~A -> ~A = ~A~%" l (subseq l 2) ret) + (assert (eps= (read-from-string (subseq l 2)) ret)))) + +(defun assert-read-line-string= (s ret &optional (f #'identity)) + (let (l) + (setq l (read-line s)) + (warning-message 2 "check read-line ~A -> ~A = ~A~%" l l ret) + (assert (string= l ret)))) + +(defun assert-read-funcall= (f ret) + (let () + (warning-message 2 "check ~A -> ~A = ~A~%" f (eval f) ret) + (assert (eps= (eval f) ret)))) + (deftest test-pointer-size (format t "~%;;;; pointer size check ;;;;~%") @@ -26,6 +49,14 @@ (format t "float size ~D ~D~%" lisp::sizeof-float (get-size-float32)) (assert (= lisp::sizeof-float (get-size-float32))) + + (format t "eusinteger size ~D ~D~%" + lisp::sizeof-* (get-size-eusfloat)) + (assert (= lisp::sizeof-* (get-size-eusfloat))) + + (format t "eusfloat size ~D ~D~%" + lisp::sizeof-* (get-size-eusinteger)) + (assert (= lisp::sizeof-* (get-size-eusinteger))) ) (deftest test-multiple-arguments-passing @@ -51,12 +82,69 @@ test-testd = 1.23456 ;; (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (test-testd 100 101 102 103 104 105 1000.000000 1010.000000 1020.000000 1030.000000 1040.000000 1050.000000 1060.000000 1070.000000 2080.000000 2090.000000 206 207)(exit 0))'" *eusdir*))) - (assert (string= (read-line f) "100 101 102")) - (assert (string= (read-line f) "103 104 105")) - (assert (string= (read-line f) "1000.000000 1010.000000 1020.000000 1030.000000")) - (assert (string= (read-line f) "1040.000000 1050.000000 1060.000000 1070.000000")) - (assert (string= (read-line f) "2080.000000 2090.000000")) - (assert (string= (read-line f) "206 207")) + (assert-read-line-string= f "100 101 102") + (assert-read-line-string= f "103 104 105") + (assert-read-line-string= f "1000.000000 1010.000000 1020.000000 1030.000000") + (assert-read-line-string= f "1040.000000 1050.000000 1060.000000 1070.000000") + (assert-read-line-string= f "2080.000000 2090.000000") + (assert-read-line-string= f "206 207") + ) + +(deftest test-int-test + (format t "~%~%int-test~%") + (format t "expected result~%") + (format t "0: 1 1~%") + (format t "0: 2 2~%") + (format t "0: 3 3~%") + (format t "0: 4 4~%") + (format t "~%int-test(success, exec in eus)~%") + (check-func 'int-test) + (int-test 0 1 2 3 4) + ;; + (check-func 'int-test) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (int-test 0 1 2 3 4)(exit 0))'" *eusdir*))) + (assert-read-line-string= f "0: 1 1") + (assert-read-line-string= f "0: 2 2") + (assert-read-line-string= f "0: 3 3") + (assert-read-line-string= f "0: 4 4") + ) + +(deftest test-long-test + (format t "~%~%long-test~%") + (format t "expected result~%") + (format t "0: 1 1~%") + (format t "0: 2 2~%") + (format t "0: 3 3~%") + (format t "0: 4 4~%") + (format t "~%long-test(success, exec in eus)~%") + (check-func 'long-test) + (long-test 0 1 2 3 4) + ;; + (check-func 'long-test) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (long-test 0 1 2 3 4)(exit 0))'" *eusdir*))) + (assert-read-line-string= f "0: 1 1") + (assert-read-line-string= f "0: 2 2") + (assert-read-line-string= f "0: 3 3") + (assert-read-line-string= f "0: 4 4") + ) + +(deftest test-eusinteger-test + (format t "~%~%eusinteger-test~%") + (format t "expected result~%") + (format t "0: 1 1~%") + (format t "0: 2 2~%") + (format t "0: 3 3~%") + (format t "0: 4 4~%") + (format t "~%eusinteger-test(success, exec in eus)~%") + (check-func 'eusinteger-test) + (eusinteger-test 0 1 2 3 4) + ;; + (check-func 'eusinteger-test) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (eusinteger-test 0 1 2 3 4)(exit 0))'" *eusdir*))) + (assert-read-line-string= f "0: 1 1") + (assert-read-line-string= f "0: 2 2") + (assert-read-line-string= f "0: 3 3") + (assert-read-line-string= f "0: 4 4") ) (deftest test-float-test @@ -67,18 +155,33 @@ test-testd = 1.23456 (format t "0: 3.000000e-01 ..~%") (format t "0: 4.000000e-01 ..~%") (format t "~%float-test(success, exec in eus)~%") + (check-func 'float-test) (float-test 0 0.1 0.2 0.3 0.4) + (format t "~%float1-test(success, exec in eus)~%") + (check-func 'float1-test) + (float1-test 0 0.1 0.2 0.3 0.4) (format t "~%float2-test(fail, exec in eus)~%") + (check-func 'float2-test) (float2-test 0 0.1 0.2 0.3 0.4) (format t "~%float3-test(depend on architecture, exec in eus)~%") + (check-func 'float3-test) (float3-test 0 0.1 0.2 0.3 0.4) ;; + (check-func 'float-test) (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (float-test 0 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) - (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.1)) ;; skip first 2 character - (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.2)) - (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.3)) - (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.4)) + (assert-read-line-eps= f 0.1) + (assert-read-line-eps= f 0.2) + (assert-read-line-eps= f 0.3) + (assert-read-line-eps= f 0.4) + + (when (memq :word-size=32 *features*) + (check-func 'float1-test) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (float1-test 0 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) + (assert-read-line-eps= f 0.1) + (assert-read-line-eps= f 0.2) + (assert-read-line-eps= f 0.3) + (assert-read-line-eps= f 0.4)) ) (deftest test-double-test @@ -89,33 +192,101 @@ test-testd = 1.23456 (format t "1: 3.000000e-01 ..~%") (format t "1: 4.000000e-01 ..~%") (format t "~%double-test(success, exec in eus)~%") + (check-func 'double-test) (double-test 1 0.1 0.2 0.3 0.4) + (format t "~%double1-test(fail, exec in eus)~%") + (check-func 'double1-test) + (double1-test 1 0.1 0.2 0.3 0.4) (format t "~%double2-test(fail, exec in eus)~%") + (check-func 'double2-test) (double2-test 1 0.1 0.2 0.3 0.4) (format t "~%double3-test(depend on architecture, exec in eus)~%") + (check-func 'double3-test) (double3-test 1 0.1 0.2 0.3 0.4) ;; + (check-func 'double-test) (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (double-test 1 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) - (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.1)) ;; skip first 2 character - (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.2)) - (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.3)) - (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.4)) + (assert-read-line-eps= f 0.1) + (assert-read-line-eps= f 0.2) + (assert-read-line-eps= f 0.3) + (assert-read-line-eps= f 0.4) + (check-func 'double3-test) (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (double3-test 1 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) - (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.1)) ;; skip first 2 character - (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.2)) - (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.3)) - (assert (eps= (read-from-string (subseq (read-line f) 2)) 0.4)) + (assert-read-line-eps= f 0.1) + (assert-read-line-eps= f 0.2) + (assert-read-line-eps= f 0.3) + (assert-read-line-eps= f 0.4) + ) + +(deftest test-eusfloat-test + (format t "~%~%eusfloat-test~%") + (format t "expected result~%") + (format t "0: 1.000000e-01 ..~%") + (format t "0: 2.000000e-01 ..~%") + (format t "0: 3.000000e-01 ..~%") + (format t "0: 4.000000e-01 ..~%") + (format t "~%eusfloat-test(fail, exec in eus)~%") + (check-func 'eusfloat-test) + (eusfloat-test 0 0.1 0.2 0.3 0.4) + (format t "~%eusfloat1-test(success, exec in eus)~%") + (check-func 'eusfloat1-test) + (eusfloat1-test 0 0.1 0.2 0.3 0.4) + (format t "~%eusfloat2-test(success, exec in eus)~%") + (check-func 'eusfloat2-test) + (eusfloat2-test 0 0.1 0.2 0.3 0.4) + (format t "~%eusfloat3-test(success, exec in eus)~%") + (check-func 'eusfloat3-test) + (eusfloat3-test 0 0.1 0.2 0.3 0.4) + + ;; + (when (memq :word-size=32 *features*) + (check-func 'eusfloat-test) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (eusfloat-test 0 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) + (assert-read-line-eps= f 0.1) + (assert-read-line-eps= f 0.2) + (assert-read-line-eps= f 0.3) + (assert-read-line-eps= f 0.4)) + + (check-func 'eusfloat1-test) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (eusfloat1-test 0 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) + (assert-read-line-eps= f 0.1) + (assert-read-line-eps= f 0.2) + (assert-read-line-eps= f 0.3) + (assert-read-line-eps= f 0.4) + + (when (memq :word-size=64 *features*) + (check-func 'eusfloat2-test) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (eusfloat2-test 0 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) + (assert-read-line-eps= f 0.1) + (assert-read-line-eps= f 0.2) + (assert-read-line-eps= f 0.3) + (assert-read-line-eps= f 0.4) + + (check-func 'eusfloat3-test) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (eusfloat3-test 0 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) + (assert-read-line-eps= f 0.1) + (assert-read-line-eps= f 0.2) + (assert-read-line-eps= f 0.3) + (assert-read-line-eps= f 0.4)) + ) (deftest test-integer-vector (setq iv (integer-vector 0 100 10000 1000000 100000000 10000000000)) - #| + (format t "~%iv-test~%") - (format t "expected result~%") - (format t "exec in eus64~%") + (format t "size = 6 +0: 0 0 +1: 100 64 +2: 10000 2710 +3: 1000000 F4240 +4: 100000000 5F5E100 +5: 10000000000 2540BE400~%") + (format t "~%iv-test(fail, exec in eus)~%") + (check-func 'iv-test) (iv-test (length iv) iv) - |# + (format t "~%lv-test~%") (format t "size = 6 0: 0 0 @@ -125,26 +296,59 @@ test-testd = 1.23456 4: 100000000 5F5E100 5: 10000000000 2540BE400~%") (format t "~%lv-test(exec in eus)~%") + (check-func 'lv-test) (lv-test (length iv) iv) ;; + (check-func 'lv-test) (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (setq iv (integer-vector 0 100 10000 1000000 100000000 10000000000))(lv-test (length iv) iv)(exit 0))'" *eusdir*))) - (assert (string= (read-line f) "size = 6")) - (assert (string= (read-line f) "0: 0 0")) - (assert (string= (read-line f) "1: 100 64")) - (assert (string= (read-line f) "2: 10000 2710")) - (assert (string= (read-line f) "3: 1000000 F4240")) - (assert (string= (read-line f) "4: 100000000 5F5E100")) - (assert (string= (read-line f) "5: 10000000000 2540BE400")) + (assert-read-line-string= f "size = 6") + (assert-read-line-string= f "0: 0 0") + (assert-read-line-string= f "1: 100 64") + (assert-read-line-string= f "2: 10000 2710") + (assert-read-line-string= f "3: 1000000 F4240") + (assert-read-line-string= f "4: 100000000 5F5E100") + (when (memq :word-size=64 *features*) + (assert-read-line-string= f "5: 10000000000 2540BE400")) + + (format t "~%eiv-test~%") + (format t "size = 6 +0: 0 0 +1: 100 64 +2: 10000 2710 +3: 1000000 F4240 +4: 100000000 5F5E100 +5: 10000000000 2540BE400~%") + (format t "~%lv-test(exec in eus)~%") + (check-func 'eiv-test) + (eiv-test (length iv) iv) + + ;; + (check-func 'eiv-test) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (setq iv (integer-vector 0 100 10000 1000000 100000000 10000000000))(eiv-test (length iv) iv)(exit 0))'" *eusdir*))) + (assert-read-line-string= f "size = 6") + (assert-read-line-string= f "0: 0 0") + (assert-read-line-string= f "1: 100 64") + (assert-read-line-string= f "2: 10000 2710") + (assert-read-line-string= f "3: 1000000 F4240") + (assert-read-line-string= f "4: 100000000 5F5E100") + (when (memq :word-size=64 *features*) + (assert-read-line-string= f "5: 10000000000 2540BE400")) ) (deftest test-float-vector (setq fv (float-vector 0.1 0.2 0.3 0.5 0.7)) - #| + (format t "~%fv-test~%") - (format t "exec in eus64~%") + (format t "size = 5 +0: 1.000000e-01 3FB9999999999998 +1: 2.000000e-01 3FC9999999999998 +2: 3.000000e-01 3FD3333333333330 +3: 5.000000e-01 3FE0000000000000 +4: 7.000000e-01 3FE6666666666664~%") + (format t "~%fv-test(exec in eus)~%") + (check-func 'fv-test) (fv-test (length fv) fv) - |# (format t "~%dv-test~%") (format t "size = 5 @@ -154,16 +358,42 @@ test-testd = 1.23456 3: 5.000000e-01 3FE0000000000000 4: 7.000000e-01 3FE6666666666664~%") (format t "~%dv-test(exec in eus)~%") + (check-func 'dv-test) (dv-test (length fv) fv) ;; - (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (setq fv (float-vector 0.1 0.2 0.3 0.5 0.7))(dv-test (length fv) fv)(exit 0))'" *eusdir*))) - (assert (string= (read-line f) "size = 5")) - (assert (string= (read-line f) "0: 1.000000e-01 3FB9999999999998")) - (assert (string= (read-line f) "1: 2.000000e-01 3FC9999999999998")) - (assert (string= (read-line f) "2: 3.000000e-01 3FD3333333333330")) - (assert (string= (read-line f) "3: 5.000000e-01 3FE0000000000000")) - (assert (string= (read-line f) "4: 7.000000e-01 3FE6666666666664")) + (when (memq :word-size=64 *features*) + (check-func 'dv-test) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (setq fv (float-vector 0.1 0.2 0.3 0.5 0.7))(dv-test (length fv) fv)(exit 0))'" *eusdir*))) + (assert-read-line-string= f "size = 5") + (assert-read-line-string= f "0: 1.000000e-01 3FB9999999999998") + (assert-read-line-string= f "1: 2.000000e-01 3FC9999999999998") + (assert-read-line-string= f "2: 3.000000e-01 3FD3333333333330") + (assert-read-line-string= f "3: 5.000000e-01 3FE0000000000000") + (assert-read-line-string= f "4: 7.000000e-01 3FE6666666666664")) + + ;; + (format t "~%efv-test~%") + (format t "size = 5 +0: 1.000000e-01 3FB9999999999998 +1: 2.000000e-01 3FC9999999999998 +2: 3.000000e-01 3FD3333333333330 +3: 5.000000e-01 3FE0000000000000 +4: 7.000000e-01 3FE6666666666664~%") + (format t "~%efv-test(exec in eus)~%") + (check-func 'efv-test) + (efv-test (length fv) fv) + + ;; + (check-func 'efv-test) + (when (memq :word-size=64 *features*) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (setq fv (float-vector 0.1 0.2 0.3 0.5 0.7))(efv-test (length fv) fv)(exit 0))'" *eusdir*))) + (assert-read-line-string= f "size = 5") + (assert-read-line-string= f "0: 1.000000e-01 3FB9999999999998") + (assert-read-line-string= f "1: 2.000000e-01 3FC9999999999998") + (assert-read-line-string= f "2: 3.000000e-01 3FD3333333333330") + (assert-read-line-string= f "3: 5.000000e-01 3FE0000000000000") + (assert-read-line-string= f "4: 7.000000e-01 3FE6666666666664")) ) (deftest test-string-test @@ -172,15 +402,29 @@ test-testd = 1.23456 ;;(format t "expected result~%") (format t "input string : ~S~%" str) (format t "~%str-test(exec in eus)~%") + (check-func 'str-test) (str-test (length str) str) ;; + (check-func 'str-test) (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (setq str \"input : test64 string\")(str-test (length str) str)(exit 0))'" *eusdir*))) - (assert (string= (read-line f) (format nil "size = ~d" (length str)))) + (assert-read-line-string= f (format nil "size = ~d" (length str))) (dotimes (i (length str)) - (assert (string= (read-line f) (format nil "~d: ~c ~x" i (elt str i) (elt str i)))) + (assert-read-line-string= f (format nil "~d: ~c ~x" i (elt str i) (elt str i))) ) ) +(deftest test-return-float + (format t "~%return float test~%") + (format t "expected result~%") + (format t " ret-float ~8,8e~%" (+ 0.55555 133.0)) + (format t "~%ret-float(exec in eus)~%") + (format t " ret-float ~8,8e~%" (ret-float 0.55555 133.0)) + ;; + (check-func 'ret-float) + (assert-read-funcall= '(ret-float 0.55555 133.0) (+ 0.55555 133.0)) + (assert (eps= (ret-float 0.55555 133.0) (+ 0.55555 133.0))) + ) + (deftest test-return-double (format t "~%return double test~%") (format t "expected result~%") @@ -188,9 +432,34 @@ test-testd = 1.23456 (format t "~%ret-double(exec in eus)~%") (format t " ret-double ~8,8e~%" (ret-double 0.55555 133.0)) ;; + (check-func 'ret-double) + (assert-read-funcall= '(ret-double 0.55555 133.0) (+ 0.55555 133.0)) (assert (eps= (ret-double 0.55555 133.0) (+ 0.55555 133.0))) ) +(deftest test-return-eusfloat + (format t "~%return eusfloat test~%") + (format t "expected result~%") + (format t " ret-eusfloat ~8,8e~%" (+ 0.55555 133.0)) + (format t "~%ret-eusfloat(exec in eus)~%") + (format t " ret-eusfloat ~8,8e~%" (ret-eusfloat 0.55555 133.0)) + ;; + (check-func 'ret-eusfloat) + (assert-read-funcall= '(ret-eusfloat 0.55555 133.0) (+ 0.55555 133.0)) + (assert (eps= (ret-eusfloat 0.55555 133.0) (+ 0.55555 133.0))) + ) + +(deftest test-return-int + (format t "~%return int test~%") + (format t "expected result~%") + (format t " ret-int ~D~%" (+ 123 645000)) + (format t "~%ret-int(exec in eus)~%") + (format t " ret-int ~D~%" (ret-int 123 645000)) + + (check-func 'ret-int) + (assert (= (ret-int 123 645000) (+ 123 645000))) + ) + (deftest test-return-long (format t "~%return long test~%") (format t "expected result~%") @@ -198,8 +467,21 @@ test-testd = 1.23456 (format t "~%ret-long(exec in eus)~%") (format t " ret-long ~D~%" (ret-long 123 645000)) + (check-func 'ret-long) (assert (= (ret-long 123 645000) (+ 123 645000))) ) + +(deftest test-return-eusinteger + (format t "~%return eusinteger test~%") + (format t "expected result~%") + (format t " ret-eusinteger ~D~%" (+ 123 645000)) + (format t "~%ret-eusinteger(exec in eus)~%") + (format t " ret-eusinteger ~D~%" (ret-eusinteger 123 645000)) + + (check-func 'ret-eusinteger) + (assert (= (ret-eusinteger 123 645000) (+ 123 645000))) + ) + #| ;; ret-int ;; ret-short diff --git a/test/test-foreign.module_l b/test/test-foreign.module_l index bd7b310df..13ad1438d 100644 --- a/test/test-foreign.module_l +++ b/test/test-foreign.module_l @@ -1,22 +1,34 @@ (unless (boundp '*testmod*) (setq *testmod* (load-foreign "test_foreign.so")) + (defforeign int-test *testmod* "int_test" (:integer :integer :integer :integer :integer) :integer) + (defforeign long-test *testmod* "long_test" (:integer :integer :integer :integer :integer) :integer) + (defforeign eusinteger-test *testmod* "eusinteger_test" (:integer :integer :integer :integer :integer) :integer) (defforeign float-test *testmod* "float_test" (:integer :float32 :float32 :float32 :float32) :integer) (defforeign float1-test *testmod* "float_test" (:integer :float :float :float :float) :integer) (defforeign float2-test *testmod* "float_test" (:integer :double :double :double :double) :integer) (defforeign float3-test *testmod* "float_test" () :integer) + (defforeign eusfloat-test *testmod* "eusfloat_test" (:integer :float32 :float32 :float32 :float32) :integer) + (defforeign eusfloat1-test *testmod* "eusfloat_test" (:integer :float :float :float :float) :integer) + (defforeign eusfloat2-test *testmod* "eusfloat_test" (:integer :double :double :double :double) :integer) + (defforeign eusfloat3-test *testmod* "eusfloat_test" () :integer) (defforeign double-test *testmod* "double_test" (:integer :double :double :double :double) :integer) (defforeign double1-test *testmod* "double_test" (:integer :float :float :float :float) :integer) (defforeign double2-test *testmod* "double_test" (:integer :float32 :float32 :float32 :float32) :integer) (defforeign double3-test *testmod* "double_test" () :integer) (defforeign iv-test *testmod* "iv_test" () :integer) (defforeign lv-test *testmod* "lv_test" () :integer) + (defforeign eiv-test *testmod* "eiv_test" () :integer) (defforeign fv-test *testmod* "fv_test" () :integer) (defforeign dv-test *testmod* "dv_test" () :integer) + (defforeign efv-test *testmod* "efv_test" () :integer) (defforeign str-test *testmod* "str_test" () :integer) (defforeign int-test *testmod* "int_test" () :integer) - (defforeign ret-float *testmod* "ret_float" () :float32) - (defforeign ret-double *testmod* "ret_double" () :float) + (defforeign ret-float *testmod* "ret_float" (:float32 :float32) :float32) + (defforeign ret-double *testmod* "ret_double" (:double :double) :float) + (defforeign ret-eusfloat *testmod* "ret_eusfloat" (:float :float) :float) + (defforeign ret-int *testmod* "ret_int" () :integer) (defforeign ret-long *testmod* "ret_long" () :integer) + (defforeign ret-eusinteger *testmod* "ret_eusinteger" () :integer) (defforeign set-ifunc *testmod* "set_ifunc" (:integer) :integer) (defforeign set-ffunc *testmod* "set_ffunc" (:integer) :integer) @@ -35,4 +47,6 @@ (defforeign get-size-double *testmod* "get_size_of_double" () :integer) (defforeign get-size-long *testmod* "get_size_of_long" () :integer) (defforeign get-size-int *testmod* "get_size_of_int" () :integer) + (defforeign get-size-eusinteger *testmod* "get_size_of_eusinteger" () :integer) + (defforeign get-size-eusfloat *testmod* "get_size_of_eusfloat" () :integer) ) diff --git a/test/test_foreign.c b/test/test_foreign.c index a53b2cb19..1202359d6 100644 --- a/test/test_foreign.c +++ b/test/test_foreign.c @@ -1,19 +1,85 @@ +// for eus.h #include +#include #include +#include +#include +#include +#include + +#define class eus_class +#define throw eus_throw +#define export eus_export +#define vector eus_vector +#define string eus_string +#include // include eus.h just for eusfloat_t ... +#undef class +#undef throw +#undef export +#undef vector +#undef string extern "C" { +int int_test(int n, int i1, int i2, int i3, int i4) { + unsigned int ui; + + //printf("int_test in c\n"); + ui = *((unsigned int *)(&i1)); + printf("%d: %8d %X\n", n, i1, ui); + ui = *((unsigned int *)(&i2)); + printf("%d: %8d %X\n", n, i2, ui); + ui = *((unsigned int *)(&i3)); + printf("%d: %8d %X\n", n, i3, ui); + ui = *((unsigned int *)(&i4)); + printf("%d: %8d %X\n", n, i4, ui); + + return -1; +} + +int long_test(long n, long d1, long d2, long d3, long d4) { + unsigned long ul; + + //printf("long_test in c\n"); + ul = *((unsigned long *)(&d1)); + printf("%d: %8d %X\n", n, d1, ul); + ul = *((unsigned long *)(&d2)); + printf("%d: %8d %X\n", n, d2, ul); + ul = *((unsigned long *)(&d3)); + printf("%d: %8d %X\n", n, d3, ul); + ul = *((unsigned long *)(&d4)); + printf("%d: %8d %X\n", n, d4, ul); + + return -1; +} + +int eusinteger_test(int n, eusinteger_t i1, eusinteger_t i2, eusinteger_t i3, eusinteger_t i4) { + unsigned long ul; + + //printf("eusinteger_test in c\n"); + ul = *((unsigned int *)(&i1)); + printf("%d: %8d %X\n", n, i1, ul); + ul = *((unsigned int *)(&i2)); + printf("%d: %8d %X\n", n, i2, ul); + ul = *((unsigned int *)(&i3)); + printf("%d: %8d %X\n", n, i3, ul); + ul = *((unsigned int *)(&i4)); + printf("%d: %8d %X\n", n, i4, ul); + + return -1; +} + int float_test(int n, float f1, float f2, float f3, float f4) { unsigned int ui; //printf("float_test in c\n"); ui = *((unsigned int *)(&f1)); - printf("%d: %8.8e %X\n", n, f1, ui); + printf("%d: %8.8e %X (%4.1f)\n", n, f1, ui, f1); ui = *((unsigned int *)(&f2)); - printf("%d: %8.8e %X\n", n, f2, ui); + printf("%d: %8.8e %X (%4.1f)\n", n, f2, ui, f2); ui = *((unsigned int *)(&f3)); - printf("%d: %8.8e %X\n", n, f3, ui); + printf("%d: %8.8e %X (%4.1f)\n", n, f3, ui, f3); ui = *((unsigned int *)(&f4)); - printf("%d: %8.8e %X\n", n, f4, ui); + printf("%d: %8.8e %X (%4.1f)\n", n, f4, ui, f4); return -1; } @@ -23,13 +89,29 @@ int double_test(long n, double d1, double d2, double d3, double d4) { //printf("double_test in c\n"); ul = *((unsigned long *)(&d1)); - printf("%ld: %16.16e %lX\n", n, d1, ul); + printf("%ld: %16.16e %lX (%4.1f)\n", n, d1, ul, d1); ul = *((unsigned long *)(&d2)); - printf("%ld: %16.16e %lX\n", n, d2, ul); + printf("%ld: %16.16e %lX (%4.1f)\n", n, d2, ul, d2); ul = *((unsigned long *)(&d3)); - printf("%ld: %16.16e %lX\n", n, d3, ul); + printf("%ld: %16.16e %lX (%4.1f)\n", n, d3, ul, d3); ul = *((unsigned long *)(&d4)); - printf("%ld: %16.16e %lX\n", n, d4, ul); + printf("%ld: %16.16e %lX (%4.1f)\n", n, d4, ul, d4); + + return -1; +} + +int eusfloat_test(int n, eusfloat_t f1, eusfloat_t f2, eusfloat_t f3, eusfloat_t f4) { + unsigned int ui; + + //printf("float_test in c\n"); + ui = *((unsigned int *)(&f1)); + printf("%d: %8.8e %X (%4.1f)\n", n, f1, ui, f1); + ui = *((unsigned int *)(&f2)); + printf("%d: %8.8e %X (%4.1f)\n", n, f2, ui, f2); + ui = *((unsigned int *)(&f3)); + printf("%d: %8.8e %X (%4.1f)\n", n, f3, ui, f3); + ui = *((unsigned int *)(&f4)); + printf("%d: %8.8e %X (%4.1f)\n", n, f4, ui, f4); return -1; } @@ -56,6 +138,17 @@ int lv_test(int n, long *src) { return -1; } +int eiv_test(int n, eusinteger_t *src) { + eusinteger_t i; + unsigned long *ul; + printf("size = %d\n", n); + for(i=0;i %f\n", a, b, ret); printf("// return %e, %X\n", ret, *ui); return ret; } @@ -107,14 +212,43 @@ double ret_double(double a, double b) { double ret = (a + b); unsigned long *ul; ul = (unsigned long *)&ret; + printf("// %f + %f -> %f\n", a, b, ret); printf("// return %e, %lX\n", ret, *ul); return ret; } +eusfloat_t ret_eusfloat(eusfloat_t a, eusfloat_t b) { + eusfloat_t ret = (a + b); + unsigned long *ul; + ul = (unsigned long *)&ret; + printf("// %f + %f -> %f\n", a, b, ret); + printf("// return %e, %lX\n", ret, *ul); + return ret; +} + +int ret_int(int a, int b) { + int ret = a + b; + unsigned long *ul; + ul = (unsigned long *)&ret; + printf("// %d + %d -> %d\n", a, b, ret); + printf("// return %ld, %lX\n", ret, *ul); + return ret; +} + long ret_long(long a, long b) { long ret = a + b; unsigned long *ul; ul = (unsigned long *)&ret; + printf("// %d + %d -> %d\n", a, b, ret); + printf("// return %ld, %lX\n", ret, *ul); + return ret; +} + +eusinteger_t ret_eusinteger(eusinteger_t a, eusinteger_t b) { + eusinteger_t ret = a + b; + unsigned long *ul; + ul = (unsigned long *)&ret; + printf("// %d + %d -> %d\n", a, b, ret); printf("// return %ld, %lX\n", ret, *ul); return ret; } @@ -215,4 +349,13 @@ long get_size_of_long() { long get_size_of_int() { return (sizeof(int)); } + +long get_size_of_eusinteger() { + return (sizeof(eusinteger_t)); +} + +long get_size_of_eusfloat() { + return (sizeof(eusfloat_t)); } + +}; From 536f3ec08ce8cf71ab09a2e5c850220ae7527b5c Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Wed, 3 Jun 2020 00:17:21 +0900 Subject: [PATCH 04/17] fox call_foregin for 32bit machine (i386) --- lisp/c/eval.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/c/eval.c b/lisp/c/eval.c index 1602e5940..ed9fd10ce 100644 --- a/lisp/c/eval.c +++ b/lisp/c/eval.c @@ -1018,10 +1018,10 @@ pointer args[]; else if (p==K_STRING) { if (elmtypeof(lisparg)==ELM_FOREIGN) cargv[i++]=lisparg->c.ivec.iv[0]; else cargv[i++]=(eusinteger_t)(lisparg->c.str.chars);} - else if (p==K_FLOAT32) { + else if (p==K_FLOAT32 || (WORD_SIZE==32 && p==K_FLOAT)) { numbox.f=ckfltval(lisparg); cargv[i++]=(int)numbox.i.i1;} - else if (p==K_DOUBLE || p==K_FLOAT) { + else if (p==K_DOUBLE || (WORD_SIZE==64 && p==K_FLOAT)) { numbox.d=ckfltval(lisparg); cargv[i++]=numbox.i.i1; cargv[i++]=numbox.i.i2;} else error(E_USER,(pointer)"unknown type specifier");} @@ -1049,7 +1049,7 @@ pointer args[]; #endif /* end of kanehiro's patch 2000.12.13 */ else cargv[i++]=(eusinteger_t)(lisparg->c.obj.iv);} /**/ - if (resulttype==K_FLOAT) { + if (resulttype==K_FLOAT || resulttype==K_FLOAT32) { if (i<=8) f=(*ffunc)(cargv[0],cargv[1],cargv[2],cargv[3], cargv[4],cargv[5],cargv[6],cargv[7]); From 0a6e1112152555036b97720608efe566bc6d4d61 Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Wed, 3 Jun 2020 07:28:41 +0000 Subject: [PATCH 05/17] update test code for arm/32bit --- test/test-foreign.l | 26 ++++++++++++++++++++++++++ test/test-foreign.module_l | 6 ++++++ test/test_foreign.c | 17 +++++++++++++++++ 3 files changed, 49 insertions(+) diff --git a/test/test-foreign.l b/test/test-foreign.l index bbdcf2955..63fbb9eb3 100644 --- a/test/test-foreign.l +++ b/test/test-foreign.l @@ -70,6 +70,7 @@ 206 207 test-testd = 1.23456 ~%") + (when (not (and (memq :word-size=32 *features*) (memq :arm *features*))) (format t "exec in eus~%") (format t "test-testd = ~A~%" (setq ret (test-testd 100 101 102 @@ -81,6 +82,7 @@ test-testd = 1.23456 (assert (eps= 1.23456 ret)) ;; + (check-func 'test-testd) (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (test-testd 100 101 102 103 104 105 1000.000000 1010.000000 1020.000000 1030.000000 1040.000000 1050.000000 1060.000000 1070.000000 2080.000000 2090.000000 206 207)(exit 0))'" *eusdir*))) (assert-read-line-string= f "100 101 102") (assert-read-line-string= f "103 104 105") @@ -90,6 +92,26 @@ test-testd = 1.23456 (assert-read-line-string= f "206 207") ) + (format t "exec in eus~%") + (format t "test-testf = ~A~%" + (setq ret (test-testf 100 101 102 + 103 104 105 + 1000.0 1010.0 1020.0 1030.0 + 1040.0 1050.0 1060.0 1070.0 + 2080.0 2090.0 + 206 207))) + (assert (eps= 1.23456 ret)) + ;; + (check-func 'test-testf) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (test-testf 100 101 102 103 104 105 1000.000000 1010.000000 1020.000000 1030.000000 1040.000000 1050.000000 1060.000000 1070.000000 2080.000000 2090.000000 206 207)(exit 0))'" *eusdir*))) + (assert-read-line-string= f "100 101 102") + (assert-read-line-string= f "103 104 105") + (assert-read-line-string= f "1000.000000 1010.000000 1020.000000 1030.000000") + (assert-read-line-string= f "1040.000000 1050.000000 1060.000000 1070.000000") + (assert-read-line-string= f "2080.000000 2090.000000") + (assert-read-line-string= f "206 207") + ) + (deftest test-int-test (format t "~%~%int-test~%") (format t "expected result~%") @@ -205,6 +227,7 @@ test-testd = 1.23456 (double3-test 1 0.1 0.2 0.3 0.4) ;; + (when (not (and (memq :word-size=32 *features*) (memq :arm *features*))) (check-func 'double-test) (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (double-test 1 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) (assert-read-line-eps= f 0.1) @@ -218,6 +241,7 @@ test-testd = 1.23456 (assert-read-line-eps= f 0.3) (assert-read-line-eps= f 0.4) ) + ) (deftest test-eusfloat-test (format t "~%~%eusfloat-test~%") @@ -432,10 +456,12 @@ test-testd = 1.23456 (format t "~%ret-double(exec in eus)~%") (format t " ret-double ~8,8e~%" (ret-double 0.55555 133.0)) ;; + (when (not (and (memq :word-size=32 *features*) (memq :arm *features*))) (check-func 'ret-double) (assert-read-funcall= '(ret-double 0.55555 133.0) (+ 0.55555 133.0)) (assert (eps= (ret-double 0.55555 133.0) (+ 0.55555 133.0))) ) + ) (deftest test-return-eusfloat (format t "~%return eusfloat test~%") diff --git a/test/test-foreign.module_l b/test/test-foreign.module_l index 13ad1438d..ddc531661 100644 --- a/test/test-foreign.module_l +++ b/test/test-foreign.module_l @@ -39,6 +39,12 @@ :double :double :double :double :double :double :integer :integer) :float) + (defforeign test-testf *testmod* "test_testf" (:integer :integer :integer + :integer :integer :integer + :float :float :float :float + :float :float :float :float + :float :float + :integer :integer) :float) (defforeign call-ifunc *testmod* "call_ifunc" () :integer) (defforeign call-ffunc *testmod* "call_ffunc" () :float) diff --git a/test/test_foreign.c b/test/test_foreign.c index 1202359d6..93952a74d 100644 --- a/test/test_foreign.c +++ b/test/test_foreign.c @@ -289,7 +289,24 @@ double test_testd2(long i0, long i1, long i2, //return 0x1234; return 1.23456; } +eusfloat_t test_testf(long i0, long i1, long i2, + long i3, long i4, long i5, + eusfloat_t d0, eusfloat_t d1, eusfloat_t d2, eusfloat_t d3, + eusfloat_t d4, eusfloat_t d5, eusfloat_t d6, eusfloat_t d7, + eusfloat_t d8, eusfloat_t d9, + long i6, long i7) { + printf("%ld %ld %ld\n", i0, i1, i2); + printf("%ld %ld %ld\n", i3, i4, i5); + //printf("%ld %ld %ld %ld\n", + //(long)d0, (long)d1, (long)d2, (long)d3); + printf("%lf %lf %lf %lf\n", d0, d1, d2, d3); + printf("%lf %lf %lf %lf\n", d4, d5, d6, d7); + printf("%lf %lf\n", d8, d9); + printf("%ld %ld\n", i6, i7); + //return 0x1234; + return 1.23456; +} static long (*g)(); static double (*gf) (long i0, long i1, long i2, long i3, long i4, long i5, From 19ddee04c12ff374a1e7e026bc0825819d5cba7b Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Wed, 3 Jun 2020 07:29:53 +0000 Subject: [PATCH 06/17] add call_foreigin for 32bit arm code (arm/32bit armhf) --- lisp/c/eval.c | 258 +++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 257 insertions(+), 1 deletion(-) diff --git a/lisp/c/eval.c b/lisp/c/eval.c index ed9fd10ce..daab35d70 100644 --- a/lisp/c/eval.c +++ b/lisp/c/eval.c @@ -980,7 +980,263 @@ pointer args[]; } else error(E_USER,(pointer)"result type?"); } } -#else /* not x86_64 */ + +#elif defined(ARM) /* not (defined(x86_64) || defined(aarch64)) */ + +extern int exec_function_i(void (*)(), int *, int *, int, int *); +extern int exec_function_f(void (*)(), int *, int *, int, int *); + +__asm__ (".align 4\n" + ".global exec_function_i\n\t" + ".type exec_function_i, %function\n" + "exec_function_i:\n\t" + "push {r7, lr}\n\t" + "sub sp, sp, #136\n\t" + "add r7, sp, #64\n\t" + "str r0, [r7, #12]\n\t" // fc + "str r1, [r7, #8]\n\t" // iargv + "str r2, [r7, #4]\n\t" // fargv + "str r3, [r7]\n\t" // vcntr + // vargv -> stack + "movs r1, #0\n\t" + "ldr r2, [r7, #80]\n\t" // vargv + "b .FUNCII_LPCK\n\t" + ".FUNCII_LP:\n\t" + "lsl r0, r1, #2\n\t" + "add r3, r2, r0\n\t" // vargv[i] + "add r5, sp, r0\n\t" // stack[i] // using v4 cause segfault. + "ldr r0, [r3]\n\t" + "str r0, [r5]\n\t" // push stack + "adds r1, r1, #1\n\t" + ".FUNCII_LPCK:\n\t" + "ldr r5, [r7]\n\t" + "cmp r1, r5\n\t" + "blt .FUNCII_LP\n\t" + // fargv -> register + "ldr r0, [r7,#4]\n\t" + "vldr.32 s0, [r0]\n\t" + "vldr.32 s1, [r0,#4]\n\t" + "vldr.32 s2, [r0,#8]\n\t" + "vldr.32 s3, [r0,#12]\n\t" + "vldr.32 s4, [r0,#16]\n\t" + "vldr.32 s5, [r0,#20]\n\t" + "vldr.32 s6, [r0,#24]\n\t" + "vldr.32 s7, [r0,#28]\n\t" + "vldr.32 s8, [r0,#32]\n\t" + "vldr.32 s9, [r0,#36]\n\t" + "vldr.32 s10, [r0,#40]\n\t" + "vldr.32 s11, [r0,#44]\n\t" + "vldr.32 s12, [r0,#48]\n\t" + "vldr.32 s13, [r0,#52]\n\t" + "vldr.32 s14, [r0,#56]\n\t" + "vldr.32 s15, [r0,#60]\n\t" + // iargv -> register + "ldr r0, [r7,#8]\n\t" + "ldr r0, [r0]\n\t" + "ldr r1, [r7,#8]\n\t" + "ldr r1, [r1,#4]\n\t" + "ldr r2, [r7,#8]\n\t" + "ldr r2, [r2,#8]\n\t" + "ldr r3, [r7,#8]\n\t" + "ldr r3, [r3,#12]\n\t" + // funcall + "ldr r6, [r7, #12]\n\t" + "blx r6\n\t" + // retval + "adds r7, r7, #72\n\t" + "mov sp, r7\n\t" + "@ sp needed @\n\t" + "pop {r7, pc}\n\t" + ".size exec_function_i, .-exec_function_i\n\t" + ); + +__asm__ (".align 4\n" + ".global exec_function_f\n\t" + ".type exec_function_f, %function\n" + "exec_function_f:\n\t" + "push {r7, lr}\n\t" + "sub sp, sp, #136\n\t" + "add r7, sp, #64\n\t" + "str r0, [r7, #12]\n\t" // fc + "str r1, [r7, #8]\n\t" // iargv + "str r2, [r7, #4]\n\t" // fargv + "str r3, [r7]\n\t" // vcntr + // vargv -> stack + "movs r1, #0\n\t" + "ldr r2, [r7, #80]\n\t" // vargv + "b .FUNCFF_LPCK\n\t" + ".FUNCFF_LP:\n\t" + "lsl r0, r1, #2\n\t" + "add r3, r2, r0\n\t" // vargv[i] + "add r4, sp, r0\n\t" // stack[i] + "ldr r0, [r3]\n\t" + "str r0, [r4]\n\t" // push stack + "adds r1, r1, #1\n\t" + ".FUNCFF_LPCK:\n\t" + "ldr r5, [r7]\n\t" + "cmp r1, r5\n\t" + "blt .FUNCFF_LP\n\t" + // fargv -> register + "ldr r0, [r7,#4]\n\t" + "vldr.32 s0, [r0]\n\t" + "vldr.32 s1, [r0,#4]\n\t" + "vldr.32 s2, [r0,#8]\n\t" + "vldr.32 s3, [r0,#12]\n\t" + "vldr.32 s4, [r0,#16]\n\t" + "vldr.32 s5, [r0,#20]\n\t" + "vldr.32 s6, [r0,#24]\n\t" + "vldr.32 s7, [r0,#28]\n\t" + "vldr.32 s8, [r0,#32]\n\t" + "vldr.32 s9, [r0,#36]\n\t" + "vldr.32 s10, [r0,#40]\n\t" + "vldr.32 s11, [r0,#44]\n\t" + "vldr.32 s12, [r0,#48]\n\t" + "vldr.32 s13, [r0,#52]\n\t" + "vldr.32 s14, [r0,#56]\n\t" + "vldr.32 s15, [r0,#60]\n\t" + // iargv -> register + "ldr r0, [r7,#8]\n\t" + "ldr r0, [r0]\n\t" + "ldr r1, [r7,#8]\n\t" + "ldr r1, [r1,#4]\n\t" + "ldr r2, [r7,#8]\n\t" + "ldr r2, [r2,#8]\n\t" + "ldr r3, [r7,#8]\n\t" + "ldr r3, [r3,#12]\n\t" + // funcall + "ldr r6, [r7, #12]\n\t" + "blx r6\n\t" + // retval + "vmov r0, s0 @ \n\t" + "adds r7, r7, #72\n\t" + "mov sp, r7\n\t" + "@ sp needed @\n\t" + "pop {r7, pc}\n\t" + ".size exec_function_f, .-exec_function_f\n\t" + ); + +#define NUM_INT_ARGUMENTS 4 +#define NUM_FLT_ARGUMENTS 16 +#define NUM_EXTRA_ARGUMENTS 16 + +pointer call_foreign(ifunc,code,n,args) +eusinteger_t (*ifunc)(); /* ???? */ +pointer code; +int n; +pointer args[]; +{ + pointer paramtypes=code->c.fcode.paramtypes; + pointer resulttype=code->c.fcode.resulttype; + pointer p,lisparg; + eusinteger_t iargv[NUM_INT_ARGUMENTS]; + eusinteger_t fargv[NUM_FLT_ARGUMENTS]; + eusinteger_t vargv[NUM_EXTRA_ARGUMENTS]; + int icntr = 0, fcntr = 0, vcntr = 0; + + numunion nu; + eusinteger_t j=0; /*lisp argument counter*//* ???? */ + eusinteger_t c=0; + union { + double d; + float f; + long l; + struct { + int i1,i2;} i; + } numbox; + double f; + + if (code->c.fcode.entry2 != NIL) { + ifunc = (eusinteger_t (*)())((((eusinteger_t)ifunc)&0xffffffff00000000) + | (intval(code->c.fcode.entry2)&0x00000000ffffffff)); + /* R.Hanai 090726 */ + } + + while (iscons(paramtypes)) { + p=ccar(paramtypes); paramtypes=ccdr(paramtypes); + lisparg=args[j++]; + if (p==K_INTEGER) { + c = isint(lisparg)?intval(lisparg):bigintval(lisparg); + if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c; + } else if (p==K_STRING) { + if (elmtypeof(lisparg)==ELM_FOREIGN) c=lisparg->c.ivec.iv[0]; + else c=(eusinteger_t)(lisparg->c.str.chars); + if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c; + } else if (p==K_FLOAT32 || p==K_FLOAT) { + numbox.f=(float)ckfltval(lisparg); + c=((eusinteger_t)numbox.i.i1) & 0x00000000FFFFFFFF; + if(fcntr < NUM_FLT_ARGUMENTS) fargv[fcntr++] = c; else vargv[vcntr++] = c; + } else if (p==K_DOUBLE) { + numbox.f=ckfltval(lisparg); + //c=numbox.l; + c=((eusinteger_t)numbox.i.i1) & 0x00000000FFFFFFFF; + if(fcntr < NUM_FLT_ARGUMENTS) fargv[fcntr++] = c; else vargv[vcntr++] = c; + } else error(E_USER,(pointer)"unknown type specifier"); + if (vcntr >= NUM_EXTRA_ARGUMENTS) { + error(E_USER,(pointer)"too many number of arguments"); + } + } + /* &rest arguments? */ + while (jc.ivec.iv[0]; + else c=(eusinteger_t)(lisparg->c.str.chars); + if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c; + } else if (isbignum(lisparg)){ + if (bigsize(lisparg)==1){ + eusinteger_t *xv = bigvec(lisparg); + c=(eusinteger_t)xv[0]; + if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c; + }else{ + fprintf(stderr, "bignum size!=1\n"); + } + } else { + c=(eusinteger_t)(lisparg->c.obj.iv); + if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c; + } + if (vcntr >= NUM_EXTRA_ARGUMENTS) { + error(E_USER,(pointer)"too many number of arguments"); + } + } + /**/ + if (resulttype==K_FLOAT || resulttype==K_FLOAT32) { + numbox.l = exec_function_f((void (*)())ifunc, iargv, fargv, vcntr, vargv); + f = (double)numbox.f; + return(makeflt(f)); + } else { + c = exec_function_i((void (*)())ifunc, iargv, fargv, vcntr, vargv); + if (resulttype==K_INTEGER) { + return(mkbigint(c)); + } else if (resulttype==K_STRING) { + p=makepointer(c-2*sizeof(pointer)); + if (isvector(p)) return(p); + else error(E_USER,(pointer)"illegal foreign string"); + } else if (iscons(resulttype)) { + /* (:string [10]) (:foreign-string [20]) */ + if (ccar(resulttype)==K_STRING) { /* R.Hanai 09/07/25 */ + resulttype=ccdr(resulttype); + if (resulttype!=NIL) j=ckintval(ccar(resulttype)); + else j=strlen((char *)c); + return(makestring((char *)c, j)); + } else if (ccar(resulttype)==K_FOREIGN_STRING) { /* R.Hanai 09/07/25 */ + resulttype=ccdr(resulttype); + if (resulttype!=NIL) j=ckintval(ccar(resulttype)); + else j=strlen((char *)c); + return(make_foreign_string(c, j)); } + error(E_USER,(pointer)"unknown result type"); + } else error(E_USER,(pointer)"result type?"); + } +} + +#else /* not ARM nor (defined(x86_64) || defined(aarch64)) */ + pointer call_foreign(ifunc,code,n,args) eusinteger_t (*ifunc)(); /* ???? */ pointer code; From 643ec7e66b157613994c15e66bf1eef6db7b0279 Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Thu, 4 Jun 2020 18:24:05 +0900 Subject: [PATCH 07/17] test-foreign.l only works with arm/aarch/x86/i386 --- .travis.sh | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/.travis.sh b/.travis.sh index fc1373c96..f3b1ced94 100755 --- a/.travis.sh +++ b/.travis.sh @@ -97,7 +97,15 @@ if [ "$QEMU" != "" ]; then eusgl $test_l; export TMP_EXIT_STATUS=$? - travis_time_end `expr 32 - $TMP_EXIT_STATUS` + export CONTINUE=0 + # test-foreign.l only works for x86 / arm + if [[ $test_l =~ test-foreign.l && ! "$(gcc -dumpmachine)" =~ "aarch".*|"arm".*|"x86_64".*|"i"[0-9]"86".* ]]; then export CONTINUE=1; fi + + if [[ $CONTINUE == 0 ]]; then travis_time_end `expr 32 - $TMP_EXIT_STATUS`; else travis_time_end 33; fi + + if [[ $TMP_EXIT_STATUS != 0 ]]; then echo "Failed running $test_l. Exiting with $TMP_EXIT_STATUS"; fi + + if [[ $CONTINUE != 0 ]]; then export TMP_EXIT_STATUS=0; fi export EXIT_STATUS=`expr $TMP_EXIT_STATUS + $EXIT_STATUS`; @@ -106,7 +114,6 @@ if [ "$QEMU" != "" ]; then eusgl "(let ((o (namestring (merge-pathnames \".o\" \"$test_l\"))) (so (namestring (merge-pathnames \".so\" \"$test_l\")))) (compile-file \"$test_l\" :o o) (if (probe-file so) (load so) (exit 1))))" export TMP_EXIT_STATUS=$? - export CONTINUE=0 # const.l does not compilable https://github.com/euslisp/EusLisp/issues/318 if [[ $test_l =~ const.l ]]; then export CONTINUE=1; fi From cf398707be8f0667e6f50d5c165e3ca438e28b30 Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Thu, 4 Jun 2020 21:59:05 +0900 Subject: [PATCH 08/17] arm/32bit : use assember for (armhf), use normal ifunc call for (armel) --- lisp/c/eval.c | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/lisp/c/eval.c b/lisp/c/eval.c index daab35d70..d569f72fc 100644 --- a/lisp/c/eval.c +++ b/lisp/c/eval.c @@ -981,7 +981,7 @@ pointer args[]; } } -#elif defined(ARM) /* not (defined(x86_64) || defined(aarch64)) */ +#elif defined(ARM) && defined(__ARM_ARCH_7A__) /* not (defined(x86_64) || defined(aarch64)) */ extern int exec_function_i(void (*)(), int *, int *, int, int *); extern int exec_function_f(void (*)(), int *, int *, int, int *); @@ -1242,8 +1242,7 @@ eusinteger_t (*ifunc)(); /* ???? */ pointer code; int n; pointer args[]; -{ double (*ffunc)(); - pointer paramtypes=code->c.fcode.paramtypes; +{ pointer paramtypes=code->c.fcode.paramtypes; pointer resulttype=code->c.fcode.resulttype; pointer p,lisparg; eusinteger_t cargv[100]; @@ -1265,7 +1264,6 @@ pointer args[]; ifunc = (eusinteger_t (*)())((((int)ifunc)&0xffff0000) | (intval(code->c.fcode.entry2)&0x0000ffff)); /* kanehiro's patch 2000.12.13 */ #endif } - ffunc=(double (*)())ifunc; while (iscons(paramtypes)) { p=ccar(paramtypes); paramtypes=ccdr(paramtypes); lisparg=args[j++]; @@ -1306,11 +1304,15 @@ pointer args[]; else cargv[i++]=(eusinteger_t)(lisparg->c.obj.iv);} /**/ if (resulttype==K_FLOAT || resulttype==K_FLOAT32) { + union { + eusfloat_t f; + eusinteger_t i; + } n; if (i<=8) - f=(*ffunc)(cargv[0],cargv[1],cargv[2],cargv[3], + n.i=(*ifunc)(cargv[0],cargv[1],cargv[2],cargv[3], cargv[4],cargv[5],cargv[6],cargv[7]); else if (i<=32) - f=(*ffunc)(cargv[0],cargv[1],cargv[2],cargv[3], + n.i=(*ifunc)(cargv[0],cargv[1],cargv[2],cargv[3], cargv[4],cargv[5],cargv[6],cargv[7], cargv[8],cargv[9],cargv[10],cargv[11], cargv[12],cargv[13],cargv[14],cargv[15], @@ -1320,7 +1322,7 @@ pointer args[]; cargv[28],cargv[29],cargv[30],cargv[31]); #if (sun3 || sun4 || mips || alpha) else if (i>32) - f=(*ffunc)(cargv[0],cargv[1],cargv[2],cargv[3], + n.i=(*ifunc)(cargv[0],cargv[1],cargv[2],cargv[3], cargv[4],cargv[5],cargv[6],cargv[7], cargv[8],cargv[9],cargv[10],cargv[11], cargv[12],cargv[13],cargv[14],cargv[15], @@ -1341,7 +1343,7 @@ pointer args[]; cargv[72],cargv[73],cargv[74],cargv[75], cargv[76],cargv[77],cargv[78],cargv[79]); #endif - return(makeflt(f));} + return(makeflt(n.f));} else { if (i<8) i=(*ifunc)(cargv[0],cargv[1],cargv[2],cargv[3], From 5de6943d00c424480efcce3ac358312a15dd26fa Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Thu, 4 Jun 2020 14:22:40 +0000 Subject: [PATCH 09/17] fix for i386 --- lisp/c/eval.c | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/lisp/c/eval.c b/lisp/c/eval.c index d569f72fc..53fe3e172 100644 --- a/lisp/c/eval.c +++ b/lisp/c/eval.c @@ -1306,8 +1306,18 @@ pointer args[]; if (resulttype==K_FLOAT || resulttype==K_FLOAT32) { union { eusfloat_t f; - eusinteger_t i; +#if __ARM_ARCH==4 + eusinteger_t i; // ARM 32bit armel +#else + eusfloat_t i; // Intel 32bit x86 +#endif } n; +#if __ARM_ARCH==4 +#else + eusinteger_t (*tmp_ifunc)() = ifunc; + double (*ifunc)(); + ifunc=(double (*)())tmp_ifunc; +#endif if (i<=8) n.i=(*ifunc)(cargv[0],cargv[1],cargv[2],cargv[3], cargv[4],cargv[5],cargv[6],cargv[7]); @@ -1343,6 +1353,7 @@ pointer args[]; cargv[72],cargv[73],cargv[74],cargv[75], cargv[76],cargv[77],cargv[78],cargv[79]); #endif + fprintf(stderr, "%d %f\n", n.i, n.f); return(makeflt(n.f));} else { if (i<8) From 005fc7e3e3d1bed4332ee6f972aba3ac39c46f5c Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Fri, 5 Jun 2020 00:44:07 +0900 Subject: [PATCH 10/17] ppc64le: skip test-foreign.l --- .travis.sh | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.travis.sh b/.travis.sh index f3b1ced94..d7e097a29 100755 --- a/.travis.sh +++ b/.travis.sh @@ -90,6 +90,8 @@ if [ "$QEMU" != "" ]; then make -C test for test_l in test/*.l; do + [[ "`uname -m`" == "ppc64le"* && $test_l =~ test-foreign.l ]] && continue; + travis_time_start euslisp.${test_l##*/}.test sed -i 's/\(i-max\ [0-9]000\)0*/\1/' $test_l From cd632ebc0370f170306f2cb71b7391425cf96471 Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Fri, 5 Jun 2020 00:44:56 +0900 Subject: [PATCH 11/17] relax test for arm/32bit (armhf), check double as arguments --- test/test-foreign.l | 6 +++--- test/test_foreign.c | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/test/test-foreign.l b/test/test-foreign.l index 63fbb9eb3..e229bb622 100644 --- a/test/test-foreign.l +++ b/test/test-foreign.l @@ -70,7 +70,6 @@ 206 207 test-testd = 1.23456 ~%") - (when (not (and (memq :word-size=32 *features*) (memq :arm *features*))) (format t "exec in eus~%") (format t "test-testd = ~A~%" (setq ret (test-testd 100 101 102 @@ -79,7 +78,9 @@ test-testd = 1.23456 1040.0 1050.0 1060.0 1070.0 2080.0 2090.0 206 207))) + (when (not (and (memq :word-size=32 *features*) (memq :arm *features*))) (assert (eps= 1.23456 ret)) + ) ;; (check-func 'test-testd) @@ -90,7 +91,6 @@ test-testd = 1.23456 (assert-read-line-string= f "1040.000000 1050.000000 1060.000000 1070.000000") (assert-read-line-string= f "2080.000000 2090.000000") (assert-read-line-string= f "206 207") - ) (format t "exec in eus~%") (format t "test-testf = ~A~%" @@ -227,13 +227,13 @@ test-testd = 1.23456 (double3-test 1 0.1 0.2 0.3 0.4) ;; - (when (not (and (memq :word-size=32 *features*) (memq :arm *features*))) (check-func 'double-test) (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (double-test 1 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) (assert-read-line-eps= f 0.1) (assert-read-line-eps= f 0.2) (assert-read-line-eps= f 0.3) (assert-read-line-eps= f 0.4) + (when (not (and (memq :word-size=32 *features*) (memq :arm *features*))) (check-func 'double3-test) (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (double3-test 1 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) (assert-read-line-eps= f 0.1) diff --git a/test/test_foreign.c b/test/test_foreign.c index 93952a74d..cf0f48666 100644 --- a/test/test_foreign.c +++ b/test/test_foreign.c @@ -210,8 +210,8 @@ float ret_float(float a, float b) { double ret_double(double a, double b) { double ret = (a + b); - unsigned long *ul; - ul = (unsigned long *)&ret; + unsigned long long *ul; + ul = (unsigned long long*)&ret; printf("// %f + %f -> %f\n", a, b, ret); printf("// return %e, %lX\n", ret, *ul); return ret; From c795945b2904c9fa0708ec478d94b08e1d90c2c2 Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Fri, 5 Jun 2020 00:45:29 +0900 Subject: [PATCH 12/17] use 64bit register for double argumnets (arm/32bit armhf) --- lisp/c/eval.c | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/lisp/c/eval.c b/lisp/c/eval.c index 53fe3e172..bf1b90852 100644 --- a/lisp/c/eval.c +++ b/lisp/c/eval.c @@ -1108,6 +1108,7 @@ __asm__ (".align 4\n" "blx r6\n\t" // retval "vmov r0, s0 @ \n\t" + "vmov r1, s1 @ \n\t" "adds r7, r7, #72\n\t" "mov sp, r7\n\t" "@ sp needed @\n\t" @@ -1166,10 +1167,12 @@ pointer args[]; c=((eusinteger_t)numbox.i.i1) & 0x00000000FFFFFFFF; if(fcntr < NUM_FLT_ARGUMENTS) fargv[fcntr++] = c; else vargv[vcntr++] = c; } else if (p==K_DOUBLE) { - numbox.f=ckfltval(lisparg); - //c=numbox.l; - c=((eusinteger_t)numbox.i.i1) & 0x00000000FFFFFFFF; - if(fcntr < NUM_FLT_ARGUMENTS) fargv[fcntr++] = c; else vargv[vcntr++] = c; + numbox.d=(double)ckfltval(lisparg); + if(fcntr < NUM_FLT_ARGUMENTS) { + fargv[fcntr++] = numbox.i.i1; fargv[fcntr++] = numbox.i.i2; + } else { + vargv[vcntr++] = numbox.i.i1; vargv[vcntr++] = numbox.i.i2; + } } else error(E_USER,(pointer)"unknown type specifier"); if (vcntr >= NUM_EXTRA_ARGUMENTS) { error(E_USER,(pointer)"too many number of arguments"); From 38329780723127423184a33596e4f542e2f8cddb Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Fri, 5 Jun 2020 11:38:54 +0900 Subject: [PATCH 13/17] arm-linux-gnueabi does not work with double arguments (arm/32bit armel) --- test/test-foreign.l | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/test-foreign.l b/test/test-foreign.l index e229bb622..476f021e0 100644 --- a/test/test-foreign.l +++ b/test/test-foreign.l @@ -227,12 +227,14 @@ test-testd = 1.23456 (double3-test 1 0.1 0.2 0.3 0.4) ;; + (when (not (eq (read (unix::piped-fork "gcc -dumpmachine") nil 'arm-linux-gnueabi) 'arm-linux-gnueabi)) (check-func 'double-test) (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (double-test 1 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) (assert-read-line-eps= f 0.1) (assert-read-line-eps= f 0.2) (assert-read-line-eps= f 0.3) (assert-read-line-eps= f 0.4) + ) (when (not (and (memq :word-size=32 *features*) (memq :arm *features*))) (check-func 'double3-test) (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (double3-test 1 0.1 0.2 0.3 0.4)(exit 0))'" *eusdir*))) From 3a49ca2906ed92bd48c25e3f130331bc63253046 Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Fri, 5 Jun 2020 19:07:20 +0900 Subject: [PATCH 14/17] add test to mix :double :float32 as arguments --- test/test-foreign.l | 19 +++++++++++++++++++ test/test-foreign.module_l | 6 ++++++ test/test_foreign.c | 18 ++++++++++++++++++ 3 files changed, 43 insertions(+) diff --git a/test/test-foreign.l b/test/test-foreign.l index 476f021e0..aebad7e84 100644 --- a/test/test-foreign.l +++ b/test/test-foreign.l @@ -110,6 +110,25 @@ test-testd = 1.23456 (assert-read-line-string= f "1040.000000 1050.000000 1060.000000 1070.000000") (assert-read-line-string= f "2080.000000 2090.000000") (assert-read-line-string= f "206 207") + + (format t "exec in eus~%") + (format t "test-testfd = ~A~%" + (setq ret (test-testfd 100 101 102 + 103 104 105 + 1000.0 1010.0 1020.0 1030.0 + 1040.0 1050.0 1060.0 1070.0 + 2080.0 2090.0 2100.0 2110.0 + 206 207))) + (assert (= 123456 ret)) + ;; + (check-func 'test-testfd) + (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (test-testfd 100 101 102 103 104 105 1000.000000 1010.000000 1020.000000 1030.000000 1040.000000 1050.000000 1060.000000 1070.000000 2080.000000 2090.000000 2100.000000 2110.000000 206 207)(exit 0))'" *eusdir*))) + (assert-read-line-string= f "100 101 102") + (assert-read-line-string= f "103 104 105") + (assert-read-line-string= f "1000.000000 1010.000000 1020.000000 1030.000000") + (assert-read-line-string= f "1040.000000 1050.000000 1060.000000 1070.000000") + (assert-read-line-string= f "2080.000000 2090.000000 2100.000000 2110.000000") + (assert-read-line-string= f "206 207") ) (deftest test-int-test diff --git a/test/test-foreign.module_l b/test/test-foreign.module_l index ddc531661..c4d917d5c 100644 --- a/test/test-foreign.module_l +++ b/test/test-foreign.module_l @@ -45,6 +45,12 @@ :float :float :float :float :float :float :integer :integer) :float) + (defforeign test-testfd *testmod* "test_testfd" (:integer :integer :integer + :integer :integer :integer + :double :float32 :double :float32 + :float32 :double :double :float32 + :float32 :double :double :float32 + :integer :integer) :integer) (defforeign call-ifunc *testmod* "call_ifunc" () :integer) (defforeign call-ffunc *testmod* "call_ffunc" () :float) diff --git a/test/test_foreign.c b/test/test_foreign.c index cf0f48666..48f62bd2f 100644 --- a/test/test_foreign.c +++ b/test/test_foreign.c @@ -307,6 +307,24 @@ eusfloat_t test_testf(long i0, long i1, long i2, //return 0x1234; return 1.23456; } +int test_testfd(long i0, long i1, long i2, + long i3, long i4, long i5, + double d0, float d1, double d2, float d3, + float d4, double d5, double d6, float d7, + float d8, double d9, double d10, float d11, + long i6, long i7) { + printf("%ld %ld %ld\n", i0, i1, i2); + printf("%ld %ld %ld\n", i3, i4, i5); + //printf("%ld %ld %ld %ld\n", + //(long)d0, (long)d1, (long)d2, (long)d3); + printf("%lf %f %lf %f\n", d0, d1, d2, d3); + printf("%f %lf %lf %f\n", d4, d5, d6, d7); + printf("%f %lf %lf %f\n", d8, d9, d10, d11); + printf("%ld %ld\n", i6, i7); + + //return 0x1234; + return 123456; +} static long (*g)(); static double (*gf) (long i0, long i1, long i2, long i3, long i4, long i5, From c58768086974fba879e1829c77e3e500447646ad Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Sun, 7 Jun 2020 06:11:05 +0000 Subject: [PATCH 15/17] use vcntr_8 and vcntr_16 for arm/32bit --- lisp/c/eval.c | 45 +++++++++++++++++++++++++++++++++++---------- 1 file changed, 35 insertions(+), 10 deletions(-) diff --git a/lisp/c/eval.c b/lisp/c/eval.c index bf1b90852..e11d1b879 100644 --- a/lisp/c/eval.c +++ b/lisp/c/eval.c @@ -1132,7 +1132,7 @@ pointer args[]; eusinteger_t iargv[NUM_INT_ARGUMENTS]; eusinteger_t fargv[NUM_FLT_ARGUMENTS]; eusinteger_t vargv[NUM_EXTRA_ARGUMENTS]; - int icntr = 0, fcntr = 0, vcntr = 0; + int icntr = 0, fcntr_d = 0, fcntr_f = 0, vcntr_8 = 0, vcntr_16 = 0; numunion nu; eusinteger_t j=0; /*lisp argument counter*//* ???? */ @@ -1151,33 +1151,58 @@ pointer args[]; | (intval(code->c.fcode.entry2)&0x00000000ffffffff)); /* R.Hanai 090726 */ } - while (iscons(paramtypes)) { p=ccar(paramtypes); paramtypes=ccdr(paramtypes); lisparg=args[j++]; if (p==K_INTEGER) { c = isint(lisparg)?intval(lisparg):bigintval(lisparg); - if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c; + if(icntr < NUM_INT_ARGUMENTS) { + iargv[icntr++] = c; + } else { + vargv[vcntr_8++] = c; + if ( vcntr_8 % 2 == 1 ) vcntr_16 += 2; + if ( vcntr_8 % 2 == 0 ) vcntr_8 = vcntr_16; + } } else if (p==K_STRING) { if (elmtypeof(lisparg)==ELM_FOREIGN) c=lisparg->c.ivec.iv[0]; else c=(eusinteger_t)(lisparg->c.str.chars); - if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c; + if(icntr < NUM_INT_ARGUMENTS) { + iargv[icntr++] = c; + } else { + vargv[vcntr_8++] = c; + if ( vcntr_8 % 2 == 1 ) vcntr_16 += 2; + if ( vcntr_8 % 2 == 0 ) vcntr_8 = vcntr_16; + } } else if (p==K_FLOAT32 || p==K_FLOAT) { numbox.f=(float)ckfltval(lisparg); c=((eusinteger_t)numbox.i.i1) & 0x00000000FFFFFFFF; - if(fcntr < NUM_FLT_ARGUMENTS) fargv[fcntr++] = c; else vargv[vcntr++] = c; + // | s0 | s1 | s2 | s3 | s4 | s5 | + // | d0 | d1 | d2 | + if(fcntr_f < NUM_FLT_ARGUMENTS) { + fargv[fcntr_f++] = c; + if ( fcntr_f % 2 == 1 ) fcntr_d += 2; // if *fcntr_f = s1, use d1 + if ( fcntr_f % 2 == 0 ) fcntr_f = fcntr_d; + } else { + vargv[vcntr_8++] = c; + if ( vcntr_8 % 2 == 1 ) vcntr_16 += 2; + if ( vcntr_8 % 2 == 0 ) vcntr_8 = vcntr_16; + } } else if (p==K_DOUBLE) { numbox.d=(double)ckfltval(lisparg); - if(fcntr < NUM_FLT_ARGUMENTS) { - fargv[fcntr++] = numbox.i.i1; fargv[fcntr++] = numbox.i.i2; + if(fcntr_d < NUM_FLT_ARGUMENTS-1) { + fargv[fcntr_d++] = numbox.i.i1; fargv[fcntr_d++] = numbox.i.i2; + if ( fcntr_f % 2 == 0 ) fcntr_f = fcntr_d; // if *fcntr_f = s2, use d1 + if(fcntr_d >= NUM_FLT_ARGUMENTS) fcntr_f = fcntr_d; } else { - vargv[vcntr++] = numbox.i.i1; vargv[vcntr++] = numbox.i.i2; + vargv[vcntr_16++] = numbox.i.i1; vargv[vcntr_16++] = numbox.i.i2; + if ( vcntr_8 % 2 == 0 ) vcntr_8 = vcntr_16; } } else error(E_USER,(pointer)"unknown type specifier"); - if (vcntr >= NUM_EXTRA_ARGUMENTS) { + if (max(vcntr_8, vcntr_16) >= NUM_EXTRA_ARGUMENTS) { error(E_USER,(pointer)"too many number of arguments"); } } + int vcntr = max(vcntr_8, vcntr_16); /* &rest arguments? */ while (jc.ivec.iv[0]; else c=(eusinteger_t)(lisparg->c.str.chars); From f2824381eb221999f6e25c80b88b2ea3723fadf2 Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Sun, 7 Jun 2020 06:11:40 +0000 Subject: [PATCH 16/17] define exec_function_{f,i} as exec_function_asm arm/32bit (armhf) --- lisp/c/eval.c | 144 +++++++++++++++++++------------------------------- 1 file changed, 54 insertions(+), 90 deletions(-) diff --git a/lisp/c/eval.c b/lisp/c/eval.c index e11d1b879..400625124 100644 --- a/lisp/c/eval.c +++ b/lisp/c/eval.c @@ -986,6 +986,58 @@ pointer args[]; extern int exec_function_i(void (*)(), int *, int *, int, int *); extern int exec_function_f(void (*)(), int *, int *, int, int *); +#define exec_function_asm(FUNC) \ + /* vargv -> stack */ \ + "movs r3, #0\n\t" \ + "str r3, [r7, #60]\n\t" \ + "b ."FUNC"_LPCK\n\t" \ + "."FUNC"_LP:\n\t" \ + "ldr r3, [r7, #60]\n\t" /* i */ \ + /* https://community.arm.com/developer/ip-products/processors/b/processors-ip-blog/posts/function-parameters-on-32-bit-arm */ \ + "lsl r4, r3, #2\n\t" /* r4 = i * 2 */ \ + "ldr r1, [r7, #80]\n\t" /* vargv[0] */ \ + "add r1, r1, r4\n\t" /* vargv[i] */ \ + "add r2, sp, r4\n\t" /* stack[i] */ \ + "ldr r0, [r1]\n\t" \ + "str r0, [r2]\n\t" /* push stack */ \ + "adds r3, r3, #1\n\t" /* i++ */ \ + "str r3, [r7, #60]\n\t" \ + "."FUNC"_LPCK:\n\t" \ + "ldr r2, [r7, #60]\n\t" \ + "ldr r3, [r7]\n\t" \ + "cmp r2, r3\n\t" \ + "blt ."FUNC"_LP\n\t" \ + /* fargv -> register */ \ + "ldr r0, [r7,#4]\n\t" \ + "vldr.32 s0, [r0]\n\t" \ + "vldr.32 s1, [r0,#4]\n\t" \ + "vldr.32 s2, [r0,#8]\n\t" \ + "vldr.32 s3, [r0,#12]\n\t" \ + "vldr.32 s4, [r0,#16]\n\t" \ + "vldr.32 s5, [r0,#20]\n\t" \ + "vldr.32 s6, [r0,#24]\n\t" \ + "vldr.32 s7, [r0,#28]\n\t" \ + "vldr.32 s8, [r0,#32]\n\t" \ + "vldr.32 s9, [r0,#36]\n\t" \ + "vldr.32 s10, [r0,#40]\n\t" \ + "vldr.32 s11, [r0,#44]\n\t" \ + "vldr.32 s12, [r0,#48]\n\t" \ + "vldr.32 s13, [r0,#52]\n\t" \ + "vldr.32 s14, [r0,#56]\n\t" \ + "vldr.32 s15, [r0,#60]\n\t" \ + /* iargv -> register */ \ + "ldr r0, [r7,#8]\n\t" \ + "ldr r0, [r0]\n\t" \ + "ldr r1, [r7,#8]\n\t" \ + "ldr r1, [r1,#4]\n\t" \ + "ldr r2, [r7,#8]\n\t" \ + "ldr r2, [r2,#8]\n\t" \ + "ldr r3, [r7,#8]\n\t" \ + "ldr r3, [r3,#12]\n\t" \ + /* funcall */ \ + "ldr r6, [r7, #12]\n\t" \ + "blx r6\n\t" + __asm__ (".align 4\n" ".global exec_function_i\n\t" ".type exec_function_i, %function\n" @@ -997,51 +1049,7 @@ __asm__ (".align 4\n" "str r1, [r7, #8]\n\t" // iargv "str r2, [r7, #4]\n\t" // fargv "str r3, [r7]\n\t" // vcntr - // vargv -> stack - "movs r1, #0\n\t" - "ldr r2, [r7, #80]\n\t" // vargv - "b .FUNCII_LPCK\n\t" - ".FUNCII_LP:\n\t" - "lsl r0, r1, #2\n\t" - "add r3, r2, r0\n\t" // vargv[i] - "add r5, sp, r0\n\t" // stack[i] // using v4 cause segfault. - "ldr r0, [r3]\n\t" - "str r0, [r5]\n\t" // push stack - "adds r1, r1, #1\n\t" - ".FUNCII_LPCK:\n\t" - "ldr r5, [r7]\n\t" - "cmp r1, r5\n\t" - "blt .FUNCII_LP\n\t" - // fargv -> register - "ldr r0, [r7,#4]\n\t" - "vldr.32 s0, [r0]\n\t" - "vldr.32 s1, [r0,#4]\n\t" - "vldr.32 s2, [r0,#8]\n\t" - "vldr.32 s3, [r0,#12]\n\t" - "vldr.32 s4, [r0,#16]\n\t" - "vldr.32 s5, [r0,#20]\n\t" - "vldr.32 s6, [r0,#24]\n\t" - "vldr.32 s7, [r0,#28]\n\t" - "vldr.32 s8, [r0,#32]\n\t" - "vldr.32 s9, [r0,#36]\n\t" - "vldr.32 s10, [r0,#40]\n\t" - "vldr.32 s11, [r0,#44]\n\t" - "vldr.32 s12, [r0,#48]\n\t" - "vldr.32 s13, [r0,#52]\n\t" - "vldr.32 s14, [r0,#56]\n\t" - "vldr.32 s15, [r0,#60]\n\t" - // iargv -> register - "ldr r0, [r7,#8]\n\t" - "ldr r0, [r0]\n\t" - "ldr r1, [r7,#8]\n\t" - "ldr r1, [r1,#4]\n\t" - "ldr r2, [r7,#8]\n\t" - "ldr r2, [r2,#8]\n\t" - "ldr r3, [r7,#8]\n\t" - "ldr r3, [r3,#12]\n\t" - // funcall - "ldr r6, [r7, #12]\n\t" - "blx r6\n\t" + exec_function_asm("FUNCI") // retval "adds r7, r7, #72\n\t" "mov sp, r7\n\t" @@ -1061,51 +1069,7 @@ __asm__ (".align 4\n" "str r1, [r7, #8]\n\t" // iargv "str r2, [r7, #4]\n\t" // fargv "str r3, [r7]\n\t" // vcntr - // vargv -> stack - "movs r1, #0\n\t" - "ldr r2, [r7, #80]\n\t" // vargv - "b .FUNCFF_LPCK\n\t" - ".FUNCFF_LP:\n\t" - "lsl r0, r1, #2\n\t" - "add r3, r2, r0\n\t" // vargv[i] - "add r4, sp, r0\n\t" // stack[i] - "ldr r0, [r3]\n\t" - "str r0, [r4]\n\t" // push stack - "adds r1, r1, #1\n\t" - ".FUNCFF_LPCK:\n\t" - "ldr r5, [r7]\n\t" - "cmp r1, r5\n\t" - "blt .FUNCFF_LP\n\t" - // fargv -> register - "ldr r0, [r7,#4]\n\t" - "vldr.32 s0, [r0]\n\t" - "vldr.32 s1, [r0,#4]\n\t" - "vldr.32 s2, [r0,#8]\n\t" - "vldr.32 s3, [r0,#12]\n\t" - "vldr.32 s4, [r0,#16]\n\t" - "vldr.32 s5, [r0,#20]\n\t" - "vldr.32 s6, [r0,#24]\n\t" - "vldr.32 s7, [r0,#28]\n\t" - "vldr.32 s8, [r0,#32]\n\t" - "vldr.32 s9, [r0,#36]\n\t" - "vldr.32 s10, [r0,#40]\n\t" - "vldr.32 s11, [r0,#44]\n\t" - "vldr.32 s12, [r0,#48]\n\t" - "vldr.32 s13, [r0,#52]\n\t" - "vldr.32 s14, [r0,#56]\n\t" - "vldr.32 s15, [r0,#60]\n\t" - // iargv -> register - "ldr r0, [r7,#8]\n\t" - "ldr r0, [r0]\n\t" - "ldr r1, [r7,#8]\n\t" - "ldr r1, [r1,#4]\n\t" - "ldr r2, [r7,#8]\n\t" - "ldr r2, [r2,#8]\n\t" - "ldr r3, [r7,#8]\n\t" - "ldr r3, [r3,#12]\n\t" - // funcall - "ldr r6, [r7, #12]\n\t" - "blx r6\n\t" + exec_function_asm("FUNCF") // retval "vmov r0, s0 @ \n\t" "vmov r1, s1 @ \n\t" From 9bd27b837ff1615530f0a753acf27fed9f74e626 Mon Sep 17 00:00:00 2001 From: Kei Okada Date: Sun, 7 Jun 2020 06:21:44 +0000 Subject: [PATCH 17/17] arm32v5 (armel) did not work with test-testfd --- test/test-foreign.l | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/test-foreign.l b/test/test-foreign.l index aebad7e84..819482b46 100644 --- a/test/test-foreign.l +++ b/test/test-foreign.l @@ -121,6 +121,7 @@ test-testd = 1.23456 206 207))) (assert (= 123456 ret)) ;; + (when (not (eq (read (unix::piped-fork "gcc -dumpmachine") nil 'arm-linux-gnueabi) 'arm-linux-gnueabi)) (check-func 'test-testfd) (setq f (piped-fork (format nil "eusg ~A/test/test-foreign.module_l '(progn (test-testfd 100 101 102 103 104 105 1000.000000 1010.000000 1020.000000 1030.000000 1040.000000 1050.000000 1060.000000 1070.000000 2080.000000 2090.000000 2100.000000 2110.000000 206 207)(exit 0))'" *eusdir*))) (assert-read-line-string= f "100 101 102") @@ -130,6 +131,7 @@ test-testd = 1.23456 (assert-read-line-string= f "2080.000000 2090.000000 2100.000000 2110.000000") (assert-read-line-string= f "206 207") ) + ) (deftest test-int-test (format t "~%~%int-test~%")