converting for to a special form

adding loadi8 instruction
cleaning up numeric comparison, reducing repeated code

femtolisp/compiler.lsp

@@ -9,7 +9,7 @@
 (define Instructions
   (make-enum-table
    [:nop :dup :pop :call :tcall :jmp :brf :brt :jmp.l :brf.l :brt.l :ret
-    :tapply
+    :tapply :for
 
     :eq? :eqv? :equal? :atom? :not :null? :boolean? :symbol?
     :number? :bound? :pair? :builtin? :vector? :fixnum?
@@ -19,9 +19,9 @@
 
     :+ :- :* :/ := :< :compare
 
-    :vector :aref :aset! :for
+    :vector :aref :aset!
 
-    :loadt :loadf :loadnil :load0 :load1 :loadv :loadv.l
+    :loadt :loadf :loadnil :load0 :load1 :loadi8 :loadv :loadv.l
     :loadg :loada :loadc :loadg.l
     :setg  :seta  :setc  :setg.l
 
@@ -39,9 +39,8 @@
 	 :cdr      1      :set-car! 2
 	 :set-cdr! 2      :eval     1
 	 :apply    2      :<        2
-         :for      3      :compare  2
+         :compare  2      :aref     2
-         :aref     2      :aset!    3
+         :aset!    3      :=        2))
-	 :=        2))
 
 (define 1/Instructions (table.invert Instructions))
 
@@ -122,7 +121,7 @@
 			 (set! i (+ i 1)))
 			
 			((:loada :seta :call :tcall :loadv :loadg :setg
-				 :list :+ :- :* :/ :vector :argc :vargc)
+			  :list :+ :- :* :/ :vector :argc :vargc :loadi8)
 			 (io.write bcode (uint8 nxt))
 			 (set! i (+ i 1)))
 			
@@ -251,6 +250,21 @@
     (emit g :jmp top)
     (mark-label g end)))
 
