Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

(eps= 1 1.0) が nil になる #406

Open
k-okada opened this issue Jan 6, 2020 · 1 comment
Open

(eps= 1 1.0) が nil になる #406

k-okada opened this issue Jan 6, 2020 · 1 comment

Comments

@k-okada
Copy link
Member

k-okada commented Jan 6, 2020

1.eusgl$ eps= 0 0.0
t
2.eusgl$ eps= 1 1.0
nil

となります.これは,

EusLisp/lisp/geo/geopack.l

Lines 197 to 199 in 41c497d

(defun eps= (m n &optional (eps *epsilon*))
(declare (type float m n eps))
(< (abs (- m n)) eps))

(declare (type float m n eps))のお陰で,通常なら

static pointer F89eps_(ctx,n,argv,env)
register context *ctx;
register int n; register pointer argv[]; pointer env;
{ register pointer *local=ctx->vsp, w, *fqv=qv;
  numunion nu;
        if (n<2) maerror();
        if (n>=3) { local[0]=(argv[2]); goto ENT159;}
        local[0]= loadglobal(fqv[16]);
ENT159:
ENT158:
        if (n>3) maerror();
        local[1]= argv[0];
        local[2]= argv[1];
        ctx->vsp=local+3;
        w=(pointer)MINUS(ctx,2,local+1); /*-*/
        local[1]= w;
        ctx->vsp=local+2;
        w=(pointer)ABS(ctx,1,local+1); /*abs*/
        local[1]= w;
        local[2]= local[0];
        ctx->vsp=local+3;
        w=(pointer)LESSP(ctx,2,local+1); /*<*/
        local[0]= w;
BLK156:
        ctx->vsp=local; return(local[0]);}

とコンパイルされるところが

static pointer F86eps2_(ctx,n,argv,env)
register context *ctx;
register int n; register pointer argv[]; pointer env;
{ register pointer *local=ctx->vsp, w, *fqv=qv;
  numunion nu;
        if (n<2) maerror();
        if (n>=3) { local[0]=(argv[2]); goto ENT135;}
        local[0]= loadglobal(fqv[16]);
ENT135:
ENT134:
        if (n>3) maerror();
        local[1]= argv[0];
        { double x,y;
                y=fltval(argv[1]); x=fltval(local[1]);
                local[1]=(makeflt(x - y));}
        local[1]= makeflt((double)fabs(fltval(local[1])));
        local[2]= local[0];
        ctx->vsp=local+3;
        w=(pointer)LESSP(ctx,2,local+1); /*<*/
        local[0]= w;
BLK132:
        ctx->vsp=local; return(local[0]);}

となっているからのようです.ちなみにこの効果がどれぐらいあるか,ですが,
https://gist.github.com/k-okada/39732bdcbf44b485378612dbc39ecb9d
を実行してみると1.3-1.8 倍ぐらい速くなっています.

... declare 有り
(eps= 2   2.0) ;; 0.230666[s]
(eps= 2.0 2.0) ;; 0.220226[s]
... declare 有り
(eps= 2   2.0) ;; 0.222742[s]
(eps= 2.0 2.0) ;; 0.204248[s]
... declare 無し
(eps= 2   2.0) ;; 0.36795[s]
(eps= 2.0 2.0) ;; 0.315143[s]

そもそもは型チェックをしない代わりに高速なコードを生成するのが目的なので,
すこし対応としてはずれますが,
エラーチェックをする,あるいは,方をチェックする,という方法ですが,
https://github.com/euslisp/EusLisp/blob/master/lisp/c/eus.h#L818-L822
を使って

