CELS: a first few working calls

git-svn-id: https://freearc.svn.sourceforge.net/svnroot/freearc@450 3a4f7f31-9599-433d-91b1-573e8b61252c
abandonware · Jul 24, 2009 · 7df94f1 · 7df94f1
1 parent b444a26
commit 7df94f1
Show file tree

Hide file tree

Showing 6 changed files with 28 additions and 13 deletions.
diff --git a/Compression.hs b/Compression.hs
@@ -255,7 +255,7 @@ decompress method callback      -
 -}
 
 -- |Ïðîöåäóðû óïàêîâêè äëÿ ðàçëè÷íûõ àëãîðèòìîâ ñæàòèÿ.
---freearcCompress   num method | aSTORING ==  method =  copy_data
+--to do: freearcCompress   num method | aSTORING ==  method =  copy_data
 --freearcCompress   num method | isFakeMethod method =  eat_data
 freearcCompress   num method                       =  CompressionLib.compress method
 

diff --git a/Compression/CELS.cpp b/Compression/CELS.cpp
@@ -8,13 +8,16 @@ int COMPRESSION_METHOD::server()
 {
   char *service = p._str("service");
 
+  if (strequ (service, "encryption?"))    return 1;               // to do: ---
+
   // Global services
   if (strequ (service, "register"))               return FREEARC_OK; //to do: Register();
 
   // Invocation-specific services
   if (strequ (service, "decompress"))             {parse_method(); return decompress (p._callback("callback"), p);}
 #ifndef FREEARC_DECOMPRESS_ONLY
   if (strequ (service, "compress"))               {parse_method(); return compress   (p._callback("callback"), p);}
+  if (strequ (service, "canonize"))               {parse_method();                                     char a[1000]; ShowCompressionMethod(a); return p._return(a);}
   if (strequ (service, "SetCompressionMem"))      {parse_method(); SetCompressionMem  (p._int("mem")); char a[1000]; ShowCompressionMethod(a); return p._return(a);}
   if (strequ (service, "SetDictionary"))          {parse_method(); SetDictionary      (p._int("mem")); char a[1000]; ShowCompressionMethod(a); return p._return(a);}
   if (strequ (service, "SetBlockSize"))           {parse_method(); SetBlockSize       (p._int("mem")); char a[1000]; ShowCompressionMethod(a); return p._return(a);}
@@ -42,7 +45,7 @@ TABI_FUNCTION* methodsTable[MAX_COMPRESSION_METHODS];
 int CELS_Register (TABI_FUNCTION *method)
 {
   CHECK (methodsCount < elements(methodsTable), (s,"INTERNAL ERROR: Overflow of compression methods table"));
-  int result = (*method)(TABI_DYNAMAP("register"));
+  int result = (*method)(TABI_DYNAMAP("service","register"));
   if (result==FREEARC_OK)
     methodsTable[methodsCount++] = method;
   return result;
@@ -51,6 +54,7 @@ int CELS_Register (TABI_FUNCTION *method)
 // Central CELS function that provides all CELS services
 int CELS_Call (TABI_ELEMENT* params)
 {
+  TABI_MAP p(params); p.dump();
   for (int i=0; i<methodsCount; i++)
   {
     int x = methodsTable[i](params);

diff --git a/Compression/HsCELS.hs b/Compression/HsCELS.hs
@@ -84,17 +84,17 @@ canonizeCompressionMethod = mapMethod "canonize" []
 
 -- |Set memory used to compress/decompress, dictionary or block size of method given
 [setCompressionMem, setDecompressionMem, setDictionary, setBlockSize :: MemSize -> Method -> Method] =
-  (flip map) (words "setCompressionMem setDecompressionMem setDictionary setBlockSize")
+  (flip map) (words "SetCompressionMem SetDecompressionMem SetDictionary SetBlockSize")
              (\service mem -> mapMethod service ["mem" ==> mem])
 
 -- |Put upper limit to memory used to compress/decompress, dictionary or block size of method given
 [limitCompressionMem, limitDecompressionMem, limitDictionary, limitBlockSize :: MemSize -> Method -> Method] =
-  (flip map) (words "limitCompressionMem limitDecompressionMem limitDictionary limitBlockSize")
+  (flip map) (words "LimitCompressionMem LimitDecompressionMem LimitDictionary LimitBlockSize")
              (\service mem -> mapMethod service ["mem" ==> mem])
 
 -- |Returns memory used to compress/decompress, dictionary or block size of method given
 [getCompressionMem, getDecompressionMem, getDictionary, getBlockSize :: Method -> MemSize] =
-  (flip map) (words "getCompressionMem getDecompressionMem getDictionary getBlockSize")
+  (flip map) (words "GetCompressionMem GetDecompressionMem GetDictionary GetBlockSize")
              (\service -> mapMethod service [])
 
 -- |Check boolean property of compression method, returning FALSE if it's not implemented

diff --git a/Compression/_TABI/tabi.h b/Compression/_TABI/tabi.h
@@ -12,7 +12,7 @@ typedef union _TABI_VALUE
 {
 	char          placeholder[16];
 	long long     int_number;
-	double        fp_number;
+	double        float_number;
 	char*         str;
 	void*         ptr;
 	VOID_FUNC     funcptr;
@@ -60,7 +60,7 @@ class TABI_MAP
 		TABI_GETTER( unsigned,        unsigned,        _unsigned,   TABI_INTEGER,   int_number);
 		TABI_GETTER( long,            long,            _long,       TABI_INTEGER,   int_number);
 		TABI_GETTER( long long,       long long,       _longlong,   TABI_INTEGER,   int_number);
-		TABI_GETTER( double,          double,          _double,     TABI_FLOATING,  fp_number);
+		TABI_GETTER( double,          double,          _double,     TABI_FLOATING,  float_number);
 		TABI_GETTER( char*,           char*,           _str,        TABI_STRING,    str);
 		TABI_GETTER( const char*,     char*,           _cstr,       TABI_STRING,    str);
 		TABI_GETTER( void*,           void*,           _ptr,        TABI_PTR,       ptr);
@@ -70,15 +70,25 @@ class TABI_MAP
 		template<class T> TABI_RESULT_TYPE _return(T v) {return _callback("return") (TABI_DYNAMAP(v));}
 
                 // Dump first n elements (for debugging purposes)
-		void dump(int n)
+		void dump(int n=0)
 		{
-			for (int i=0; i<n; i++)
+			for (int i=0; i<n?n:999; i++)
 			{
-				printf("%10s ",p[i].name);
 				for (int j= 0; j< 4; j++)   printf("%02x ", *((unsigned char*)(p+i)+j)); printf("  ");
 				for (int j= 4; j< 8; j++)   printf("%02x ", *((unsigned char*)(p+i)+j)); printf("  ");
-				for (int j= 8; j<24; j++)   printf("%02x ", *((unsigned char*)(p+i)+j)); printf("\n");
+				for (int j= 8; j<24; j++)   printf("%02x ", *((unsigned char*)(p+i)+j)); printf("  ");
+				if (p[i].name == NULL)
+					break;
+				printf("%10s ", p[i].name);
+				switch (p[i].type)
+				{
+					case TABI_STRING:	if (p[i].value.str)   printf("%s", p[i].value.str); break;
+					case TABI_INTEGER:	printf("%lld", p[i].value.int_number); break;
+					case TABI_FLOATING:	printf("%g", p[i].value.float_number); break;
+				}
+				printf("\n");
 			}
+			printf("\n");
 		}
 
 	protected:
@@ -120,7 +130,7 @@ class TABI_DYNAMAP : public TABI_MAP
 		TABI_SETTER( unsigned,        unsigned,        _unsigned,   TABI_INTEGER,   int_number);
 		TABI_SETTER( long,            long,            _long,       TABI_INTEGER,   int_number);
 		TABI_SETTER( long long,       long long,       _longlong,   TABI_INTEGER,   int_number);
-		TABI_SETTER( double,          double,          _double,     TABI_FLOATING,  fp_number);
+		TABI_SETTER( double,          double,          _double,     TABI_FLOATING,  float_number);
 		TABI_SETTER( char*,           char*,           _str,        TABI_STRING,    str);
 		TABI_SETTER( const char*,     char*,           _cstr,       TABI_STRING,    str);
 		TABI_SETTER( void*,           void*,           _ptr,        TABI_PTR,       ptr);

diff --git a/Compression/_TABI/tabi.hsc b/Compression/_TABI/tabi.hsc
@@ -115,7 +115,7 @@ pokeELEMENT array i (Pair n v) = do
 -- |Call that returns value of arbitrary type
 callret :: Value a => C_FUNCTION -> [ELEMENT] -> IO a
 callret server params = do
-  result <- newIORef$ error "undefined result"                        -- create variable to store result of call
+  result <- newIORef$ error "TABI.callret: undefined result"          -- create variable to store result of call
   let return_callback p = do                                          -- callback used to return result of call
         writeIORef result =<< TABI.required p ""
         return 0

diff --git a/compile.cmd b/compile.cmd
@@ -21,5 +21,6 @@
 @set options=-iCompression -iCompression/_TABI -threaded -fglasgow-exts -fallow-undecidable-instances -fallow-overlapping-instances -fno-monomorphism-restriction -fbang-patterns
 @set ghc_rts_options=+RTS -A4m -H50m -M300m
 @del %exe% >nul 2>nul
+@hsc2hs Compression/_TABI/tabi.hsc
 t ghc.exe --make %1 %2 %3 Arc.hs %options% %defines% %c_modules% Unarc/gui/icon.o -odir %tempdir% -hidir %tempdir% -o %exe% %ghc_rts_options%
 @del Compression\CompressionLib_stub.? >nul 2>nul