HSPポータル
サイトマップ お問い合わせ


HSPTV!掲示板


未解決 解決 停止 削除要請

2015
0212
甜菜飛鳥WindowsAPIによるスタンドアロンな連想配列の実装を試行4解決


甜菜飛鳥

リンク

2015/2/12(Thu) 21:43:13|NO.67382

ふと、Win32APIのウインドウプロパティを利用してスタンドアロンな連想配列をHSPで実現できないかな?と思って試してみました。
DLLが実行ファイルに埋め込めるようになった今、いかほどの需要があるのかは分かりませんが公開してみます。
(結構、遠回りなことをやっているのかもしれないので確認もこめて)

処理時間は普通の変数読み書きの数十倍程度かかりますが、オプションの読み書きなどの定期的な処理には十分実用に足ると思います。
なお、内部的にコールバック関数を使用しているのですが、それには下記スレッドに転載されているモジュールを流用させていただきました。
当モジュールの作者であるtds12さんにはこの場を借りてお礼申し上げます。

http://hsp.tv/play/pforum.php?mode=all&num=62130

#include "modclbk3a1.as" #module mod_assoc #uselib "kernel32.dll" #cfunc lstrlen "lstrlenA" int #func lstrcpy "lstrcpyA" int, int #func RtlMoveMemory "RtlMoveMemory" int, int, int #cfunc GetProcessHeap "GetProcessHeap" #cfunc HeapAlloc "HeapAlloc" int, int, int #func HeapFree "HeapFree" int, int, int #cfunc HeapSize "HeapSize" int, int, int #uselib "user32.dll" #cfunc GetWindowLong "GetWindowLongA" int, int #func SetWindowLong "SetWindowLongA" int, int, int #cfunc GetProp "GetPropA" int, str #func SetProp "SetPropA" int, str, int #func RemoveProp "RemovePropA" int, str #func EnumProps "EnumPropsA" int, int #cfunc CreateWindowEx "CreateWindowExA" int, str, str, int, int, int, int, int, int, int, int, int #func DestroyWindow "DestroyWindow" int #define global enum_assoc(%1, %2, %3, %4) eal@mod_assoc = %2 : _enum_assoc %1, eal@mod_assoc, %3, %4 #define global set_assoc(%1, %2, %3) _set_assoc %1, %2, str(%3) #deffunc _init_assoc heap = GetProcessHeap() id_cnt = -1 id_list_hwnd = CreateWindowEx(0, "static", "", 0, 0, 0, 0, 0, 0, 0, 0, 0) return #defcfunc new_assoc id_cnt++ assoc_hwnd = CreateWindowEx(0, "static", "", 0, 0, 0, 0, 0, 0, 0, 0, 0) SetProp id_list_hwnd, str(id_cnt), assoc_hwnd return id_cnt #deffunc del_assoc int id dim clbkptr, 1 newclbk3 clbkptr, 3, *free_props EnumProps GetProp(id_list_hwnd, str(id)), clbkptr DestroyWindow GetProp(id_list_hwnd, str(id)) return #defcfunc has_assoc int id, str key if GetProp(GetProp(id_list_hwnd, str(id)), key) = 0 : return 0 return 1 #defcfunc get_assoc int id, str key addr = GetProp(GetProp(id_list_hwnd, str(id)), key) if addr = 0 : return "" size = HeapSize(heap, 0, addr) sdim value, size - 1 RtlMoveMemory varptr(value), addr, size return value #deffunc _set_assoc int id, str key, str value_ value = value_ assoc_hwnd = GetProp(id_list_hwnd, str(id)) addr = GetProp(assoc_hwnd, key) if addr = 0 { size = strlen(value) + 1 addr = HeapAlloc(heap, 0, size) } else { size = HeapSize(heap, 0, addr) value_size = strlen(value) + 1 if value_size > size { HeapFree heap, 0, addr size = value_size addr = HeapAlloc(heap, 0, size << 1) } } RtlMoveMemory addr, varptr(value), size SetProp assoc_hwnd, key, addr return #deffunc remove_assoc int id, str key assoc_hwnd = GetProp(id_list_hwnd, str(id)) addr = GetProp(assoc_hwnd, key) HeapFree heap, 0, addr RemoveProp assoc_hwnd, key return #deffunc _enum_assoc int id, var callback_, var ea_key, var ea_val callback = callback_ dim clbkptr, 1 newclbk3 clbkptr, 3, *prop_enum_proc EnumProps GetProp(id_list_hwnd, str(id)), clbkptr return *free_props HeapFree heap, 0, args(2) return 1 *prop_enum_proc clbkargprotect args key_addr = args(1) key_size = lstrlen(key_addr) + 1 if key_size = 1 : return 1 sdim ea_key, key_size - 1 RtlMoveMemory varptr(ea_key), key_addr, key_size value_addr = args(2) value_size = lstrlen(value_addr) + 1 sdim ea_val, value_size - 1 RtlMoveMemory varptr(ea_val), value_addr, value_size gosub callback return 1 #global _init_assoc #if 1 /* example */ opt = new_assoc() set_assoc opt, "window_cx", "640" set_assoc opt, "window_cy", "480" set_assoc opt, "show_on_taskbar", "on" set_assoc opt, "auto_startup", "off" set_assoc opt, "キーには日本語も使える", "列挙の順序は不明" set_assoc opt, "数値などは文字列に変換される", 3.14 mes "-- has_assoc test --------" mes "has_auto_startup:" + has_assoc(opt, "auto_startup") mes "has_auto_shutdown:" + has_assoc(opt, "auto_shutdown") mes "\n-- get_assoc test --------" mes "window_cx:" + get_assoc(opt, "window_cx") mes "window_cy:" + get_assoc(opt, "window_cy") remove_assoc opt, "window_cx" remove_assoc opt, "show_on_taskbar" mes "\n-- enum_assoc test --------" enum_assoc opt, *enum_proc, ea_key, ea_val del_assoc opt stop *enum_proc mes "key: " + ea_key + " value: " + ea_val return #endif



