CELS: (almost) successful compilation

git-svn-id: https://freearc.svn.sourceforge.net/svnroot/freearc@449 3a4f7f31-9599-433d-91b1-573e8b61252c

ArcvProcessExtract.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -cpp #-}
 ----------------------------------------------------------------------------------------------------
 ---- Ïðîöåññ ðàñïàêîâêè âõîäíûõ àðõèâîâ.                                                        ----
 ---- Âûçûâàåòñÿ èç ArcExtract.hs è ArcCreate.hs (ïðè îáíîâëåíèè è ñëèÿíèè àðõèâîâ).             ----
@@ -15,6 +16,7 @@ import Foreign.Ptr
 import Foreign.Marshal.Utils
 import Foreign.Storable
 
+import TABI hiding (doNothing)
 import Utils
 import Errors
 import Process
@@ -70,7 +72,7 @@ decompress_block command cfile state count_cbytes pipe = mdo
   bytesLeft <- ref (blCompSize block - startPos)
 
   let reader buf size  =  do aBytesLeft <- val bytesLeft
-                             let bytes   = minI size aBytesLeft
+                             let bytes   = minI (size::Int) aBytesLeft
                              len        <- archiveBlockReadBuf block buf bytes
                              bytesLeft  -= i len
                              count_cbytes  len
@@ -155,6 +157,41 @@ de_compress_PROCESS1 de_compress reader times command limit_memory comprMethod n
   let -- Íàïå÷àòàòü êàðòó ïàìÿòè
       showMemoryMap = do printLine$ "\nBefore "++show num++": "++comprMethod++"\n"
                          testMalloc
+#ifdef FREEARC_CELS
+  let callback p = do
+        service <- TABI.required p ""
+        case service of
+          -- Ïðîöåäóðà ÷òåíèÿ âõîäíûõ äàííûõ ïðîöåññà óïàêîâêè/ðàñïàêîâêè
+          "read" -> do buf  <- TABI.required p "buf"
+                       size <- TABI.required p "size"
+                       reader buf size
+          -- Ïðîöåäóðà çàïèñè âûõîäíûõ äàííûõ
+          "write" -> do buf  <- TABI.required p "buf"
+                        size <- TABI.required p "size"
+                        total' += i size
+                        uiWriteData num (i size)
+                        resend_data pipe (DataBuf buf size)
+          -- "Êâàçèçàïèñü" ïðîñòî ñèãíàëèçèðóåò ñêîëüêî äàííûõ áóäåò çàïèñàíî â ðåçóëüòàòå ñæàòèÿ
+          "quasiwrite" -> do bytes <- TABI.required p "bytes"
+                             uiQuasiWriteData num bytes
+                             return aFREEARC_OK
+          -- Èíôîðìàöèÿ î ÷èñòîì âðåìåíè âûïîëíåíèÿ óïàêîâêè/ðàñïàêîâêè
+          "time" -> do time <- TABI.required p "time"
+                       time' =: time
+                       return aFREEARC_OK
+          -- Ïðî÷èå (íåïîääåðæèâàåìûå) callbacks
+          _ -> return aFREEARC_ERRCODE_NOT_IMPLEMENTED
+
+  let -- Ïîñêîëüêó Haskell'îâñêèé êîä, âûçûâàåìûé èç Ñè, íå ìîæåò ïîëó÷àòü èñêëþ÷åíèé, äîáàâèì ê ïðîöåäóðàì ÷òåíèÿ/çàïèñè ÿâíûå ïðîâåðêè
+      checked_callback p = do
+        operationTerminated' <- val operationTerminated
+        if operationTerminated'
+          then return CompressionLib.aFREEARC_ERRCODE_OPERATION_TERMINATED   -- foreverM doNothing0
+          else callback p
+      -- Non-debugging wrapper
+      debug f = f
+      debug_checked_callback what buf size = undefined --TABI.call checked_callback [Pair "" what, Pair "buf" size, Pair "buf" size]
+#else
   let -- Ïðîöåäóðà ÷òåíèÿ âõîäíûõ äàííûõ ïðîöåññà óïàêîâêè/ðàñïàêîâêè
       callback "read" buf size = do res <- reader buf size
                                     return res
@@ -188,14 +225,16 @@ de_compress_PROCESS1 de_compress reader times command limit_memory comprMethod n
 -}
       -- Non-debugging wrapper
       debug f what buf size = f what buf size
+      debug_checked_callback = debug checked_callback
+#endif
 
   -- ÑÎÁÑÒÂÅÍÍÎ ÓÏÀÊÎÂÊÀ ÈËÈ ÐÀÑÏÀÊÎÂÊÀ
