Lazarusで十進BASICで使うDLLを作る

PascalやC,C++などを利用してDLLを自作することも可能。
その場合の要点は,公開する関数にstdcall(C++では,__stdcall)を指定すること。

FPC+Lazarusのインストール

Delphiと互換性を持つPascal開発環境FPC+Lazarusをダウンロードしてインストールする。
Lazarus Windows 32bit
Windows版十進BASICで使うDLLを作るのが目的であれば,OSが64ビット版Windowsの場合でも32ビットWindows版を選ぶ。

<Memo>
PascalとBASICの類似点:Pascalは,大文字と小文字を同一視する(文字列定数を除く)。
PascalとBASICが異なる点:Pascalでは改行は空白と同じ意味しか持たない。代わりに文と文の区切りとしてセミコロンが書かれる。

参照 Pascal言語の概要
Object Pascal Tutorial /ja(日本語訳)
ixam Pascal入門
Delphiのすすめ
Mr.Xray Delphi Library
Object Pascal入門『ソースは語る』

FPC PascalでDLLを作る

FPC Pascalでは,program 〜 end.の代わりに,library 〜 end. でDLLを作れる。

BASICから呼び出す関数(手続きも可)にはstdcallを指示し,それらの名前をexportsに書く。
BASICから使うときには,関数(手続き)の名前は,大文字と小文字の違いが識別される。
exportsに書いた名前と関数(手続き)の頭書きに書いた名前の文字の大小が違っていてもDLLの翻訳はできるので注意が必要。BASICから使うときの名前はexport文で書かれた名前。

関数の場合,結果の型は,実数型,文字列型以外で,内部表現が8ビット,16ビット,または,32ビットであるもの。ただし,8ビット,または,16ビットのときは,BASICの側で上位ビットを切り捨てる処理が必要。
引数は原則として値引数にする。引数にできるのは,実数型,文字列型以外で,内部表現が8ビット,16ビット,または32ビットであるもの。ただし,ポインタを引数にする代わりに変数引数にすることもできる。
文字列をPascalに渡すとき,Pascalの関数(手続き)ではPCharで受ける。
Pointerを扱う場合,BASICにはポインタ型がないので,数値変数を用いて値を保持する。
DLLの内部でのみ利用する関数・手続きには上述の制限はない。

 2数の和,差を求める関数

1.次の内容をメモ帳で作成し,「ファイル」メニューから「名前を付けて保存」を選び,下段の「ファイルの種類」を「すべてのファイル(*.*)」に変えて適宜のフォルダにSample.pasというファイル名で保存する。

library Sample;

function add(a,b:Longint): Longint; stdcall;
begin
   add:=a+b
end;

function sub(a,b:Longint): Longint; stdcall;
begin
   sub:=a-b
end;

exports add, sub;

end.

Note. Longintは,32ビット符号付き整数型.

2.Lazarusの「プロジェクト」メニューの「ファイルから新規プロジェクト」でSample.pasを指定し, 「新規にプロジェクトを作成」ダイアログで,「ライブラリ」を選び, 「実行」メニューの「コンパイル」を実行するとSample.dllができる。

3.BASICのプログラムでは,次のようにして利用する。
(プログラムをDLLがあるのと同じフォルダに保存してから実行してください。)

100 FUNCTION ADD(a,b)
110    ASSIGN "Sample.dll","add"
120 END FUNCTION
130 
140 FUNCTION SUB(a,b)
150    ASSIGN "Sample.dll","sub"
160 END FUNCTION
170  
180 PRINT ADD(5,-4),SUB(4,7)
190 END

補足
引数はプログラムに書かれた順に対応付けられる。仮引数名とは無関係。だから,双方のプログラムで仮引数名が異なっていてもよい。
Pascalの関数名とBASICのASSIGN文に書く関数名は,大文字と小文字の違いまで含めて一致させる。

ビット演算

Visual BASICのAND,OR,NOT,XOR,IMP,EQVに相当するビット演算。
AND, OR, NOTはPascalの予約語なので,Pascalプログラムでは,関数名をANDop,ORop,NOTopなどとする。
関数定義におけるresultはDelphi独自の拡張なので,FPCで使うために{$MODE Delphi}を書いて構文解釈をDelphiモードにする。

library bitOp;
{$MODE Delphi}
function ANDop(a,b:Longint):Longint;stdcall;
begin
   result:=a and b
end;

function ORop(a,b:Longint):Longint;stdcall;
begin
   result:=a or b
end;

function NOTop(a:Longint):Longint;stdcall;
begin
   result:=not a
end;

function XORop(a,b:Longint):Longint;stdcall;
begin
   result:=a xor b
end;

function IMPop(a,b:Longint):Longint;stdcall;
begin
    result:=not a or b 
end;
   
function EQVop(a,b:Longint):Longint;stdcall;
begin
    result:=not (a xor b)