この記事に返信する


甜菜飛鳥

リンク

2015/2/12(Thu) 21:52:39|NO.67383

せっかくなので、なんの役に立つのか不明ですが、やっつけで書いたベンチマークのソースも貼っておきます。

#if 1 /* benchmark */ #runtime "hsp3cl" #uselib "winmm.dll" #cfunc timeGetTime "timeGetTime" #func timeBeginPeriod "timeBeginPeriod" int #func timeEndPeriod "timeEndPeriod" int id = new_assoc() trial = 100000 mes "試行回数: " + trial sdim _0byte sdim _8byte : repeat 8 : _8byte += "a" : loop sdim _16byte : repeat 16 : _16byte += "a" : loop sdim _32byte : repeat 32 : _32byte += "a" : loop sdim _64byte : repeat 64 : _64byte += "a" : loop timeBeginPeriod 1 mes "\n-- benchmark for key length --------" gosub *assoc_assign_key8byte gosub *assoc_assign_key16byte gosub *assoc_assign_key32byte gosub *assoc_assign_key64byte mes "\n-- benchmark for value length --------" gosub *normal_assign_value8byte gosub *assoc_assign_value8byte gosub *normal_assign_value16byte gosub *assoc_assign_value16byte gosub *normal_assign_value32byte gosub *assoc_assign_value32byte gosub *normal_assign_value64byte gosub *assoc_assign_value64byte timeEndPeriod 1 mes "\n-- report on the benchmark --------" mes "・基本的な速度差は40倍程度" mes "・値のサイズが大きくなるほど速度差は縮まっていく" mes "・実用範囲でのキーの長さは速度にほぼ影響しない" mes "(ちなみにゲッターはヒープメモリを弄らないせいかセッターより数割速くなる)" stop *assoc_assign_key8byte prev = result time = timeGetTime() repeat trial : set_assoc id, _8byte, _0byte : loop result = timeGetTime() - time mes "連想配列代入(キーが8byte): " + result + "ms" return *assoc_assign_key16byte prev = result time = timeGetTime() repeat trial : set_assoc id, _16byte, _0byte : loop result = timeGetTime() - time mes "連想配列代入(キーが16byte): " + result + "ms" + "\t直前との比: " + (double(result) / double(prev)) return *assoc_assign_key32byte prev = result time = timeGetTime() repeat trial : set_assoc id, _32byte, _0byte : loop result = timeGetTime() - time mes "連想配列代入(キーが32byte): " + result + "ms" + "\t直前との比: " + (double(result) / double(prev)) return *assoc_assign_key64byte prev = result time = timeGetTime() repeat trial : set_assoc id, _64byte, _0byte : loop result = timeGetTime() - time mes "連想配列代入(キーが64byte): " + result + "ms" + "\t直前との比: " + (double(result) / double(prev)) return *normal_assign_value8byte prev = result time = timeGetTime() repeat trial : a = _8byte : loop result = timeGetTime() - time mes "通常変数代入(値が8byte): " + result + "ms" return *assoc_assign_value8byte prev = result time = timeGetTime() repeat trial : set_assoc id, "a", _8byte : loop result = timeGetTime() - time mes "連想配列代入(値が8byte): " + result + "ms" + "\t直前との比: " + (double(result) / double(prev)) return *normal_assign_value16byte prev = result time = timeGetTime() repeat trial : a = _16byte : loop result = timeGetTime() - time mes "通常変数代入(値が16byte): " + result + "ms" return *assoc_assign_value16byte prev = result time = timeGetTime() repeat trial : set_assoc id, "a", _16byte : loop result = timeGetTime() - time mes "連想配列代入(値が16byte): " + result + "ms" + "\t直前との比: " + (double(result) / double(prev)) return *normal_assign_value32byte prev = result time = timeGetTime() repeat trial : a = _32byte : loop result = timeGetTime() - time mes "通常変数代入(値が32byte): " + result + "ms" return *assoc_assign_value32byte prev = result time = timeGetTime() repeat trial : set_assoc id, "a", _32byte : loop result = timeGetTime() - time mes "連想配列代入(値が32byte): " + result + "ms" + "\t直前との比: " + (double(result) / double(prev)) return *normal_assign_value64byte prev = result time = timeGetTime() repeat trial : a = _64byte : loop result = timeGetTime() - time mes "通常変数代入(値が64byte): " + result + "ms" return *assoc_assign_value64byte prev = result time = timeGetTime() repeat trial : set_assoc id, "a", _64byte : loop result = timeGetTime() - time mes "連想配列代入(値が64byte): " + result + "ms" + "\t直前との比: " + (double(result) / double(prev)) return #endif