diff --git a/lisp/comp/trans.l b/lisp/comp/trans.l
index ab801270..5fd1775b 100644
--- a/lisp/comp/trans.l
+++ b/lisp/comp/trans.l
@@ -499,7 +499,7 @@
  (:flt-op2 (op)
     (format cfile "    { double x,y;~%")
     (format cfile 
-   "               y=fltval(~A); x=fltval(~A);~%"
+ "           y=ckfltval(~A); x=ckfltval(~A);~%"
        (send self :pop) (send self :pop))
     (format cfile
        "               local[~d]=(makeflt(x ~A y));}~%"

とすると,

;; declare 有り
(eps= 2   2.0) ;; 0.302843[s]
(eps= 2.0 2.0) ;; 0.230271[s]
;; declare 有り
(eps= 2   2.0) ;; 0.285085[s]
(eps= 2.0 2.0) ;; 0.232271[s]
;; declare 無し
(eps= 2   2.0) ;; 0.371205[s]
(eps= 2.0 2.0) ;; 0.310996[s]

となり,110-150%程時間が掛かるようです.
ちゃと仕様どおり引数に実数を入れていても110%程になる,ということで,
これをどう見るか?ワーニングを出すものと,型をキャストするコードにはそこまで速度は変わらず,
結局,型をキャストするかどうか?するならワーニングを出すべきか,という判断になりそうです.

diff --git a/lisp/comp/trans.l b/lisp/comp/trans.l
index ab801270..f62cb2e1 100644
--- a/lisp/comp/trans.l
+++ b/lisp/comp/trans.l
@@ -497,10 +497,14 @@
         (t (send self :error "illegal compare"))))
 ;;; floating arithemtics
  (:flt-op2 (op)
-    (format cfile "        { double x,y;~%")
-    (format cfile 
-   "               y=fltval(~A); x=fltval(~A);~%"
+    (format cfile "  { double x,y; pointer a0,a1;~%")
+    (format cfile
+ "           a0=~A; a1=~A;~%"
        (send self :pop) (send self :pop))
+    (format cfile
+ "           if(!(isflt(a0)&&isflt(a1))){fprintf(stderr,\"WARNING: float expected .. \");struct callframe *vf=(struct callframe *)(ctx->callfp);prinx(ctx,vf->form, ERROUT);flushstream(ERROUT);fprintf(stderr,\"\\n\");}~%")
+    (format cfile
+ "           y=ckfltval(a0); x=ckfltval(a1);~%")
     (format cfile
        "               local[~d]=(makeflt(x ~A y));}~%"
        pushcount
@Affonso-Gui
Copy link
Member

Luckily for us the eps= is still under-optimized (why are we using LESSP even when both arguments have been declared as float?), so we can implement a solution that has both better performance and is type-safe.

/*my-eps=*/
static pointer testF1my_eps_(ctx,n,argv,env)
register context *ctx;
register int n; register pointer argv[]; pointer env;
{ register pointer *local=ctx->vsp, w, *fqv=qv;
  numunion nu;
  double x,y;
	if (n<2) maerror();
        if (n>3) maerror();
	if (n>=3) { local[0]=(argv[2]); goto testENT11;}
	local[0]= loadglobal(fqv[0]);
testENT11:
        x = fabs(ckfltval(argv[0]) - ckfltval(argv[1]));
        y = ckfltval(local[0]);
        local[0] = x<y?T:NIL;
testBLK9:
	ctx->vsp=local; return(local[0]);}
(defun foo ()
  (dotimes (i 100000000)
    (eps= 1.0 1.0)))

(defun bar ()
  (dotimes (i 100000000)
    (my-eps= 1.0 1.0)))

(defun bar-int ()
  (dotimes (i 100000000)
    (my-eps= 1 1.0)))

(defun bar-int-int ()
  (dotimes (i 100000000)
    (my-eps= 1 1)))
1.irteusgl$ (my-eps= 1 1.0)
t
2.irteusgl$ (my-eps= 1 1.1)
nil
3.irteusgl$ (bench (foo))
;; time -> 2.63216[s]
nil
4.irteusgl$ (bench (bar))
;; time -> 2.31267[s]
nil
5.irteusgl$ (bench (bar-int))
;; time -> 2.76027[s]
nil
6.irteusgl$ (bench (bar-int-int))
;; time -> 3.43548[s]
nil

The time for the optimized and unsafe code was (bench (bar)) ;; time -> 1.92481[s].
Compiling with -O3 made it even faster, with 1.93313[s] for the type-check and 1.64588[s] for the unsafe.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

2 participants