任意の型の引数を任意の数だけ取る関数(可変長引数を取る関数)の実装

タイトル通りです。
ちなみにマクロは使用していません。

タイトル通りです。
ちなみにマクロは使用していません。

//-----------------------------------------------------------------------------------------
// 可変長引数(笑)                                                                       |
//                                                                       2015/07/04  Flat |
//-----------------------------------------------------------------------------------------

/*
■特徴
    コードセグメントを直に読みます
    ですので無限に引数を付けられます
    更にあらゆる型の引数を受け付けます
    言い換えれば型の自動変換がありません
    
    尤も、あらゆる型を受け付けられてもその型の処理ができなければ意味がありませんがね!

■使用できる型
    現在対応している型は
      ・空引数
      ・ユーザー定義命令・関数
      ・変数、配列(※)
      ・その他HSPの変数に格納できる全ての型
    となります
    vfunc関数を編集すれば他の型にも対応可能です
    
    ※配列は正常に動作しないことがあります(文字列型など)
      おそらくHSPのバグまたは仕様なので、ランタイムの方を編集してください

■注意
    ・vfuncから呼び出された関数の中でvfuncを呼び出すとreturn時に死にます
      これはvfuncから他の関数を呼び出す際に定義情報を無理矢理書き換えている関係です
      根本的な解決策は現在見つかっていません…
    
    ・関数内からvfuncを呼び出す際、引数に関数の引数(ローカル変数含む)は使えません
      これは引数の評価処理がvfunc内部で行われているためで、根本的な解決策は(略)

■その他
    vfuncは命令形式の呼び出しですが、少し書き換えるだけで関数形式の呼び出しにできます
    つまり、今まで夢だった関数へのラベル渡しもできます

■使い方
    使い方はサンプルを見たほうが早いので、ここでは割愛します
*/


// 引数格納庫
// タイプが-1のときは引数の変数をクローンする
#module ParameterStore m_type, m_var
#modinit int p_type, array p_var
	m_type = p_type
	if m_type == -1 {
		dup m_var, p_var
	} else {
		m_var = p_var
	}
	return

#modcfunc gettype
	return m_type

#modcfunc getparam
	return m_var

#modfunc  dupparam var p_var
	dup p_var, m_var
	return
#global


// 可変長引数モジュール
#module Variadic
// PVal取得関数
// http://d.hatena.ne.jp/chaperatta/20081012/1223803468
#defcfunc local getpval var
#deffunc local _getpval int p_pval
	return p_pval

// コールバック用ダミー関数
#deffunc local callback
	return