end;

exports ANDop, ORop, NOTop, XORop, IMPop, EQVop;

end.

BASICでの使い方
NOTはFull BASICの予約語なので,関数名をBitInvにした。

DECLARE EXTERNAL FUNCTION AND,OR,XOR,IMP,EQV,BitInv
LET a=BVAL("1010",2)
LET b=BVAL("11",2)
PRINT AND(a,b),OR(a,b),XOR(a,b),IMP(a,b),EQV(a,b)
PRINT BitInv(a),BitInv(b)
END
EXTERNAL FUNCTION AND(a,b)
ASSIGN "BitOp.dll","ANDop"
END FUNCTION
EXTERNAL FUNCTION OR(a,b)
ASSIGN "BitOp.dll","ORop"
END FUNCTION
EXTERNAL FUNCTION XOR(a,b)
ASSIGN "BitOp.dll","XORop"
END FUNCTION
EXTERNAL FUNCTION IMP(a,b)
ASSIGN "BitOp.dll","IMPop"
END FUNCTION
EXTERNAL FUNCTION EQV(a,b)
ASSIGN "BitOp.dll","EQVop"
END FUNCTION
EXTERNAL FUNCTION BitInv(a)
ASSIGN "BitOp.dll","NOTop"
END FUNCTION

ビット配列

BASICでビット配列が使えるようにする。複数の配列を用いることもできる。
完成品のダウンロード BITARRAY.zip

DLLに独自のメモリ管理を追加し,メモリの解放を怠ったとしてもDLLを利用するプログラムの実行が終わればアドレス空間が解放されるようにしておく。
以下の内容をHEAPMEM.PASとして保存

unit HeapMem;

interface
uses Windows;
var
   HHeap:THandle;

implementation

initialization
  HHeap:=HeapCreate(0,0,0);

finalization
  HeapDestroy(HHeap);

end.
次に,次の内容をBitArray.pasとして保存してLazarusからコンパイルする。
Intel x86にビット列を扱う命令があるので,それを利用してビット列を操作する関数・手続きを定義している。
library BitArray;
{$MODE DELPHI}
uses
  Windows,
  HeapMem in 'HEAPMEM.PAS';

function MemSize(s:Longint):Longint;
begin
   result:=(s shr 5) shl 2;
   if (s and 31) <>0 then inc(result,4)
end;

const
  HEAP_ZERO_MEMORY = $00000008;
function GetArray(s:Longint):pointer;stdcall;
begin
   Result:=HeapAlloc(HHeap,HEAP_ZERO_MEMORY,MemSize(s));
end;

procedure FreeArray(p:pointer); stdcall;
begin
  HeapFree(HHeap,0,p)
end;

function Test(p:pointer; i:Longint):Longint;stdcall;
begin
  asm
   mov eax,i
   mov edx,p
   bt  [edx],eax
   mov eax,0
   rcl eax,1
   mov result,eax
  end;
end;

procedure SetBit(p:pointer; i:Longint);stdcall;
begin
  asm
   mov eax,i
   mov edx,p
   bts [edx],eax
  end;
end;

procedure ResetBit(p:pointer; i:Longint);stdcall;
begin
  asm
   mov eax,i
   mov edx,p
   btr [edx],eax
  end;
end;

exports GetArray,FreeArray,Test,SetBit,ResetBit ;

end.

BASICのプログラムでは次のように利用する。

REM エラトステネスの篩 
DECLARE EXTERNAL FUNCTION GetArray, Test
DECLARE EXTERNAL SUB FreeArray, setbit
LET Nmax=10000
LET p=GetArray(Nmax)
IF p<>0 THEN 
   FOR i=2 TO Nmax-1
      IF Test(p,i)=0 THEN
         PRINT i
         FOR  j=i^2 TO Nmax-1 STEP i
            CALL SetBit(p,j)
         NEXT j 
      END IF
   NEXT i
   CALL FreeArray(p)
END IF
END
 
EXTERNAL FUNCTION GetArray(s)
! (s+1)ビットのメモリを確保し,ゼロで埋める。
! 結果は,メモリのアドレス。0のときは失敗。
FUNCTION GetArray_sub(s)
   ASSIGN "BitArray.DLL","GetArray"
END FUNCTION
IF 0<=s AND s<2^32 THEN
   LET GetArray=getArray_sub(s)
ELSE 
   LET GetArray=0
END if
END FUNCTION
 
EXTERNAL SUB FreeArray(p)
! メモリを返却する。pはGetArrayで得た値
ASSIGN "BitArray.DLL","FreeArray"
END SUB 
 
EXTERNAL FUNCTION Test(p,i)
! i番目のビットを取得する。pはGetArrayで得た値
ASSIGN "BitArray.DLL", "Test"
END FUNCTION