+(define (1arg-lambda? func)
+  (and (pair? func)
+       (eq? (car func) 'lambda)
+       (pair? (cdr func))
+       (pair? (cadr func))
+       (length= (cadr func) 1)))
+
+(define (compile-for g env lo hi func)
+  (if (1arg-lambda? func)
+      (begin (compile-in g env #f lo)
+	     (compile-in g env #f hi)
+	     (compile-in g env #f func)
+	     (emit g :for))
+      (error "for: third form must be a 1-argument lambda")))
+
 (define (compile-short-circuit g env tail? forms default branch)
   (cond ((atom? forms)        (compile-in g env tail? default))
 	((atom? (cdr forms))  (compile-in g env tail? (car forms)))
@@ -360,6 +374,9 @@
 	       ((eq? x #t) (emit g :loadt))
 	       ((eq? x #f) (emit g :loadf))
 	       ((eq? x ()) (emit g :loadnil))
+	       ((and (fixnum? x)
+		     (>= x -128)
+		     (<= x 127)) (emit g :loadi8 x))
 	       (else       (emit g :loadv x))))
 	(else
 	 (case (car x)
@@ -373,9 +390,12 @@
 	   (and      (compile-and g env tail? (cdr x)))
 	   (or       (compile-or  g env tail? (cdr x)))
 	   (while    (compile-while g env (cadr x) (cons 'begin (cddr x))))
+	   (for      (compile-for   g env (cadr x) (caddr x) (cadddr x)))
 	   (set!     (compile-in g env #f (caddr x))
 		     (compile-sym g env (cadr x) [:seta :setc :setg]))
 	   (trycatch (compile-in g env #f `(lambda () ,(cadr x)))
+		     (unless (1arg-lambda? (caddr x))
+			     (error "trycatch: second form must be a 1-argument lambda"))
 		     (compile-in g env #f (caddr x))
 		     (emit g :trycatch))
 	   (else   (compile-app g env tail? x))))))
@@ -437,7 +457,7 @@
 		      (set! i (+ i 1)))
 
 		     ((:loada :seta :call :tcall :list :+ :- :* :/ :vector
-		       :argc :vargc)
+		       :argc :vargc :loadi8)
 		      (princ (number->string (aref code i)))
 		      (set! i (+ i 1)))
 

femtolisp/cvalues.c

@@ -1204,39 +1204,66 @@ static value_t fl_mul_any(value_t *args, u_int32_t nargs, int64_t Saccum)
     return return_from_uint64(Uaccum);
 }
 
+static int num_to_ptr(value_t a, fixnum_t *pi, numerictype_t *pt, void **pp)
+{
+    cprim_t *cp;
+    if (isfixnum(a)) {
+        *pi = numval(a);
+        *pp = pi;
+        *pt = T_FIXNUM;
+    }
+    else if (iscprim(a)) {
+        cp = (cprim_t*)ptr(a);
+        *pp = cp_data(cp);
+        *pt = cp_numtype(cp);
+    }
+    else {
+        return 0;
+    }
+    return 1;
+}
+
+/*
+  returns -1, 0, or 1 based on ordering of a and b
+  eq: consider equality only, returning 0 or nonzero
+  eqnans: NaNs considered equal to each other
+  fname: if not NULL, throws type errors, else returns 2 for type errors
+*/
+int numeric_compare(value_t a, value_t b, int eq, int eqnans, char *fname)
+{
+    int_t ai, bi;
+    numerictype_t ta, tb;
+    void *aptr, *bptr;
+
+    if (bothfixnums(a,b)) {
+        if (a==b) return 0;
+        if (numval(a) < numval(b)) return -1;
+        return 1;
+    }
+    if (!num_to_ptr(a, &ai, &ta, &aptr)) {
+        if (fname) type_error(fname, "number", a); else return 2;
+    }
+    if (!num_to_ptr(b, &bi, &tb, &bptr)) {
+        if (fname) type_error(fname, "number", b); else return 2;
+    }
+    if (cmp_eq(aptr, ta, bptr, tb, eqnans))
+        return 0;
+    if (eq) return 1;
+    if (cmp_lt(aptr, ta, bptr, tb))
+        return -1;
+    return 1;
+}
+
 static value_t fl_div2(value_t a, value_t b)
 {
     double da, db;
     int_t ai, bi;
-    int ta, tb;
+    numerictype_t ta, tb;
-    void *aptr=NULL, *bptr=NULL;
+    void *aptr, *bptr;
-    cprim_t *cp;
 
-    if (isfixnum(a)) {
+    if (!num_to_ptr(a, &ai, &ta, &aptr))
-        ai = numval(a);
-        aptr = &ai;
-        ta = T_FIXNUM;
-    }
-    else if (iscprim(a)) {
-        cp = (cprim_t*)ptr(a);
-        ta = cp_numtype(cp);
-        if (ta <= T_DOUBLE)
-            aptr = cp_data(cp);
-    }
-    if (aptr == NULL)
         type_error("/", "number", a);
-    if (isfixnum(b)) {
+    if (!num_to_ptr(b, &bi, &tb, &bptr))
-        bi = numval(b);
-        bptr = &bi;
-        tb = T_FIXNUM;
-    }
-    else if (iscprim(b)) {
-        cp = (cprim_t*)ptr(b);
-        tb = cp_numtype(cp);
-        if (tb <= T_DOUBLE)
-            bptr = cp_data(cp);
-    }
-    if (bptr == NULL)
         type_error("/", "number", b);
 
     if (ta == T_FLOAT) {
@@ -1294,43 +1321,18 @@ static value_t fl_div2(value_t a, value_t b)
     lerror(DivideError, "/: division by zero");
 }
 
-static void *int_data_ptr(value_t a, int *pnumtype, char *fname)
-{
-    cprim_t *cp;
-    if (iscprim(a)) {
-        cp = (cprim_t*)ptr(a);
-        *pnumtype = cp_numtype(cp);
-        if (*pnumtype < T_FLOAT)
-            return cp_data(cp);
-    }
-    type_error(fname, "integer", a);
-    return NULL;
-}
-
 static value_t fl_bitwise_op(value_t a, value_t b, int opcode, char *fname)
 {
     int_t ai, bi;
-    int ta, tb, itmp;
+    numerictype_t ta, tb, itmp;
     void *aptr=NULL, *bptr=NULL, *ptmp;
     int64_t b64;
 
-    if (isfixnum(a)) {
+    if (!num_to_ptr(a, &ai, &ta, &aptr) || ta >= T_FLOAT)
-        ta = T_FIXNUM;
+        type_error(fname, "integer", a);
-        ai = numval(a);
+    if (!num_to_ptr(b, &bi, &tb, &bptr) || tb >= T_FLOAT)
-        aptr = &ai;
+        type_error(fname, "integer", b);
-        bptr = int_data_ptr(b, &tb, fname);
+
-    }
-    else {
-        aptr = int_data_ptr(a, &ta, fname);
-        if (isfixnum(b)) {
-            tb = T_FIXNUM;
-            bi = numval(b);
-            bptr = &bi;
-        }
-        else {
-            bptr = int_data_ptr(b, &tb, fname);
-        }
-    }
     if (ta < tb) {
         itmp = ta; ta = tb; tb = itmp;
         ptmp = aptr; aptr = bptr; bptr = ptmp;
@@ -1348,6 +1350,8 @@ static value_t fl_bitwise_op(value_t a, value_t b, int opcode, char *fname)
     case T_UINT32: return mk_uint32(*(uint32_t*)aptr & (uint32_t)b64);
     case T_INT64:  return mk_int64( *(int64_t*)aptr  & (int64_t )b64);
     case T_UINT64: return mk_uint64(*(uint64_t*)aptr & (uint64_t)b64);
+    case T_FLOAT:
+    case T_DOUBLE: assert(0);
     }
     break;
     case 1:
@@ -1360,6 +1364,8 @@ static value_t fl_bitwise_op(value_t a, value_t b, int opcode, char *fname)
     case T_UINT32: return mk_uint32(*(uint32_t*)aptr | (uint32_t)b64);
     case T_INT64:  return mk_int64( *(int64_t*)aptr  | (int64_t )b64);
     case T_UINT64: return mk_uint64(*(uint64_t*)aptr | (uint64_t)b64);
+    case T_FLOAT:
+    case T_DOUBLE: assert(0);
     }
     break;
     case 2:
@@ -1372,6 +1378,8 @@ static value_t fl_bitwise_op(value_t a, value_t b, int opcode, char *fname)
     case T_UINT32: return mk_uint32(*(uint32_t*)aptr ^ (uint32_t)b64);
     case T_INT64:  return mk_int64( *(int64_t*)aptr  ^ (int64_t )b64);
     case T_UINT64: return mk_uint64(*(uint64_t*)aptr ^ (uint64_t)b64);
+    case T_FLOAT:
+    case T_DOUBLE: assert(0);
     }
     }
     assert(0);

femtolisp/equal.c

@@ -33,27 +33,6 @@ static void eq_union(htable_t *table, value_t a, value_t b,
     ptrhash_put(table, (void*)b, (void*)ca);
 }
 
-// a is a fixnum, b is a cprim
-static value_t compare_num_cprim(value_t a, value_t b, int eq, int swap)
-{
-    cprim_t *bcp = (cprim_t*)ptr(b);
-    numerictype_t bt = cp_numtype(bcp);
-    fixnum_t ia = numval(a);
-    void *bptr = cp_data(bcp);
-    if (cmp_eq(&ia, T_FIXNUM, bptr, bt, 1))
-        return fixnum(0);
-    if (eq) return fixnum(1);
-    if (swap) {
-        if (cmp_lt(bptr, bt, &ia, T_FIXNUM))
-            return fixnum(-1);
-    }
-    else {
-        if (cmp_lt(&ia, T_FIXNUM, bptr, bt))
-            return fixnum(-1);
-    }
-    return fixnum(1);
-}
-
 static value_t bounded_compare(value_t a, value_t b, int bound, int eq);
 static value_t cyc_compare(value_t a, value_t b, htable_t *table, int eq);
 
@@ -86,6 +65,7 @@ static value_t bounded_compare(value_t a, value_t b, int bound, int eq)
         return NIL;
     int taga = tag(a);
     int tagb = cmptag(b);
+    int c;
     switch (taga) {
     case TAG_NUM :
     case TAG_NUM1:
@@ -93,7 +73,7 @@ static value_t bounded_compare(value_t a, value_t b, int bound, int eq)
             return (numval(a) < numval(b)) ? fixnum(-1) : fixnum(1);
         }
         if (iscprim(b)) {
-            return compare_num_cprim(a, b, eq, 0);
+            return fixnum(numeric_compare(a, b, eq, 1, NULL));
         }
         return fixnum(-1);
     case TAG_SYM:
@@ -106,20 +86,9 @@ static value_t bounded_compare(value_t a, value_t b, int bound, int eq)
             return bounded_vector_compare(a, b, bound, eq);
         break;
     case TAG_CPRIM:
-        if (iscprim(b)) {
+        c = numeric_compare(a, b, eq, 1, NULL);
-            cprim_t *acp=(cprim_t*)ptr(a), *bcp=(cprim_t*)ptr(b);
+        if (c != 2)
-            numerictype_t at=cp_numtype(acp), bt=cp_numtype(bcp);
+            return fixnum(c);
-            void *aptr=cp_data(acp), *bptr=cp_data(bcp);
-            if (cmp_eq(aptr, at, bptr, bt, 1))
-                return fixnum(0);
-            if (eq) return fixnum(1);
-            if (cmp_lt(aptr, at, bptr, bt))
-                return fixnum(-1);
-            return fixnum(1);
-        }
-        else if (isfixnum(b)) {
-            return compare_num_cprim(b, a, eq, 1);
-        }
         break;
     case TAG_CVALUE:
         if (iscvalue(b))

femtolisp/flisp.c

@@ -55,7 +55,7 @@
 static char *builtin_names[] =
     { // special forms
       "quote", "cond", "if", "and", "or", "while", "lambda",
-      "trycatch", "%apply", "%applyn", "set!", "prog1", "begin",
+      "trycatch", "%apply", "%applyn", "set!", "prog1", "for", "begin",
 
       // predicates
       "eq?", "eqv?", "equal?", "atom?", "not", "null?", "boolean?", "symbol?",
@@ -71,7 +71,7 @@ static char *builtin_names[] =
       "+", "-", "*", "/", "=", "<", "compare",
 
       // sequences
-      "vector", "aref", "aset!", "for",
+      "vector", "aref", "aset!",
       "", "", "" };
 
 #define N_STACK 262144
@@ -649,33 +649,6 @@ int isnumber(value_t v)
     return (isfixnum(v) || iscprim(v));
 }
 
-static int numeric_equals(value_t a, value_t b)
-{
-    value_t tmp;
-    if (isfixnum(b)) {
-        tmp=a; a=b; b=tmp;
-    }
-    void *aptr, *bptr;
-    numerictype_t at, bt;
-    if (!iscprim(b)) type_error("=", "number", b);
-    cprim_t *cp = (cprim_t*)ptr(b);
-    fixnum_t fv;
-    bt = cp_numtype(cp);
-    bptr = cp_data(cp);
-    if (isfixnum(a)) {
-        fv = numval(a);
-        at = T_FIXNUM;
-        aptr = &fv;
-    }
-    else if (iscprim(a)) {
-        cp = (cprim_t*)ptr(a);
-        at = cp_numtype(cp);
-        aptr = cp_data(cp);
-    }
-    else type_error("=", "number", a);
-    return cmp_eq(aptr, at, bptr, bt, 0);
-}
-
 // read -----------------------------------------------------------------------
 
 #include "read.c"
@@ -1079,6 +1052,35 @@ static value_t eval_sexpr(value_t e, value_t *penv, int tail, uint32_t envsz)
             }
             v = POP();
             break;
+        case F_FOR:
+            if (!iscons(Stack[bp])) goto notpair;
+            v = car_(Stack[bp]);
+            lo = tofixnum(eval(v), "for");
+            Stack[bp] = cdr_(Stack[bp]);
+            if (!iscons(Stack[bp])) goto notpair;
+            v = car_(Stack[bp]);
+            hi = tofixnum(eval(v), "for");
+            Stack[bp] = cdr_(Stack[bp]);
+            if (!iscons(Stack[bp])) goto notpair;
+            v = car_(Stack[bp]);
+            f = eval(v);
+            v = car(cdr(f));
+            if (!iscons(v) || !iscons(cdr_(cdr_(f))) || cdr_(v) != NIL ||
+                car_(f) != LAMBDA)
+                lerror(ArgError, "for: expected 1 argument lambda");
+            f = cdr_(f);
+            PUSH(f);  // save function cdr
+            SP += 3;  // make space
+            Stack[SP-1] = cdr_(cdr_(f));   // cloenv
+            v = FL_F;
+            for(s=lo; s <= hi; s++) {
+                f = Stack[SP-4];
+                Stack[SP-3] = car_(f);     // lambda list
+                Stack[SP-2] = fixnum(s);   // argument value
+                v = car_(cdr_(f));
+                if (!selfevaluating(v)) v = eval_sexpr(v, &Stack[SP-3], 0, 3);
+            }
+            break;
         case F_TRYCATCH:
             v = do_trycatch(car(Stack[bp]), penv, envsz);
             break;
@@ -1323,7 +1325,7 @@ static value_t eval_sexpr(value_t e, value_t *penv, int tail, uint32_t envsz)
                 v = (v == e) ? FL_T : FL_F;
             }
             else {
-                v = numeric_equals(v, e) ? FL_T : FL_F;
+                v = (!numeric_compare(v,e,1,0,"=")) ? FL_T : FL_F;
             }
             break;
         case F_LT:
@@ -1380,28 +1382,6 @@ static value_t eval_sexpr(value_t e, value_t *penv, int tail, uint32_t envsz)
                 penv = &Stack[SP-2];
             }
             goto eval_top;
-        case F_FOR:
-            argcount("for", nargs, 3);
-            lo = tofixnum(Stack[SP-3], "for");
-            hi = tofixnum(Stack[SP-2], "for");
-            f = Stack[SP-1];
-            v = car(cdr(f));
-            if (!iscons(v) || !iscons(cdr_(cdr_(f))) || cdr_(v) != NIL ||
-                car_(f) != LAMBDA)
-                lerror(ArgError, "for: expected 1 argument lambda");
-            f = cdr_(f);
-            PUSH(f);  // save function cdr
-            SP += 3;  // make space
-            Stack[SP-1] = cdr_(cdr_(f));   // cloenv
-            v = FL_F;
-            for(s=lo; s <= hi; s++) {
-                f = Stack[SP-4];
-                Stack[SP-3] = car_(f);     // lambda list
-                Stack[SP-2] = fixnum(s);   // argument value
-                v = car_(cdr_(f));
-                if (!selfevaluating(v)) v = eval_sexpr(v, &Stack[SP-3], 0, 3);
-            }
-            break;
         case F_SPECIAL_APPLYN:
             POPN(4);
             v = POP();
@@ -1900,7 +1880,7 @@ static value_t apply_cl(uint32_t nargs)
                 v = (v == e) ? FL_T : FL_F;
             }
             else {
-                v = numeric_equals(v, e) ? FL_T : FL_F;
+                v = (!numeric_compare(v,e,1,0,"=")) ? FL_T : FL_F;
             }
             POPN(1);
             Stack[SP-1] = v;
@@ -1996,6 +1976,7 @@ static value_t apply_cl(uint32_t nargs)
         case OP_LOADNIL: PUSH(NIL); break;
         case OP_LOAD0: PUSH(fixnum(0)); break;
         case OP_LOAD1: PUSH(fixnum(1)); break;
+        case OP_LOADI8: s = (int8_t)code[ip++]; PUSH(fixnum(s)); break;
         case OP_LOADV:
             assert(code[ip] < vector_size(*pvals));
             v = vector_elt(*pvals, code[ip]); ip++;

femtolisp/flisp.h

@@ -117,7 +117,8 @@ extern uint32_t SP;
 enum {
     // special forms
     F_QUOTE=0, F_COND, F_IF, F_AND, F_OR, F_WHILE, F_LAMBDA,
-    F_TRYCATCH, F_SPECIAL_APPLY, F_SPECIAL_APPLYN, F_SETQ, F_PROG1, F_BEGIN,
+    F_TRYCATCH, F_SPECIAL_APPLY, F_SPECIAL_APPLYN, F_SETQ, F_PROG1, F_FOR,
+    F_BEGIN,
 
     // functions
     F_EQ, F_EQV, F_EQUAL, F_ATOM, F_NOT, F_NULL, F_BOOLEANP, F_SYMBOLP,
@@ -127,7 +128,7 @@ enum {
     F_EVAL, F_APPLY,
     F_ADD, F_SUB, F_MUL, F_DIV, F_NUMEQ, F_LT, F_COMPARE,
 
-    F_VECTOR, F_AREF, F_ASET, F_FOR,
+    F_VECTOR, F_AREF, F_ASET,
     F_TRUE, F_FALSE, F_NIL,
     N_BUILTINS
 };
@@ -292,6 +293,7 @@ int isstring(value_t v);
 int isnumber(value_t v);
 int isiostream(value_t v);
 value_t cvalue_compare(value_t a, value_t b);
+int numeric_compare(value_t a, value_t b, int eq, int eqnans, char *fname);
 
 void to_sized_ptr(value_t v, char *fname, char **pdata, size_t *psz);
 

femtolisp/opcodes.h

@@ -3,7 +3,7 @@
 
 enum {
     OP_NOP=0, OP_DUP, OP_POP, OP_CALL, OP_TCALL, OP_JMP, OP_BRF, OP_BRT,
-    OP_JMPL, OP_BRFL, OP_BRTL, OP_RET, OP_TAPPLY,
+    OP_JMPL, OP_BRFL, OP_BRTL, OP_RET, OP_TAPPLY, OP_FOR,
 
     OP_EQ, OP_EQV, OP_EQUAL, OP_ATOMP, OP_NOT, OP_NULLP, OP_BOOLEANP,
     OP_SYMBOLP, OP_NUMBERP, OP_BOUNDP, OP_PAIRP, OP_BUILTINP, OP_VECTORP,
@@ -14,11 +14,11 @@ enum {
 
     OP_ADD, OP_SUB, OP_MUL, OP_DIV, OP_NUMEQ, OP_LT, OP_COMPARE,
 
-    OP_VECTOR, OP_AREF, OP_ASET, OP_FOR,
+    OP_VECTOR, OP_AREF, OP_ASET,
 
-    OP_LOADT, OP_LOADF, OP_LOADNIL, OP_LOAD0, OP_LOAD1, OP_LOADV, OP_LOADVL,
+    OP_LOADT, OP_LOADF, OP_LOADNIL, OP_LOAD0, OP_LOAD1, OP_LOADI8,
-    OP_LOADG, OP_LOADA, OP_LOADC, OP_LOADGL, OP_SETG, OP_SETA, OP_SETC,
+    OP_LOADV, OP_LOADVL, OP_LOADG, OP_LOADA, OP_LOADC, OP_LOADGL,
-    OP_SETGL,
+    OP_SETG, OP_SETA, OP_SETC, OP_SETGL,
 
     OP_CLOSURE, OP_TRYCATCH, OP_ARGC, OP_VARGC
 };

femtolisp/system.lsp

@@ -661,8 +661,8 @@
 	 (io.close F)
 	 (raise `(load-error ,filename ,e)))))))
 
-;(load (string *install-dir* *directory-separator* "compiler.lsp"))
+(load (string *install-dir* *directory-separator* "compiler.lsp"))
-;(define (load-process x) ((compile-thunk (expand x))))
+(define (load-process x) ((compile-thunk (expand x))))
 
 (define *banner* (string.tail "
 ;  _

femtolisp/todo

@@ -1017,12 +1017,13 @@ typedef struct _fltype_t {
 
 new evaluator todo:
 
-- need builtin = to handle nans properly, fix equal? on nans
+* need builtin = to handle nans properly, fix equal? on nans
 - builtin quasi-opaque function type
   fields: signature, maxstack, bcode, vals, cloenv
   function->vector
-- make (for ...) a special form
+* make (for ...) a special form
-- trycatch should require 2nd arg to be a lambda expression
+* trycatch should require 2nd arg to be a lambda expression
+* immediate load int8 instruction
 - maxstack calculation, replace Stack with C stack, alloca
   - stack traces and better debugging support
 - lambda lifting

femtolisp/wt.lsp

@@ -1,8 +1,28 @@
-(set! i 0)
 (define-macro (while- test . forms)
   `((label -loop- (lambda ()
                     (if ,test
                         (begin ,@forms
                                (-loop-))
-			nil)))))
+                      ())))))
-(while (< i 10000000) (set! i (+ i 1)))
+
+(define (tw)
+  (set! i 0)
+  (while (< i 10000000) (set! i (+ i 1))))
+
+(define (tw2)
+  (letrec ((loop (lambda ()
+                   (if (< i 10000000)
+                       (begin (set! i (+ i 1))
+                              (loop))
+		     ()))))
+          (loop)))
+
+#|
+interpreter:
+while: 1.82sec
+macro: 2.98sec
+
+compiler:
+while: 0.72sec
+macro: 1.24sec
+|#

llt/dtypes.h

@@ -116,7 +116,7 @@ typedef u_ptrint_t uptrint_t;
 #define LABS(n) (((n)^((n)>>(NBITS-1))) - ((n)>>(NBITS-1)))
 #define NBABS(n,nb) (((n)^((n)>>((nb)-1))) - ((n)>>((nb)-1)))
 #define DFINITE(d) (((*(int64_t*)&(d))&0x7ff0000000000000LL)!=0x7ff0000000000000LL)
-#define DNAN(d) (((*(int64_t*)&(d))&0x7ff8000000000000LL)==0x7ff8000000000000LL)
+#define DNAN(d) ((d)!=(d))
 
 extern double D_PNAN;
 extern double D_NNAN;