// 可変長引数で任意の関数を呼び出す関数
// vfunc 呼び出す関数, 引数1, 引数2, 引数3, …
#deffunc vfunc \
local param, local param_index, local param_num, \
local hspctx, local hsphed, local mcs, local cs, local callback_st, \
local pcs, local old_pcs, local code_num, \
local info, local is48, local ex0, local ex1, local ex2, local type, local code, \
local params, local size, local label, local vtype, local bytecode, local func_st, \
local flag, local t_offset, local t_type, local t_code, \
local func
	
	// ローカル変数paramのインデックスを取得
	// 次がparamの参照となるようなラベルを作成
	newlab label, 0
	param = 0
	// その場所のコードを取得
	dupptr cs, lpeek(label, 0), 6, 2
	// インデックス(=Code)を取得
	if wpeek(cs, 0) & 0x8000 {
		param_index = lpeek(cs, 2)
	} else {
		param_index = wpeek(cs, 2)
	}
	
	// CSを取得
	// HSPCTX取得
	mref hspctx, 68
	// HSPHED取得
	dupptr hsphed, hspctx(0), 96, 4
	// 関数呼び出し元のCSポインタ取得
	dupptr mcs, hspctx(207) - 16, 4
	// CSポインタからCSを取得
	dupptr cs, mcs, hsphed(5) - (hspctx(2) - mcs)
	
	// CSをなめる
	// http://codetter.com/?p=1165 からパクった
	pcs       = 0
	old_pcs   = 0
	param_num = 0
	code_num  = 0
	repeat
		// ExやType等取得
		info = wpeek(cs, pcs)
		is48 = info & 0x8000
		ex2  = info & 0x4000
		ex1  = info & 0x2000
		ex0  = info & 0x1000
		type = info & 0x0FFF
		
		// 引数の区切り
		if ex1 | ex2 {
			// 引数のコードサイズ
			size = pcs - old_pcs
			
			// 例外処理
			vtype = 0
			switch wpeek(cs, old_pcs) & 0x0FFF
				// 空引数
				case 0
					if wpeek(cs, old_pcs) & 0x8000 {
						t_code = lpeek(cs, old_pcs + 2)
					} else {
						t_code = wpeek(cs, old_pcs + 2)
					}
					if t_code != 0x3F : swbreak
					
					// とりあえず0にでもしておく
					param = 0
					// vtypeセット
					vtype = -3
					swbreak
				
				// 変数及び配列の要素
				case 1/*TYPE_VAR*/
					flag = 0
					if code_num == 1 {
						// 変数
						flag = 1
					} else : if code_num >= 4 {
						// 配列の要素?
						// TYPE_VARの直後が'('で末尾が')'なら配列の要素とみなす
						// a(3) * a(2) などはコンパイル後 a(3) a(2) * となるので問題はなさそう
						flag = 1
						t_offset = old_pcs
						repeat code_num
							t_type = wpeek(cs, t_offset) & 0x0FFF
							
							if wpeek(cs, t_offset) & 0x8000 {
								t_code = lpeek(cs, t_offset + 2)
								t_offset += 6
							} else {
								t_code = wpeek(cs, t_offset + 2)
								t_offset += 4
							}
							
							if type == 11/*TYPE_CMPCMD*/ {
								t_offset += 2
							}
							
							switch cnt
								// 先頭のチェック
								case 1
									if t_type ==  0x000 : swbreak
									if t_code == 0x0028 : swbreak
									
									flag = 0
									break
								
								// 末尾のチェック
								case code_num - 1
									if t_type ==  0x000 : swbreak
									if t_code == 0x0029 : swbreak
									
									flag = 0
									break
							swend
						loop
					}
					if flag {
						// バイトコードの生成
						sdim bytecode, size + 18
						wpoke bytecode, 0, 0x200F					// dup
						wpoke bytecode, 2, 0x000E
						wpoke bytecode, 4, 0x8005					// param
						lpoke bytecode, 6, param_index
						memcpy bytecode, cs, size, 10, old_pcs		// 変数、配列の要素
						wpoke bytecode, size + 10, 0x200F			// return
						wpoke bytecode, size + 12, 0x0002
						wpoke bytecode, size + 14, 0x200F			// return(なんでもいいので何かひとつ必要)
						wpoke bytecode, size + 16, 0x0002
						
						// 先頭のEx2フラグを立てる
						wpoke bytecode, 10, wpeek(bytecode, 10) | 0x4000
						
						// バイトコード呼び出し
						newlab label, 0
						lpoke label, 0, varptr(bytecode)
						gosub label
						
						// vtypeセット
						vtype = -1
					}
					swbreak
				
				// ユーザー定義関数
				case 12/*TYPE_MODCMD*/
					if code_num != 1 : swbreak
					
					// バイトコードの生成
					sdim bytecode, size + 20
					wpoke bytecode,  0, 0x200F					// return
					wpoke bytecode,  2, 0x0002
					wpoke bytecode,  4, 0x0011					// libptr
					wpoke bytecode,  6, 0x0103
					wpoke bytecode,  8, 0x0000					// (
					wpoke bytecode, 10, 0x0028
					memcpy bytecode, cs, size, 12, old_pcs		// 関数
					wpoke bytecode, size + 12, 0x0000			// )
					wpoke bytecode, size + 14, 0x0029
					wpoke bytecode, size + 16, 0x200F			// return(なんでもいいので何かひとつ必要)
					wpoke bytecode, size + 18, 0x0002
					
					// 先頭のEx2フラグを下ろす
					wpoke bytecode, 12, wpeek(bytecode, 12) & 0xBFFF
					
					// バイトコード呼び出し
					newlab label, 0
					lpoke label, 0, varptr(bytecode)
					gosub label
					
					// param、vtypeセット
					param = stat
					vtype = -2
					swbreak
			swend
			
			if vtype == 0 {
				// バイトコードの生成
				sdim bytecode, size + 18
				wpoke bytecode, 0, 0xA005					// param
				lpoke bytecode, 2, param_index
				wpoke bytecode, 6, 0x0000					// =
				wpoke bytecode, 8, 0x0008
				memcpy bytecode, cs, size, 10, old_pcs		// 引数
				wpoke bytecode, size + 10, 0x200F			// return
				wpoke bytecode, size + 12, 0x0002
				wpoke bytecode, size + 14, 0x200F			// return(なんでもいいので何かひとつ必要)
				wpoke bytecode, size + 16, 0x0002
				
				// 先頭のEx2フラグを下ろす
				wpoke bytecode, 10, wpeek(bytecode, 10) & 0xBFFF
				
				// バイトコード呼び出し
				newlab label, 0
				lpoke label, 0, varptr(bytecode)
				gosub label
				
				// vtypeセット
				vtype = vartype(param)
			}
			
			// 処理
			if param_num < 1 {
				// vfuncが使用する引数
				switch param_num
					// 最初の引数(呼び出す関数)
					case 0
						if (vtype != -2) && (vartype(param) != 4) {
							// エラーを引き起こす
							_errorfunc@Variadic 123
						}
						func = param
						swbreak
				swend
			} else {
				// ユーザー定義関数に渡す引数
				newmod params, ParameterStore, vtype, param
			}
			
			// paramクリア
			dim param
			
			// 情報更新
			code_num = 0
			old_pcs  = pcs
			param_num++
		}
		
		// 引数終了
		if ex1 {
			break
		}
		
		// ポインタを進める
		pcs += 2
		
		// Code取得
		if is48 {
			code = lpeek(cs, pcs)
			pcs += 4
		} else {
			code = wpeek(cs, pcs)
			pcs += 2
		}
		
		// TYPE_CMPCMDのときはジャンプ先が記録されている
		// 一応書いておいたが、不要かもしれない
		if type == 11/*TYPE_CMPCMD*/ {
			pcs += 2
		}
		
		// デバッグ用
		;mes strf("%08X %d %d %d %d %4d %08X", pcs, is48!=0, ex0!=0, ex1!=0, ex2!=0, type, code)
		
		// コード数更新(あとで使用する)
		code_num++
	loop
	
	// 引数不足のチェック
	if param_num < 1 {
		// エラーを引き起こす
		_errorfunc@Variadic
		return
	}
	
	// callbackを弄る
	dupptr callback_st, libptr(callback@Variadic), 28, 2
	dupptr func_st, func, 28, 2
	memcpy callback_st, func_st, 28
	
	// callback呼び出し
	callback@Variadic params
	
	// 引数解放
	foreach params
		delmod params(cnt)
	loop
	
	// 戻り先を修正
	mcs += pcs
	return

