ab.com コミュニティ

コード: 全て選択

Sub main(a As Long,b As **Byte)
	Dim o As *Byte,p As Long,l=1 As Long,m[999] As Byte,i As Long
	o=b[1]
	while o[l]<>0
		Select Case o[l]
			Case Asc("+")
				m[p]=m[p]+1
			Case Asc("-")
				m[p]=m[p]-1
			Case Asc(",")
				m[p]=getchar()
			Case Asc(".")
				putchar(m[p])
			Case Asc(">")
				p=p+1
			Case Asc("<")
				p=p-1
			Case Asc("[")
				If m[p]=0 then
					i=1
					while i<>0
						l=l+1
						If o[l]=Asc("[") then
							i=i+1
						Elseif o[l]=Asc("]") then
							i=i-1
						End If
					Wend
				End If
			Case Asc("]")
				If m[p]<>0 then
					i=1
					while i<>0
						l=l-1
						If o[l]=Asc("[") then
							i=i-1
						Elseif o[l]=Asc("]") then
							i=i+1
						End If
					Wend
					l=l-1
				End If
		End Select
		l=l+1
	Wend
End Sub

コード: 全て選択

brainfuck.exe "+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.------------.<++++++++.--------.+++.------.--------.>+."

コード: 全て選択

'必ずインクルード元で
'Sub main(argc As Long,argv As **Byte)
'を定義する事。

#console

Declare Function PathGetArgsA Lib "shlwapi" (psz As *Byte) As *Byte
Declare Function atoi Lib "msvcrt" cdecl (buf As *Byte) As Long

_main()
Sub _main()
	Dim i As Long
	Dim argc As Long,argv As **Byte
	Dim CommandLine As *Byte

'コマンドラインの取得・整理
	CommandLine=GetCommandLine()
	argc=GetArgc(CommandLine)
	argv=calloc(argc*4)
	For i=0 To argc-1
		argv=GetArgv(CommandLine,i)
	Next

'呼び出し
	main(argc,argv)

'解放
	For i=0 To argc-1
		free(argv)
	Next
	free(argv)
End Sub

'引数の総数を取得
'第一引数にコマンドライン文字列をぶち込む
Function GetArgc(CommandLine As *Byte) As Long
	Dim i=0 As Long,bufptr As *Byte
	GetArgc=1'呼び出し名含めかならず1つ以上ある筈
	bufptr=PathGetArgsA(CommandLine)
	Do
		If bufptr=0 then
			If i then
				GetArgc++
				bufptr+=i
				i=0
			End If
			Exit Do
		ElseIf	bufptr=10 Or bufptr=32 Or bufptr=40 Or bufptr=44 Or bufptr=47 Or _
				bufptr=59 Or bufptr=60 Or bufptr[i]=61 Or bufptr[i]=62 Or bufptr[i]=124 then'区切り文字
			GetArgc++
			bufptr+=i+1
			i=0
		Else
			i++
		End If
	Loop
End Function

'呼び出し名を取得する
'第一引数にコマンドライン文字列をぶち込む
'戻り値は自分でfreeする必要がある
Function GetArgv0(CommandLine As *Byte) As *Byte
	Dim i As Long
	If CommandLine[0]=34 then
		i=1
		Do
			If CommandLine[i]>=128 then'SHIFT-JIS文字対策
				i++
			ElseIf CommandLine[i]=34 then
				i++
				Exit Do
			ElseIf CommandLine[i]=0 then
				Exit Do
			End If
			i++
		Loop
	Else
		Do
			If CommandLine[i]>=128 then'SHIFT-JIS文字対策
				i++
			ElseIf	CommandLine[i]=0 Or CommandLine[i]=10 Or CommandLine[i]=32 Or _
					CommandLine[i]=40 Or CommandLine[i]=44 Or CommandLine[i]=47 Or _
					CommandLine[i]=59 Or CommandLine[i]=60 Or CommandLine[i]=61 Or _
					CommandLine[i]=62 Or CommandLine[i]=124 then'区切り文字
				Exit Do
			End If
			i++
		Loop
	End If
	GetArgv0=calloc(i+1)
	memcpy(GetArgv0,CommandLine,i)
End Function

'引数を取得する。
'第一引数にコマンドライン文字列をぶち込む
'戻り値は自分でfreeする必要がある
Function GetArgv(CommandLine As *Byte,ArgvIndex As Long) As *Byte
	Dim i As Long,bufptr As *Byte
	If ArgvIndex=0 then'呼び出し名を取得する場合
		GetArgv=GetArgv0(CommandLine)
		Exit Function
	ElseIf ArgvIndex<0 then'インデックスがおかしい
		Exit Function
	End If

	bufptr=PathGetArgsA(CommandLine)
	i=0
	Do
		If bufptr[i]=0 then
			If i then
				ArgvIndex--
				If ArgvIndex=0 then
					GetArgv=calloc(i+1)
					memcpy(GetArgv,bufptr,i)
					Exit Do
				End If
				bufptr+=i
				i=0
			End If
			Exit Do
		ElseIf bufptr[0]=34 then
			i=1
			Do
				If bufptr[i]>=128 then'SHIFT-JIS文字対策
					i++
				ElseIf bufptr[i]=34 then
					i++
					Exit Do
				ElseIf bufptr[i]=0 then
					Exit Do
				End If
				i++
			Loop
		ElseIf	bufptr[i]=10 Or bufptr[i]=32 Or bufptr[i]=40 Or bufptr[i]=44 Or bufptr[i]=47 Or _
				bufptr[i]=59 Or bufptr[i]=60 Or bufptr[i]=61 Or bufptr[i]=62 Or bufptr[i]=124 then'区切り文字
				ArgvIndex--
				If ArgvIndex=0 then
					GetArgv=calloc(i+1)
					memcpy(GetArgv,bufptr,i)
					Exit Do
				End If
			bufptr+=i+1
			i=0
		Else
			i++
		End If
	Loop
End Function

Sub putchar(a As Byte)
	Dim dwAccessBytes As DWord
	WriteFile(_System_hConsoleOut,VarPtr(a),1,VarPtr(dwAccessBytes),ByVal 0)
End Sub

Function getchar() As Byte
	Dim dwAccessBytes As DWord
	ReadFile(_System_hConsoleIn,VarPtr(getchar),1,VarPtr(dwAccessBytes),ByVal 0)
End Function