-  res <- debug checked_callback "read" nullPtr 0  -- ýòîò âûçîâ ïîçâîëÿåò îòëîæèòü çàïóñê ñëåäóþùåãî â öåïî÷êå àëãîðèòìà óïàêîâêè/ðàñïàêîâêè äî ìîìåíòà, êîãäà ïðåäûäóùèé âîçâðàòèò õîòü êàêèå-íèáóäü äàííûå (à åñëè ýòî ïîáëî÷íûé àëãîðèòì - äî ìîìåíòà, êîãäà îí îáðàáîòàåò âåñü áëîê)
+  res <- debug_checked_callback "read" nullPtr 0  -- ýòîò âûçîâ ïîçâîëÿåò îòëîæèòü çàïóñê ñëåäóþùåãî â öåïî÷êå àëãîðèòìà óïàêîâêè/ðàñïàêîâêè äî ìîìåíòà, êîãäà ïðåäûäóùèé âîçâðàòèò õîòü êàêèå-íèáóäü äàííûå (à åñëè ýòî ïîáëî÷íûé àëãîðèòì - äî ìîìåíòà, êîãäà îí îáðàáîòàåò âåñü áëîê)
   opt_testMalloc command  &&&  showMemoryMap      -- íàïå÷àòàåì êàðòó ïàìÿòè íåïîñðåäñòâåííî ïåðåä íà÷àëîì ñæàòèÿ
   real_method <- limit_memory num comprMethod     -- îáðåæåì ìåòîä ñæàòèÿ ïðè íåõâàòêå ïàìÿòè
   result <- if res<0  then return res
                       else de_compress num real_method (debug checked_callback)
-  debug checked_callback "finished" nullPtr result
+  debug_checked_callback "finished" nullPtr result
   -- Ñòàòèñòèêà
   total <- val total'
   time  <- val time'

Compression.hs

@@ -255,12 +255,12 @@ decompress method callback      - 
 -}
 
 -- |Ïðîöåäóðû óïàêîâêè äëÿ ðàçëè÷íûõ àëãîðèòìîâ ñæàòèÿ.
-freearcCompress   num method | aSTORING ==  method =  copy_data
-freearcCompress   num method | isFakeMethod method =  eat_data
+--freearcCompress   num method | aSTORING ==  method =  copy_data
+--freearcCompress   num method | isFakeMethod method =  eat_data
 freearcCompress   num method                       =  CompressionLib.compress method
 
 -- |Ïðîöåäóðû ðàñïàêîâêè äëÿ ðàçëè÷íûõ àëãîðèòìîâ ñæàòèÿ.
-freearcDecompress num method | aSTORING ==  method =  copy_data
+--freearcDecompress num method | aSTORING ==  method =  copy_data
 freearcDecompress num method | isFakeMethod method =  impossible_to_decompress   -- ýòè òèïû ñæàòûõ äàííûõ íå ïîäëåæàò ðàñïàêîâêå
 freearcDecompress num method                       =  CompressionLib.decompress method
 

Compression/CELS.cpp

@@ -1,6 +1,9 @@
 #include <stdio.h>
 #include "CELS.h"
 
+namespace CELS
+{
+
 int COMPRESSION_METHOD::server()
 {
   char *service = p._str("service");
@@ -25,6 +28,7 @@ int COMPRESSION_METHOD::server()
   return FREEARC_ERRCODE_NOT_IMPLEMENTED;
 }
 
+}
 
 // ****************************************************************************************************************************
 // ÏÎÄÄÅÐÆÊÀ ÒÀÁËÈÖÛ ÇÀÐÅÃÈÑÒÐÈÐÎÂÀÍÍÛÕ ÌÅÒÎÄΠÑÆÀÒÈß È ÏÎÈÑÊ Â ÝÒÎÉ ÒÀÁËÈÖÅ ÐÅÀËÈÇÀÖÈÈ ×ÈÑÒÎ ÊÎÍÊÐÅÒÍÎÃÎ ÌÅÒÎÄÀ *************
@@ -44,7 +48,7 @@ int CELS_Register (TABI_FUNCTION *method)
   return result;
 }
 
-//
+// Central CELS function that provides all CELS services
 int CELS_Call (TABI_ELEMENT* params)
 {
   for (int i=0; i<methodsCount; i++)

Compression/CELS.h

@@ -65,6 +65,9 @@ extern "C" {
 
 typedef TABI_FUNCTION CALLBACK_FUNC;
 
+namespace CELS
+{
+
 struct COMPRESSION_METHOD
 {
   TABI_MAP p;      // Call parameters
@@ -104,7 +107,12 @@ struct COMPRESSION_METHOD
   virtual MemSize GetDecompressionMem (void) = 0;
 };
 
+}
+
+// Compression method registration
 int CELS_Register (TABI_FUNCTION *method);
+// Central CELS function that provides all CELS services
+int CELS_Call (TABI_ELEMENT* params);
 
 
 // ****************************************************************************************************************************

Compression/CompressionLib.hs

@@ -3,7 +3,7 @@
 ---- Óïàêîâêà è ðàñïàêîâêà äàííûõ.                                                              ----
 ---- Èíòåðôåéñ ñ íàïèñàííûìè íà Ñè ïðîöåäóðàìè, âûïîëíÿþùèìè âñþ ðåàëüíóþ ðàáîòó.               ----
 ----------------------------------------------------------------------------------------------------
-#if 0
+#ifdef FREEARC_CELS
 module CompressionLib (module HsCELS) where
 import HsCELS
 #else

Compression/HsCELS.hs

@@ -135,7 +135,7 @@ askMethod service params method  =  unsafePerformIO$ TABI.call server ("service"
 ----------------------------------------------------------------------------------------------------
 
 -- |Server function implemented in C++
-foreign import ccall safe "Compression.h"
+foreign import ccall safe "Compression.h CELS_Call"
   server :: TABI.C_FUNCTION
 
 -- |Get/set number of threads used for (de)compression