EXTERNAL SUB SetBit(p,i)
! i番目のビットを1にする。pはGetArrayで得た値
ASSIGN "BitArray.DLL", "SetBit"
END SUB
 
EXTERNAL SUB ResetBit(p,i)
! i番目のビットを0にする。pはGetArrayで得た値
ASSIGN "BitArray.DLL", "ResetBit"
END SUB

Test,SetBit,ResetBitで指定できるiの値は,GetArrayに指定した数をsとして,0〜sである。
また,実際にGetArrayに指定できるsの値の上限は,Windows XPでの実験結果では,1983381248で,これは2^30を超えるが,2^31よりは小さい 。
<注意>Test,SetBit,resetBitは範囲外の数を指定したときの安全策を講じていない。

直接メモリー操作

次のDLLは,文字列変数を用いずに,メモリーを直接操作する関数・手続きを用意する。

library memory;

uses
  Windows,
  HeapMem in 'HEAPMEM.PAS';

function GetMem(s:Longint):pointer;stdcall;
begin
   Result:=HeapAlloc(HHeap,0,s);
end;

procedure FreeMem(p:pointer); stdcall;
begin
  HeapFree(HHeap,0,p)
end;

type
   PByte=^byte;
   PWord=^word;
   PLongint=^Longint;

function Peek(p:PByte):Longint;stdcall;
begin
   result:=p^
end;

function Peek2(p:PWord):Longint;stdcall;
begin
   result:=p^
end;

function Peek4(p:PLongint):Longint;stdcall;
begin
   result:=p^
end;

procedure Poke(p:PByte; i:byte);stdcall;
begin
  p^:=i
end;

procedure Poke2(p:PWord; i:word);stdcall;
begin
  p^:=i
end;

procedure Poke4(p:PLongint; i:Longint);stdcall;
begin
  p^:=i
end;

procedure MoveM(p,q:Pointer; n:Longint);stdcall;
begin
  move(p^,q^,n)
end;


exports GetMem,FreeMem,Peek,Peek2,Peek4,Poke,Poke2,Poke4,MoveM ;

end.

使い方はこちら

Lazarusで出力窓を作る

これを土台にして修正・拡張していけば,好みの出力ウィンドウが作れる。

(1) Lazarusの「ファイル」メニューから「新規フォーム」を選ぶ。
(2) フォームにメモ・コントロール(TMemo)を貼り付ける。
次の(3),(4)は飛ばして(5)に進んでもよい。
(3) オブジェクト・インスペクタを利用して,memo1のAlignプロパティをalClientに変更する。
(4) 同じく,memo1のlinesプロパティをクリックして,「文字列リストの設定」を開いて,入力されている文字列“memo1”を消す。
(5) 適当なフォルダにwindow1.pasという名前で保存する。
(6) メモ帳で次の内容を作成し,Sample1.pasという名前でwindow1.pasと同じフォルダに保存する。

library Sample1;

uses
  Forms, Interfaces,
  window1;

procedure Show; stdcall;
begin
   Form1.Show
end;

procedure Hide; stdcall;
begin
   Form1.Hide
end;

procedure TextOut(p:PChar);stdcall;
begin
   Form1.Memo1.Lines.Append(p)
end;

procedure Erase;stdcall;
begin
   Form1.Memo1.Lines.SetText('')
end;

procedure Run;stdcall;
begin
   Application.Run;
end;

exports Show,Hide,TextOut,Erase,Run;

initialization
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);

finalization
  Application.terminate;
end.

(7)Lazarusの「プロジェクト」メニューの「ファイルから新規プロジェクト」でSample1.pasを指定し,「新規にプロジェクトを作成」ダイアログで「アプリケーション」を選び,「実行」メニューで「コンパイル」を実行すると,Sample1.dllが生成される。

(8)BASICプログラムでは,次のようにして利用する。

100 SUB Show
110    ASSIGN "Sample1.dll", "Show"
120 END SUB
130 SUB Hide
140    ASSIGN "Sample1.dll", "Hide"
150 END SUB
160 SUB TextOut(s$)
170    ASSIGN "Sample1.dll", "TextOut"
180 END SUB
190 SUB Erase
200    ASSIGN "Sample1.dll", "Erase"
210 END SUB
220 SUB Run
230    ASSIGN "Sample1.dll", "Run"
240 END SUB
250 CALL Show
260 CALL TextOut("Hello")
270 WAIT DELAY 1
280 CALL ERASE
290 WAIT DELAY 1
300 FOR x=1 TO 10
310    CALL TextOut(STR$(SQR(x)))
320 NEXT x
330 WAIT DELAY 4   
340 ! CALL Run
350 END

340行の CALL Run を有効にすると,ユーザにwindow1を操作させることが可能になり,ウィンドウを閉じるまでBASICプログラムは進行を停止する。



戻る inserted by FC2 system