#deffunc local _errorfunc str a
	return
#global



// 以下サンプル、#if 0を#if 1にして動作
#if 0
// テスト関数
#module
#deffunc testfunc array p_params, \
local type, local var
	mes strf("NUM OF PARAMS: %d", length(p_params))
	foreach p_params
		// 引数の種類を取得
		type = gettype(p_params(cnt))
		
		// 引数を変数にクローン
		dupparam p_params(cnt), var
		
		// 表示してみる
		switch type
			case -3
				mes strf("TYPE: EMPTY")
				swbreak
			
			case -2
				mes strf("TYPE: FUNCTION,  PTR TO STRUCTDAT: %08X", var)
				swbreak
			
			case -1
				if length(var) > 1 {
					mes strf("TYPE: ARRAY[%d],  DATA[0]:          %s", length(var), str(var(0)))
				} else {
					mes strf("TYPE: VARIABLE,  DATA:             %s", str(var))
				}
				swbreak
			
			case 1
				mes strf("TYPE: LABEL,     DESTINATION:      %08X", lpeek(var, 0))
				swbreak
			
			case 2
				mes strf("TYPE: STRING,    DATA:             %s", var)
				swbreak
			
			case 3
				mes strf("TYPE: DOUBLE,    DATA:             %g", var)
				swbreak
			
			case 4
				mes strf("TYPE: INTEGER,   DATA:             %d", var)
				swbreak
			
			default
				mes strf("TYPE: %d", var)
				swbreak
		swend
	loop
	return
#global


*label
	abc = "a", "b", "c"
	def = 1, 2, 3, 4
	
	vfunc testfunc, 2, "xyz", 3.14, *label, 4 * 5, "3" + 4, 4.6
	mes
	
	vfunc testfunc, abc, def, abc(1), def(2), testfunc
	mes
	
	vfunc testfunc, , , , 5
	mes
#endif