tds12

リンク

2015/2/13(Fri) 21:49:50|NO.67399

>この場を借りてお礼申し上げます。
どういたしまして。
私のmodclbkを使ったモジュールがついに現れて、感激です。
しかも、必要とされていた便利な連想配列とは、驚きです。

ところで、このモジュールは自由に使って良いのでしょうか。



甜菜飛鳥

リンク

2015/2/13(Fri) 23:18:36|NO.67401

あ、tds12さん。レスポンスありがとうございます。
あなたの功績はもっと評価されてもいいと思います(笑)

ともあれ、本初アイデアを見つけたあとにかりかりソースを書きながら、
途中になってプロパティの列挙にコールバック関数が必要だということに気付いて、
「ああこりゃだめかな」と思った矢先にこれぞ!というモジュールを発見したので助かりました。

> ところで、このモジュールは自由に使って良いのでしょうか。
ええ、もちろんご自由に使用していただいて構いませんよ。
まあほぼラッパーですし、ヒープ管理のメモリアロケータまで手掛ける気力はなかったので、
この程度のスクリプトでしたらパブリックドメインでお好きにどうぞ。



甜菜飛鳥

リンク

2015/3/1(Sun) 09:21:32|NO.67589

バグフィックスです。del_assocにてシステムエラーが起きることがありました。
*free_propsラベルの直後に以下の二行を挿入すれば修正されます。

clbkargprotect args if lstrlen(args(1)) = 0 : return 1

なお、数値型の値にも対応したので全文更新しておきます。
APIの仕様上、has_issocは使えませんが、こちらは文字列型の二倍速いです。

