Commits

Carter Schonwald committed fae55b7

more benchmark examples

Comments (0)

Files changed (5)

     where 
         res =  cmm_factorialWord   n 
 
+foreign import ccall unsafe "normal.c c_doubleNum" 
+    c_doubleNum_unsafeFFI:: CULong ->CULong 
+{-# INLINE wrapper_c_doubleNum_UNSAFE #-}
+wrapper_c_doubleNum_UNSAFE :: Word64 -> Word64  
+wrapper_c_doubleNum_UNSAFE num  =  fromIntegral $! (c_doubleNum_unsafeFFI $! fromIntegral num   )
+
+
+foreign import ccall safe "normal.c  c_doubleNum_alt" 
+    c_doubleNum_safeFFI:: CULong ->CULong 
+
+foreign import prim "c4hs_Factorial" c4hs_Factorial :: Word# -> Word#
+
+{-# INLINE wrapped_C4HS_factorial #-}
+wrapped_C4HS_factorial (W64# num) = W64# res
+    where res = c4hs_Factorial num 
+
+{-# INLINE wrapper_c_doubleNum_SAFE #-}
+wrapper_c_doubleNum_SAFE :: Word64 -> Word64  
+wrapper_c_doubleNum_SAFE num  =  fromIntegral $! (c_doubleNum_safeFFI $! fromIntegral num   )
+
+
+
 foreign import prim "c4hs_doubleWord" c4hs_doubleWord :: Word# ->Word#
 main =  defaultMainWith defaultConfig{cfgSamples=ljust 30} (return ()) [
         bgroup "double a  64bit word" [
             bcompare [ bench "wrapped_cmmDoubleWord 1000" $! whnfIter 1000 wrapped_cmmDoubleWord 7 ,
                         bench "hs double word  1000" $! whnfIter 1000 hsDoubleWord64 7 ,
                         bench "hs double word INLINED 1000" $! whnfIter 1000 hsDoubleWord64Inlined 7 ,
-                        bench "hs double int  C4hs  1000" $!  whnfIter 1000  wrapped_C4HS_doubleword 7 
+                        bench "hs double int  C4hs  1000" $!  whnfIter 1000  wrapped_C4HS_doubleword 7,
+                        bench " double int  C UNSAFE  1000" $!  whnfIter 1000  wrapper_c_doubleNum_UNSAFE 7,
+                        bench " double int  C SAFE 1000" $!  whnfIter 1000  wrapper_c_doubleNum_SAFE 7
                         ]],
         bgroup "factorial   64bit word" [
             bcompare [ bench "wrapped_cmm_factorialWord " $! whnf wrapped_cmm_factorialWord 10,
                         bench "hs factorial word  " $! whnf hsFactorial 10,
-                        bench "hs factorial  word INLINED " $! whnf hsFactorialInlined 10
-                        --bench "hs double int  C4hs  1000" $!  whnfIter 1000  wrapped_C4HS_factorial 10 
+                        bench "hs factorial  word INLINED " $! whnf hsFactorialInlined 10,
+                        bench "factorial   C4hs  1000" $!  whnf wrapped_C4HS_factorial 10 
                             ]   ] 
 
 
 
 }
 
-extern void c4hs_doubleWord(GHC_ARGS){
+extern void c4hs_Factorial(GHC_ARGS){
      HsCall Retfun = (HsCall)sp[0];
-     int64_t  val = r1 ; 
-     val = val + val ; 
-     return returnN(Retfun, baseReg,sp,hp, spLim, val ) ; 
+    unsigned long num = r1 ; 
+     unsigned long accum = num ; 
+    num -- ;
+    while(num > 0){
+        accum *= num ;
+        num -- ; 
+
+    }
+    return   returnN(Retfun, baseReg,sp,hp, spLim, accum ) ; 
 
 }
 
+
+
+
+
+unsigned long  c_doubleNum( unsigned long  num){
+
+    return (num + num); 
+
+}
+
+unsigned long  c_doubleNum_alt ( unsigned long  num){
+
+    return (num + num); 
+
+}
+
+
+unsigned long c_factorialNum(unsigned long num){
+    unsigned long accum = num ; 
+    num -- ;
+    while(num > 0){
+        accum *= num ;
+        num -- ; 
+
+    }
+    return accum ; 
+
+
+}
   ctx.find_program('ghc', var='GHC')
   ctx.find_program('sed', var='SED')
   ctx.env.FIXUP    = 's/call void/call cc10 void/; s/define void/define cc10 void/;'
-  ctx.env.LLCOPT   = '-O3 -pre-RA-sched=list-burr -regalloc=greedy -relocation-model=static'
-  ctx.env.CLANGOPT = '-O3'
+  ctx.env.LLCOPT   = '-O3 -pre-RA-sched=list-burr -regalloc=greedy -relocation-model=static '
+  ctx.env.CLANGOPT = '-O3 -march=native'
   ctx.env.GHCOPT    = '-fllvm -O2 -rtsopts -threaded'
   ctx.env.GHC_CMM_OPT= '-fllvm -O2  -dcmm-lint  -rtsopts -threaded '
 
 def build(bld):
   # bld(rule='${RAGEL} -G2 ${SRC} -o ${TGT}',                          source='Kospi.rl',             target='Kospi.c')
   bld(rule='${CLANG} ${CLANGOPT} -emit-llvm -S -c ${SRC} -o ${TGT}', source='c4hs.c',              target='c4hs.ll')
+  bld(rule='${CLANG} ${CLANGOPT} -march=native   ${SRC} -o ${TGT} -c ',            source='normal.c',              target='normal.o ')
   bld(rule='${SED} -e "${FIXUP}" < ${SRC} > ${TGT}',                 source='c4hs.ll',             target='c4hs.ll-patched')
   bld(rule='${LLC} ${LLCOPT} -filetype=obj ${SRC} -o ${TGT}',        source='c4hs.ll-patched',     target='c4hs.o')
   bld(rule='${GHC} ${GHC_CMM_OPT} -c   ${SRC} -o ${TGT} ' ,                                 source='MyPrims.cmm',          target='MyPrims.o')
-  bld(rule='${GHC} ${GHCOPT} --make -outputdir=. ${SRC} -o ${TGT}',  source=['c4hs.o', 'MyPrims.o','Main.hs'], target='bench')
+  bld(rule='${GHC} ${GHCOPT} --make -outputdir=. ${SRC} -o ${TGT}',  source=['normal.o','c4hs.o', 'MyPrims.o','Main.hs'], target='bench')

who-ya-gonna-call.md

 
 * Ignore optimization completely
 
-* Pretend we're using a strict language
+* Kinda Gloss over evaluation strategy 
 
 * Lets actually just work though it for the untyped lambda calculus
 
 
 * Closures close, accept not substitutes!
 
+# Analogous evaluator 
+
+\begin{code}
+whnf :: Exp a -> Exp a
+ whnf (f :@ a) = case whnf f of
+    Closure f b  -> whnf (instantiate1 a $  (b >>>= f  ))
+    --- heres the lambda one again, shouldn't happen though!
+    Lambda  b  -> whnf (instantiate1 a  b)
+   f'    -> f' :@ a
+ whnf e = e
+\end{code}
+
+
+# Bah, Boring and not an interesting evaluator
+
+* we're using the haskell stack implicitly to support a call stack in this lang!
+
+* lets make our evaluator have its own little stack of contexts, have 
+    every function only appear in tail position.
+
 
 
 <!-- # WHat else