#include "modclbk3a1.as" #ifndef __MOD_ASSOC__ #define __MOD_ASSOC__ #module mod_assoc #uselib "kernel32.dll" #cfunc lstrlen "lstrlenA" int #func lstrcpy "lstrcpyA" int, int #func RtlMoveMemory "RtlMoveMemory" int, int, int #cfunc GetProcessHeap "GetProcessHeap" #cfunc HeapAlloc "HeapAlloc" int, int, int #func HeapFree "HeapFree" int, int, int #cfunc HeapSize "HeapSize" int, int, int #uselib "user32.dll" #cfunc GetWindowLong "GetWindowLongA" int, int #func SetWindowLong "SetWindowLongA" int, int, int #cfunc GetProp "GetPropA" int, str #func SetProp "SetPropA" int, str, int #func RemoveProp "RemovePropA" int, str #func EnumProps "EnumPropsA" int, int #cfunc CreateWindowEx "CreateWindowExA" int, str, str, int, int, int, int, int, int, int, int, int #func DestroyWindow "DestroyWindow" int #define global ctype has_assoc(%1, %2) _has_assoc(%1, str(%2)) #define global ctype get_assoc(%1, %2) _get_assoc(%1, str(%2)) #define global set_assoc(%1, %2, %3) _set_assoc %1, str(%2), str(%3) #define global remove_assoc(%1, %2) _remove_assoc %1, str(%2) #define global enum_assoc(%1, %2, %3, %4) eal@mod_assoc = %2 : _enum_assoc %1, eal@mod_assoc, %3, %4 #define global ctype get_issoc(%1, %2) _get_issoc(%1, str(%2)) #define global set_issoc(%1, %2, %3) _set_issoc %1, str(%2), int(%3) #define global remove_issoc(%1, %2) _remove_issoc %1, str(%2) #define global enum_issoc(%1, %2, %3, %4) eal@mod_assoc = %2 : _enum_issoc %1, eal@mod_assoc, %3, %4 #deffunc _init_mod_assoc assoc_newid = -1 issoc_newid = -1 assoc_idlist_hwnd = CreateWindowEx(0, "static", "", 0, 0, 0, 0, 0, 0, 0, 0, 0) issoc_idlist_hwnd = CreateWindowEx(0, "static", "", 0, 0, 0, 0, 0, 0, 0, 0, 0) assoc_heap = GetProcessHeap() return #defcfunc new_assoc assoc_newid++ assoc_hwnd = CreateWindowEx(0, "static", "", 0, 0, 0, 0, 0, 0, 0, 0, 0) SetProp assoc_idlist_hwnd, str(assoc_newid), assoc_hwnd return assoc_newid #deffunc del_assoc int id dim clbkptr, 1 newclbk3 clbkptr, 3, *free_props assoc_hwnd = GetProp(assoc_idlist_hwnd, str(id)) EnumProps assoc_hwnd, clbkptr DestroyWindow assoc_hwnd return stat *free_props clbkargprotect args if lstrlen(args(1)) = 0 : return 1 HeapFree assoc_heap, 0, args(2) return 1 #defcfunc _has_assoc int id, str key if GetProp(GetProp(assoc_idlist_hwnd, str(id)), key) = 0 : return 0 return 1 #defcfunc _get_assoc int id, str key addr = GetProp(GetProp(assoc_idlist_hwnd, str(id)), key) if addr = 0 : return "" size = HeapSize(assoc_heap, 0, addr) sdim value, size - 1 RtlMoveMemory varptr(value), addr, size return value #deffunc _set_assoc int id, str key, str value_ value = value_ assoc_hwnd = GetProp(assoc_idlist_hwnd, str(id)) addr = GetProp(assoc_hwnd, key) if addr = 0 { size = strlen(value) + 1 addr = HeapAlloc(assoc_heap, 0, size) } else { size = HeapSize(assoc_heap, 0, addr) value_size = strlen(value) + 1 if value_size > size { HeapFree assoc_heap, 0, addr size = value_size addr = HeapAlloc(assoc_heap, 0, size << 1) } } RtlMoveMemory addr, varptr(value), size SetProp assoc_hwnd, key, addr return (addr ! 0) & (stat ! 0) #deffunc _remove_assoc int id, str key assoc_hwnd = GetProp(assoc_idlist_hwnd, str(id)) addr = GetProp(assoc_hwnd, key) HeapFree assoc_heap, 0, addr RemoveProp assoc_hwnd, key return stat #deffunc _enum_assoc int id, var callback_, var ea_key, var ea_val callback = callback_ dim clbkptr, 1 newclbk3 clbkptr, 3, *assoc_enum_prop EnumProps GetProp(assoc_idlist_hwnd, str(id)), clbkptr return (stat ! -1) *assoc_enum_prop clbkargprotect args key_addr = args(1) key_size = lstrlen(key_addr) + 1 if key_size = 1 : return 1 sdim ea_key, key_size - 1 RtlMoveMemory varptr(ea_key), key_addr, key_size value_addr = args(2) value_size = lstrlen(value_addr) + 1 sdim ea_val, value_size - 1 RtlMoveMemory varptr(ea_val), value_addr, value_size gosub callback return 1 ; 数値型対応のissocを追加 #defcfunc new_issoc issoc_newid++ issoc_hwnd = CreateWindowEx(0, "static", "", 0, 0, 0, 0, 0, 0, 0, 0, 0) SetProp issoc_idlist_hwnd, str(issoc_newid), issoc_hwnd return issoc_newid #deffunc del_issoc int id DestroyWindow GetProp(issoc_idlist_hwnd, str(id)) return stat #defcfunc _get_issoc int id, str key return GetProp(GetProp(issoc_idlist_hwnd, str(id)), key) #deffunc _set_issoc int id, str key, int value_ SetProp GetProp(issoc_idlist_hwnd, str(id)), key, value_ return stat #deffunc _remove_issoc int id, str key RemoveProp GetProp(issoc_idlist_hwnd, str(id)), key return stat #deffunc _enum_issoc int id, var callback_, var ea_key, var ea_val callback = callback_ dim clbkptr, 1 newclbk3 clbkptr, 3, *issoc_enum_prop EnumProps GetProp(issoc_idlist_hwnd, str(id)), clbkptr return (stat ! -1) *issoc_enum_prop clbkargprotect args key_addr = args(1) key_size = lstrlen(key_addr) + 1 if key_size = 1 : return 1 sdim ea_key, key_size - 1 RtlMoveMemory varptr(ea_key), key_addr, key_size ea_val = args(2) gosub callback return 1 #global _init_mod_assoc #endif #if 1 /* example */ opt = new_assoc() set_assoc opt, "window_cx", "640" set_assoc opt, "window_cy", "480" set_assoc opt, "show_on_taskbar", "on" set_assoc opt, "auto_startup", "off" set_assoc opt, "キーには日本語も使える", "列挙の順序は不明" set_assoc opt, "数値などは文字列に変換される。", 3.14 mes "-- has_assoc test --------" mes "has_auto_startup:" + has_assoc(opt, "auto_startup") mes "has_auto_shutdown:" + has_assoc(opt, "auto_shutdown") mes "\n-- get_assoc test --------" mes "window_cx:" + get_assoc(opt, "window_cx") mes "window_cy:" + get_assoc(opt, "window_cy") remove_assoc opt, "window_cx" remove_assoc opt, "show_on_taskbar" mes "\n-- enum_assoc test --------" enum_assoc opt, *enum_proc, ea_key, ea_val del_assoc opt stop *enum_proc mes "key: " + ea_key + " value: " + ea_val return #endif #if 0 /* benchmark */ #runtime "hsp3cl" #uselib "winmm.dll" #cfunc timeGetTime "timeGetTime" #func timeBeginPeriod "timeBeginPeriod" int #func timeEndPeriod "timeEndPeriod" int a_id = new_assoc() i_id = new_issoc() trial = 100000 mes "試行回数: " + trial sdim _0byte sdim _8byte : repeat 8 : _8byte += "a" : loop sdim _16byte : repeat 16 : _16byte += "a" : loop sdim _32byte : repeat 32 : _32byte += "a" : loop sdim _64byte : repeat 64 : _64byte += "a" : loop timeBeginPeriod 1 mes "\n-- benchmark for key length --------" gosub *assoc_assign_key8byte gosub *assoc_assign_key16byte gosub *assoc_assign_key32byte gosub *assoc_assign_key64byte mes "\n-- benchmark for value length --------" gosub *normal_assign_value8byte gosub *assoc_assign_value8byte gosub *normal_assign_value16byte gosub *assoc_assign_value16byte gosub *normal_assign_value32byte gosub *assoc_assign_value32byte gosub *normal_assign_value64byte gosub *assoc_assign_value64byte ; 数値型対応につき追加 gosub *normal_assign_intvalue gosub *issoc_assign timeEndPeriod 1 mes "\n-- report on the benchmark --------" mes "・基本的な速度差は40倍程度" mes "・値のサイズが大きくなるほど速度差は縮まっていく" mes "・実用範囲でのキーの長さは速度にほぼ影響しない" mes "・issoc系はassoc系の2倍速い" mes "(ちなみにゲッターはヒープメモリを弄らないせいかセッターより数割速くなる)" stop *assoc_assign_key8byte prev = result time = timeGetTime() repeat trial : set_assoc a_id, _8byte, _0byte : loop result = timeGetTime() - time mes "set_assoc(キーが8byte): " + result + "ms" return *assoc_assign_key16byte prev = result time = timeGetTime() repeat trial : set_assoc a_id, _16byte, _0byte : loop result = timeGetTime() - time mes "set_assoc(キーが16byte): " + result + "ms" + "\t直前との比: " + (double(result) / double(prev)) return *assoc_assign_key32byte prev = result time = timeGetTime() repeat trial : set_assoc a_id, _32byte, _0byte : loop result = timeGetTime() - time mes "set_assoc(キーが32byte): " + result + "ms" + "\t直前との比: " + (double(result) / double(prev)) return *assoc_assign_key64byte prev = result time = timeGetTime() repeat trial : set_assoc a_id, _64byte, _0byte : loop result = timeGetTime() - time mes "set_assoc(キーが64byte): " + result + "ms" + "\t直前との比: " + (double(result) / double(prev)) return *normal_assign_value8byte prev = result time = timeGetTime() repeat trial : a = _8byte : loop result = timeGetTime() - time mes "通常変数代入(値が8byte): " + result + "ms" return *assoc_assign_value8byte prev = result time = timeGetTime() repeat trial : set_assoc a_id, "a", _8byte : loop result = timeGetTime() - time mes "set_assoc(値が8byte): " + result + "ms" + "\t直前との比: " + (double(result) / double(prev)) return *normal_assign_value16byte prev = result time = timeGetTime() repeat trial : a = _16byte : loop result = timeGetTime() - time mes "通常変数代入(値が16byte): " + result + "ms" return *assoc_assign_value16byte prev = result time = timeGetTime() repeat trial : set_assoc a_id, "a", _16byte : loop result = timeGetTime() - time mes "set_assoc(値が16byte): " + result + "ms" + "\t直前との比: " + (double(result) / double(prev)) return *normal_assign_value32byte prev = result time = timeGetTime() repeat trial : a = _32byte : loop result = timeGetTime() - time mes "通常変数代入(値が32byte): " + result + "ms" return *assoc_assign_value32byte prev = result time = timeGetTime() repeat trial : set_assoc a_id, "a", _32byte : loop result = timeGetTime() - time mes "set_assoc(値が32byte): " + result + "ms" + "\t直前との比: " + (double(result) / double(prev)) return *normal_assign_value64byte prev = result time = timeGetTime() repeat trial : a = _64byte : loop result = timeGetTime() - time mes "通常変数代入(値が64byte): " + result + "ms" return *assoc_assign_value64byte prev = result time = timeGetTime() repeat trial : set_assoc a_id, "a", _64byte : loop result = timeGetTime() - time mes "set_assoc(値が64byte): " + result + "ms" + "\t直前との比: " + (double(result) / double(prev)) return *normal_assign_intvalue prev = result time = timeGetTime() repeat trial : a = 0 : loop result = timeGetTime() - time mes "通常変数代入(値が数値型): " + result + "ms" return *issoc_assign prev = result time = timeGetTime() repeat trial : set_issoc i_id, "a", 0 : loop result = timeGetTime() - time mes "set_issoc(値が数値型): " + result + "ms" + "\t直前との比: " + (double(result) / double(prev)) return #endif



ONION software Copyright 1997-2021(c) All rights reserved.