はじめに
前回、Delphi で Pascal-P5 v1.3 のソースコードをコンパイルできるように改変する記事を書きました。
今回は Pascal-P5 v1.4 のソースコードにチャレンジしてみます。
何故、最初から v1.4 でやらなかったかというと、v1.4 は GNU Pascal (GPC) でしかコンパイルできないような改変がなされていたからです。v1.3 は Free Pascal (FPC) でもコンパイルできましたから、比較的容易にトラブルシューティングができたのです。
目論見通り v1.3 は Delphi へと移植できましたから、次は v1.4 との差分を修正すればいいわけです。
v1.3 と v1.4 で共通な詳細情報へのリンクは本記事では省いてあります。
改変
使うのは Pascal-P5 バージョン 1.4 のソースコードです。
アーカイブを解凍したら、source サブフォルダにある pcom.pas と pint.pas をそれぞれ pcom.dpr pint.dpr にリネームし、コンソールアプリケーションのプロジェクトファイルとして Delphi IDE に読み込めるようにしておきます。
Delphi は 11.0 Alexandria を使っていますが、無償の Community Edition でもコンパイルできると思います。新しい機能はほぼ使っていませんが、条件シンボルの関係で Delphi XE8 以降が必要です 1。
See also:
■ PCOM
そのまま Delphi でコンパイルすると 42 件のコンパイルエラーと 1 件の警告が出ます。
1. コンパイラ指令の削除
先頭のコンパイラ指令を削除します。
pcom.dpr
//(*$l-,p*)
{*******************************************************************************
* *
* PASCAL-P5 PORTABLE INTERPRETER *
* *
...
*******************************************************************************}
2. 条件コンパイル指令の変更 (1)
GNU Pascal (GPC) 用の条件コンパイル指令を Delphi 用に書き換えます。
pcom.dpr
{ Set default configuration flags. This gives proper behavior even if no
preprocessor flags are passed in.
The defaults are:
WRDSIZ32 - 32 bit compiler.
}
//#if !defined(WRDSIZ16) && !defined(WRDSIZ32) && !defined(WRDSIZ64)
//#define WRDSIZ32 1
//#endif
{$IFDEF CPU64BITS}
{$DEFINE WRDSIZ64}
{$ELSE}
{$DEFINE WRDSIZ32}
{$ENDIF}
16bit コンパイラ用の設定はありません。
3. コンソールアプリケーションの指定
{$APPTYPE Console} を追記して、コンソールアプリケーションであることを明示します。RTTI も使わない設定にします。
pcom.dpr
program pascalcompiler(output,prd,prr);
{$APPTYPE Console}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
4. goto 99 の削除
プログラム終端にラベル 99 が設定されています。標準 Pascal の goto は Extraprocedural gotos であり、広域ジャンプが可能ですが、Delphi の goto は Intraprocedural gotos であり、局所的なジャンプとなります。この非互換性は Abort() を使って代替します。
例外を使うので、uses に SysUtils を追加します。
pcom.dpr
...
program pascalcompiler(output,prd,prr);
{$APPTYPE Console}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
uses
System.SysUtils;
label 99; { terminate immediately }
ラベル 99を削除。
pcom.dpr
program pascalcompiler(output,prd,prr);
{$APPTYPE Console}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
uses
System.SysUtils;
//label 99; { terminate immediately }
メインブロックを try～except で括ります。ラベル 99 は削除します。
pcom.dpr
...
begin
try
{ Suppress unreferenced errors. These are all MPB (machine parameter
block) equations that need to stay the same between front end and backend. }
...
if wtpcnt <> 0 then
writeln('*** Error: Compiler internal error: with recycle balance: ',
wtpcnt:1);
// 99:
except
on E: EAbort do
;
end;
end.
goto 99 を Abort で置換します。
pcom.dpr
{ scrub all display levels until given }
procedure putdsps(l: disprange);
var t: disprange;
begin
if l > top then begin
writeln('*** Error: Compiler internal error');
// goto 99
Abort
end;
t := top;
while t > l do begin
putdsp(t); t := t-1
end
end;
変更対象が複数あります。
5. 条件コンパイル指令の変更 (2)
GPC 用の条件コンパイル指令を Delphi 用に書き換えます。
pcom.dpr
//#ifdef WRDSIZ16
//#include "mpb16.inc"
//#endif
//
//#ifdef WRDSIZ32
//#include "mpb32.inc"
//#endif
//
//#ifdef WRDSIZ64
//#include "mpb64.inc"
//#endif
{$IFDEF WRDSIZ32}
{$I 'mpb32.inc'}
{$ENDIF}
{$IFDEF WRDSIZ64}
{$I 'mpb64.inc'}
{$ENDIF}
16bit コンパイラ用の設定はありません。mpb16.inc は使いません。
6. 条件コンパイル指令の変更 (3)
GPC 用の条件コンパイル指令を Delphi 用に書き換えます。
pcom.dpr
var
{ !!! remove this statement for self compile }
//#ifndef SELF_COMPILE
{$IFNDEF SELF_COMPILE}
prd,prr: text; { output code file }
//#endif
{$ENDIF}
7. New() / Dispose() 関数の二番目の書式
New() / Dispose() 関数の二番目の書式を使っている箇所を変更します。二番目以降のパラメータを削除するだけです。
pcom.dpr
// reel: dispose(p, reel);
reel: dispose(p);
変更対象が複数あります。
8. 条件コンパイル指令の変更 (4)
GPC 用の条件コンパイル指令を Delphi 用に書き換えます。
pcom.dpr
//#ifdef NO_PREAMBLE
{$IFDEF NO_PREAMBLE}
begin write(output,' ':6,' ':2);
if dp then write(output,' ':7) else write(output,' ':7);
write(output,' ')
end;
//#else
{$ELSE}
begin write(output,linecount:6,' ':2);
if dp then write(output,lc:7) else write(output,ic:7);
write(output,' ')
end;
//#endif
{$ENDIF}
9. 条件コンパイル指令の変更 (5)
GPC 用の条件コンパイル指令を Delphi 用に書き換えます。
pcom.dpr
//#ifdef IMM_ERR
{$IFDEF IMM_ERR}
writeln; writeln('error: ', ferrnr:1);
//#endif
{$ENDIF}
10. 識別子 string の変更
string という名前の識別子が使われていますので、これを passtr に置換します。
pcom.dpr
procedure insymbol;
(*read next basic symbol of source program and return its
description in the global variables sy, op, id, val and lgth*)
var i,k, ks: integer;
digit: nmstr; { temp holding for digit string }
rvalb: nmstr; { temp holding for real string }
// string: csstr;
passtr: csstr;
lvp: csp; test, ferr: boolean;
ev: integer;
syv: boolean;
11. バッファ変数の置換
Delphi にはバッファ変数がありませんので、CurrentChar() 関数を用意します。insymbol() 手続きよりも前に追加してください。
pcom.dpr
function CurrentChar(var F: Text): WideChar;
begin
Eoln(F);
result := WideChar((TTextRec(F).BufPtr + TTextRec(F).BufPos)^);
end (*CurrentChar*) ;
バッファ変数を使っている箇所を CurrentChar() で置換します。
pcom.dpr
number:
begin op := noop; i := 0;
repeat i := i+1; if i<= digmax then digit[i] := ch; nextch
until chartp[ch] <> number;
{ separator must be non-alpha numeric or 'e' }
if (chartp[ch] = letter) and not (lcase(ch) = 'e') then error(241);
// if ((ch = '.') and (prd^ <> '.') and (prd^ <> ')')) or
if ((ch = '.') and (CurrentChar(prd) <> '.') and (prd^ <> ')')) or
(lcase(ch) = 'e') then
変更対象が複数あります。
12. Write() / Writeln() の書式
write() / writeln() に Pascal 文字列を渡している所があるので、Delphi の長い文字列に変換します。
pcom.dpr
// ident: write('ident: ', id:10);
ident: write('ident: ', string(id):10);
変更対象が複数あります。
13. 条件コンパイル指令の変更 (6)
GPC 用の条件コンパイル指令を Delphi 用に書き換えます。
pcom.dpr
{ !!! remove these statements for self compile }
//#ifndef SELF_COMPILE
{$IFNDEF SELF_COMPILE}
reset(prd); rewrite(prr); { open output file }
//#endif
{$ENDIF}
14. ファイルアサイン
ここまでの変更でコンパイルは通るようになったと思いますが、まだ正しく動作はしません。
'prd' を外部ファイル prd に、'prr' を外部ファイル prr に関連付けるよう、メインブロックの先頭に AssignFile() を追加します。
pcom.dpr
...
begin
AssignFile(prd, 'prd');
AssignFile(prr, 'prr');
try
{ Suppress unreferenced errors. These are all MPB (machine parameter
block) equations that need to stay the same between front end and backend. }
15. ファイルクローズ
ファイルを確実にフラッシュするために Flush() と CloseFile() を追加します。
pcom.dpr
//99:
except
on E: EAbort do
;
end;
CloseFile(prd);
Flush(prr);
CloseFile(prr);
end.
16. W1050 を消す
WideChar に対して in 演算子を使用している箇所を CharInSet() で置き換えます。
pcom.dpr
// if c in ['A'..'Z'] then c := chr(ord(c)-ord('A')+ord('a'));
if CharInSet(c, ['A'..'Z']) then c := chr(ord(c)-ord('A')+ord('a'));
変更対象が複数あります。
17. W1036 を消す
ローカル変数が初期化されていない箇所があるので初期化します。
pcom.dpr
lp := nil;
変更対象が複数あります。
18. H2077 を消す
使われていない代入があるのでコメントアウトします。
pcom.dpr
// lsize := parmsize; if id <> nil then lsize := id^.size;
変更対象が複数あります。
19. H2164 を消す
H2077 を潰すと、使われていない変数が発生するので、これもブロックコメントでコメントアウトします。
pcom.dpr
var lsp,lsp1,lsp2: stp; {varts: integer;}
20. W1022 を消す
バグか仕様か不明なので、ブロックコメントでコメントアウトしておきます。
pcom.dpr
{if varcnt >= 0 then} begin
これでヒントも警告もなくなりました。
21. 改行コードの問題を解決する
Windows 環境の場合、改行コードは CR+LF (0D 0A) ですが、Delphi の Eoln() は 0x0d の位置で True を返し、0x0a の位置では False を返します。このため、Windows 環境では行末を検知したらもう 1 バイト読み飛ばす必要があります。
nextch() 手続きを次のように書き換えます。
pcom.dpr
procedure nextch;
begin
{$IFDEF MSWINDOWS}
if CurrentChar(prd) = #$0A then
begin
Read(prd,ch);
Exit;
end;
{$ENDIF}
if eol then
begin if list then writeln(output); endofline
end;
if not eof(prd) then
begin eol := eoln(prd); read(prd,ch);
if list then write(output,ch);
chcnt := chcnt + 1
end
else
begin writeln(output,' *** eof ','encountered');
test := false
end
end;
22. ピリオドの判定を解決する
Pascal ソースコードの最後のピリオドの後に改行がない場合、ピリオドが連続したとみなされて部分範囲型の範囲文字列 .. と判定されてしまいます。
pcom.dpr
chperiod:
begin op := noop; nextch;
// if ch = '.' then begin sy := range; nextch end // 削除
if Eof(Prd) then sy := period // 追加
else if ch = '.' then begin sy := range; nextch end // 追加
else if ch = ')' then begin sy := rbrack; nextch end
else sy := period
end;
そして、プログラムの途中で EOF が来たような判定がされてしまうので、次のようなコードを追加します。
pcom.dpr
// else // 削除
else if (sy <> endsy) or (ch <> '.') then // 追加
begin
writeln(output,' *** eof ','encountered');
ch := ' '; // 追加
eol := true; // 追加
test := false
end;
23. mod 演算子の挙動
想定されている mod 演算子の挙動と異なるので、それを代替するための Mod2() 関数を追加します。
まず、uses に Math を追加します。
pcom.dpr
program pascalcompiler(output,prd,prr);
{$APPTYPE Console}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
uses
System.SysUtils, System.Math;
できるだけ前方に Mod2() 関数を記述します。
pcom.dpr
function Mod2(a, n: Integer): Integer;
begin
if n = 0 then
result := a
else
result := a - Floor(Extended(a / n)) * n;
end (*Mod2*) ;
mod 演算子を使っている箇所を Mod2() 関数で置き換えます。
pcom.dpr
// flc := l + k - (k+l) mod k
flc := l + k - Mod2(k+l, k)
変更対象が複数あります。
これで PCOM は正しく動作するようになりました。
■ PINT
そのまま Delphi でコンパイルすると 57 件のコンパイルエラーと 1 件の警告が出ます。
1. コンパイラ指令の削除
先頭のコンパイラ指令を削除します。
pint.dpr
//(*$l-,u-*)
{*******************************************************************************
* *
* Portable Pascal compiler *
* ************************ *
...
*******************************************************************************}
2. 条件コンパイル指令の変更 (1)
GNU Pascal (GPC) 用の条件コンパイル指令を Delphi 用に書き換えます。
pcom.dpr
{ Set default configuration flags. This gives proper behavior even if no
preprocessor flags are passed in.
The defaults are:
WRDSIZ32 - 32 bit compiler.
}
//#if !defined(WRDSIZ16) && !defined(WRDSIZ32) && !defined(WRDSIZ64)
//#define WRDSIZ32 1
//#endif
{$IFDEF CPU64BITS}
{$DEFINE WRDSIZ64}
{$ELSE}
{$DEFINE WRDSIZ32}
{$ENDIF}
3. コンソールアプリケーションの指定
{$APPTYPE Console} を追記して、コンソールアプリケーションであることを明示します。RTTI も使わない設定にします。
pint.dpr
program pcode(input,output,prd,prr);
{$APPTYPE Console}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
4. goto 1 の削除
プログラム終端付近にラベル 1 が設定されていますので、Abort() を使って代替します。
例外を使うので、uses に SysUtils を追加します。
pint.dpr
...
program pcode(input,output,prd,prr);
{$APPTYPE Console}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
uses
System.SysUtils;
label 1;
ラベル 1を削除。
pint.dpr
program pascalcompiler(output,prd,prr);
{$APPTYPE Console}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
//label 1;
メインブロックを try～except で括ります。ラベル 1 は削除します。
pint.dpr
...
begin (* main *)
try
{ Suppress unreferenced errors. }
...
// 1 : { abort run }
except
on E: EAbort do
;
end;
writeln;
writeln('program complete');
end.
goto 1 を Abort で置換します。
pint.dpr
procedure errori(string: beta);
begin writeln; write('*** Runtime error');
if srclin > 0 then write(' [', srclin:1, ']');
writeln(': ', string);
// pmd; goto 1
pmd; Abort
end;(*errori*)
pint.dpr
procedure errorl(string: beta); (*error in loading*)
begin writeln;
writeln('*** Program load error: [', iline:1, '] ', string);
// goto 1
Abort
end; (*errorl*)
5. 条件コンパイル指令の変更 (2)
GPC 用の条件コンパイル指令を Delphi 用に書き換えます。
pint.dpr
//#ifdef WRDSIZ16
//#include "mpb16.inc"
//#endif
//
//#ifdef WRDSIZ32
//#include "mpb32.inc"
//#endif
//
//#ifdef WRDSIZ64
//#include "mpb64.inc"
//#endif
{$IFDEF WRDSIZ32}
{$I 'mpb32.inc'}
{$ENDIF}
{$IFDEF WRDSIZ64}
{$I 'mpb64.inc'}
{$ENDIF}
6. 条件コンパイル指令の変更 (3)
GPC 用の条件コンパイル指令を Delphi 用に書き換えます。
pint.dpr
{ !!! Need to use the small size memory to self compile, otherwise, by
definition, pint cannot fit into its own memory. }
//#ifndef SELF_COMPILE
{$IFNDEF SELF_COMPILE}
maxstr = 16777215; { maximum size of addressing for program/var }
maxtop = 16777216; { maximum size of addressing for program/var+1 }
maxdef = 2097152; { maxstr / 8 for defined bits }
//#else
{$ELSE}
maxstr = 2000000; { maximum size of addressing for program/var }
maxtop = 2000001; { maximum size of addressing for program/var+1 }
maxdef = 250000; { maxstr /8 for defined bits }
//#endif
{$ENDIF}
7. 条件コンパイル指令の変更 (4)
GPC 用の条件コンパイル指令を Delphi 用に書き換えます。
pint.dpr
{ !!! remove this statement for self compile }
//#ifndef SELF_COMPILE
{$IFNDEF SELF_COMPILE}
prd,prr : text; (*prd for read only, prr for write only *)
//#endif
{$ENDIF}
8. 識別子 string の変更
string という名前の識別子が使われていますので、これを passtr に置換します。ついでに Writeln() のパラメータとして渡せるように string でキャストしておきます。
pint.dpr
//procedure errori(string: beta);
procedure errori(passtr: beta);
begin writeln; write('*** Runtime error');
if srclin > 0 then write(' [', srclin:1, ']');
// writeln(': ', string);
writeln(': ', string(passtr));
// pmd; goto 1
pmd; Abort;
end;(*errori*)
pint.dpr
// procedure errorl(string: beta); (*error in loading*)
procedure errorl(passtr: beta); (*error in loading*)
begin writeln;
// writeln('*** Program load error: [', iline:1, '] ', string);
writeln('*** Program load error: [', iline:1, '] ', string(passtr));
// goto 1
Abort;
end; (*errorl*)
9. Write() / Writeln() の書式
write() / writeln() に Pascal 文字列を渡している所があるので、Delphi の長い文字列に変換します。
pint.dpr
// write(' ', instr[op]:10, ' ');
write(' ', string(instr[op]):10, ' ');
変更対象が複数あります。
10. 条件コンパイル指令の変更 (5)
GPC 用の条件コンパイル指令を Delphi 用に書き換えます。
pint.dpr
{ !!! remove this next statement for self compile }
//#ifndef SELF_COMPILE
{$IFNDEF SELF_COMPILE}
reset(prd);
//#endif
{$ENDIF}
11. Pack の削除
Delphi には Pack() がないので削除します。ここでの処理は word -> name のコピーなので、Move() 手続きで代替します。
pint.dpr
// pack(word,1,name)
Move(word, name, SizeOf(name));
12. バッファ変数の置換
Delphi にはバッファ変数がありませんので、CurrentChar() 関数を用意します。load() 手続きよりも前に追加してください。
pint.dpr
function CurrentChar(var F: Text): WideChar;
begin
result := WideChar((TTextRec(F).BufPtr + TTextRec(F).BufPos)^);
end (*CurrentChar*) ;
バッファ変数を使っている箇所を CurrentChar() で置換します。
pint.dpr
// c := ch; if (ch = '''') and (prd^ = '''') then begin
c := ch; if (ch = '''') and (CurrentChar(prd) = '''') then begin
変更対象が複数あります。
13. Get() の追加
Delphi には Get() がありませんので、同等の関数を追加します。
pint.dpr
{$HINTS OFF}
procedure Get(var F: Text);
var
ch: Char;
begin
Read(F, ch);
end (*Get*) ;
{$HINTS ON}
14. Page() の追加
Delphi には Page() 手続きがありませんので、同等の関数を追加します。
pint.dpr
procedure Page(var F: Text);
begin
Write(F, #$0C);
end (*Page*) ;
15. Put() の代替
Delphi には Put() 手続きがありませんので、同等のロジックを追加します。
pint.dpr
procedure putfile(var f: text; var ad: address; fn: fileno);
begin if not filbuff[fn] then errori('File buffer undefined ');
// f^:= getchr(ad+fileidsize); put(f);
Write(f, getchr(ad+fileidsize));
filbuff[fn] := false
end;(*putfile*)
16. 条件コンパイル指令の変更 (6)
GPC 用の条件コンパイル指令を Delphi 用に書き換えます。
pint.dpr
{ !!! remove this next statement for self compile }
//#ifndef SELF_COMPILE
{$IFNDEF SELF_COMPILE}
rewrite(prr);
//#endif
{$ENDIF}
17. ファイルアサイン
ここまでの変更でコンパイルは通るようになったと思いますが、まだ正しく動作はしません。
'prd' を外部ファイル prd に、'prr' を外部ファイル prr に関連付けるよう、メインブロックの先頭に AssignFile() を追加します。
pint.dpr
...
begin (* main *)
AssignFile(prd, 'prd');
AssignFile(prr, 'prr');
try
{ Suppress unreferenced errors. }
18. ファイルクローズ
ファイルを確実にフラッシュするために Flush() と CloseFile() を追加します。
pint.dpr
writeln;
writeln('program complete');
CloseFile(prd);
Flush(prr);
CloseFile(prr);
end.
19. W1050 を消す
WideChar に対して in 演算子を使用している箇所を CharInSet() で置き換えます。
pint.dpr
// if not (ch in ['!', 'l', 'q', ' ', ':', 'o', 'g','v', 'f']) then
if not CharInSet(ch, ['!', 'l', 'q', ' ', ':', 'o', 'g','v', 'f']) then
変更対象が複数あります。
20. W1036 を消す
ローカル変数が初期化されていない箇所があるので初期化します。
pint.dpr
p := 0;
変更対象が複数あります。
21. H2077 を消す
使われていない代入があるのでコメントアウトします。
pint.dpr
// len := len; { shut up compiler check }
22. H2164 を消す
H2077 を潰すと、使われていない変数が発生するので、これもコメントアウトします。
pint.dpr
{op: instyp;} q : address; (*instruction register*)
23. W1021 を消す
{$WARN} 指令を使ってワーニングを握りつぶします。
pint.dpr
{ Suppress unreferenced errors. }
{$WARN COMPARISON_FALSE OFF}
if adral = 0 then;
if adral = 0 then;
if boolal = 0 then;
if charmax = 0 then;
if charal = 0 then;
if codemax = 0 then;
if filesize = 0 then;
if fileal = 0 then;
if intdig = 0 then;
if maxresult = 0 then;
if ordminchar = 0 then;
if ordmaxchar = 0 then;
if maxexp = 0 then;
if stackelsize = 0 then;
if filres = 0 then;
if ujplen = 0 then;
if false then dmpdsp(0);
{$WARN COMPARISON_FALSE ON}
これでヒントも警告もなくなりました。
24. Read() 手続きの挙動
Read() 手続きの挙動が異なるため、Delphi では l 4=-40 のような行でファイルポインタが l の後にある場合、数値変数に 4 を読み込む事ができません。ReadNum() 関数を作って処理を置き換えます。
pint.dpr
procedure load;
type labelst = (entered,defined); (*label situation*)
labelrg = 0..maxlabel; (*label range*)
labelrec = record
val: address;
st: labelst
end;
var word : array[alfainx] of char; ch : char;
labeltab: array[labelrg] of labelrec;
labelvalue: address;
iline: integer; { line number of intermediate file }
function ReadNum(var F: Text): Integer;
var
IsNegative: Boolean;
begin
result := 0;
while (CurrentChar(F) = ' ') and not Eoln(F) do
Read(F, ch);
IsNegative := CurrentChar(F) = '-';
if IsNegative then
Read(F, ch);
while CharInSet(CurrentChar(F), ['0'..'9']) and not Eoln(F) do
begin
result := result * 10 + Ord(CurrentChar(F)) - Ord('0');
Read(F, ch);
end;
if IsNegative then
result := -result;
end;
pint.dpr
case ch of
'!': getlin; { comment }
// 'l': begin read(prd,x);
'l': begin x := ReadNum(prd);
getnxt;
if ch='=' then read(prd,labelvalue)
else labelvalue:= pc;
update(x); getlin
end;
pint.dpr
7: begin skpspc;
if ch <> '(' then
errorl('ldcs() expected ');
s := [ ]; getnxt;
while ch<>')' do
// begin read(prd,s1); getnxt; s := s + [s1]
begin s1 := ReadNum(prd); getnxt; s := s + [s1]
end;
cp := cp-setsize;
alignd(setal, cp);
if cp <= 0 then
errorl('constant table overflow ');
putset(cp, s);
q := cp;
storeop; storeq
end
end (*case*)
25. mod 演算子の挙動
想定されている mod 演算子の挙動と異なるので、それを代替するための Mod2() 関数を追加します。
まず、uses に Math を追加します。
pint.dpr
program pcode(input,output,prd,prr);
{$APPTYPE Console}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
uses
System.SysUtils, System.Math;
できるだけ前方に Mod2() 関数を記述します。
pint.dpr
function Mod2(a, n: Integer): Integer;
begin
if n = 0 then
result := a
else
result := a - Floor(Extended(a / n)) * n;
end (*Mod2*) ;
mod 演算子を使っている箇所を Mod2() 関数で置き換えます。
pint.dpr
// v := v mod maxpow16; { remove digit }
v := Mod2(v, maxpow16); { remove digit }
変更対象が複数あります。
これで PINT が正しく動作するようになりました。
■ 機能拡張
機能拡張に関する修正です。
1. 任意の外部ファイルを扱えるようにする
Pascal-P5 では標準入出力 input / output 以外では特殊なファイル prd (入力) prr (出力) しか使えません。この制約はあまりにも大きいので、任意の外部ファイルを扱えるように改変します。
PCOM で外部ファイルをエラーにしている箇所をコメントアウトします。
pcom.dpr
// { output general error for undefined external file }
// writeln(output);
// writeln(output,'**** Error: external file unknown ''',
// string(fextfilep^.filename):8, '''');
// toterr := toterr+1;
PINT で Reset() または Rewrite() が実行される直前に AssignFile() でファイルを割り当てます。
pint.dpr
22(*rsf*): begin popadr(ad); valfil(ad); fn := store[ad];
if fn <= prrfn then case fn of
inputfn: errori('Reset on input file ');
outputfn: errori('Reset on output file ');
prdfn: reset(prd);
prrfn: errori('Reset on prr file ')
end
else begin
filstate[fn] := fread;
AssignFile(filtable[fn] , 'FILE.' + IntToStr(fn - 4)); // 追加
reset(filtable[fn]);
filbuff[fn] := false
end
end;
23(*rwf*): begin popadr(ad); valfil(ad); fn := store[ad];
if fn <= prrfn then case fn of
inputfn: errori('Rewrite on input file ');
outputfn: errori('Rewrite on output file ');
prdfn: errori('Rewrite on prd file ');
prrfn: rewrite(prr)
end
else begin
filstate[fn] := fwrite;
AssignFile(filtable[fn] , 'FILE.' + IntToStr(fn - 4)); // 追加
rewrite(filtable[fn])
end
end;
PINT 終了時に外部ファイルをすべて閉じます。
pint.dpr
writeln;
writeln('program complete');
for i := 5 to maxfil do
begin
if filstate[i] <> fclosed then
begin
if filstate[i] = fwrite then
Flush(filtable[i]);
CloseFile(filtable[i]);
end;
end;
CloseFile(prd);
Flush(prr);
CloseFile(prr);
end.
この拡張を行う事で任意のファイルが扱えるようになりますが、ファイル名を指定できないため、次のようなプログラムヘッダだった場合、
program Test(Input, Output, TEMP, FIZZ, BUZZ);
次のようなファイル名が割り当てられます。
| 外部ファイル | ファイル名 |
|---|---|
| TEMP | 'FILE.1' |
| FIZZ | 'FILE.2' |
| BUZZ | 'FILE.3' |
外部ファイルの識別子をそのままファイル名にすればよさそうに思えるかもしれませんが、Pascal-P5 はコンパイラなのです。コンパイルした時点で識別子の情報は失われます。
この拡張はオリジナルの Pascal-P5 中間ファイルと互換性を保っています。
2. 任意のファイル名をバインドできるようにする
もっと簡単に外部ファイルを使えるようにするため、言語を拡張します。具体的にはプログラムヘッダでファイル名をバインドできるようにします。
program Test(Input, Output, TEMP='TEMP.TXT');
ファイル名のバインドは、今まで数多くの Pascal 方言が実装してきました。
- Assign() / AssignFile()
- Reset() / Rewrite() の追加パラメータでファイル名を指定
- Bind() / Binding() / Unbind() でバインド
これらの実装は理に適っており、ファイル名をプログラム中で任意に変更する事ができます。しかしながらその代償としてプログラムヘッダが形骸化してしまいます。
標準 Pascal では string 型がありませんし (標準 Pascal の任意の長さの文字列型をルーチンに渡すのは面倒)、先に示した拡張の方が Pascal の雰囲気に合っているかと思います。
PCOM で、文字列定数の認識長さを 250 文字まで拡張します。
pcom.dpr
// varsqt = 10; { variable string quanta }
varsqt = strglgth; { variable string quanta }
programme() を書き換え、中間形式ファイルに x コマンドを追加します。これはファイル No にファイル名を割り当てる機能です。
| コマンド | オペランド 1 | オペランド 2 |
|---|---|---|
| x | ファイル No | ファイル名 |
pcom.dpr
procedure programme(fsys:setofsys);
var extfp:extfilep;
extfn: Integer; // Add
extfilename: string; // Add
begin
extfn := 5;
chkudtf := chkudtc; { finalize undefined tag checking flag }
if sy = progsy then
begin insymbol; if sy <> ident then error(2) else insymbol;
if not (sy in [lparent,semicolon]) then error(14);
if sy = lparent then
begin
repeat insymbol;
if sy = ident then
begin getfil(extfp); if searchext then error(240);
with extfp^ do
begin filename := id; nextfile := fextfilep end;
fextfilep := extfp;
extfilename := Trim(id); // Add
{ check 'input' or 'output' appears in header for defaults }
if strequri('input ', id) then inputhdf := true
else if strequri('output ', id) then outputhdf := true;
insymbol;
// if not ( sy in [comma,rparent] ) then
// perror(20, fsys+[ident,comma,rparent,semicolon], [])
{ Add begin }
if not ( sy in [comma,rparent,relop] ) then
perror(20, fsys+[ident,comma,rparent,relop,semicolon], [])
else if sy = relop then
begin
insymbol;
if sy <> stringconst then
perror(31, fsys+[stringconst], [])
else
begin
extfilename := Trim(string(val.valp^.sval.str));
insymbol
end;
end;
if not (strequri('input ', id) or
strequri('output ', id) or
strequri('prd ', id) or
strequri('prr ', id)) then
begin
writeln(prr, 'x ', extfn:1, ' ''', extfilename, '''');
extfn := extfn + 1;
end;
{ Add end }
end
else perror(2, fsys+[ident,comma,rparent,semicolon], [])
until sy <> comma;
if sy <> rparent then perror(4, fsys+[rparent,semicolon], []);
insymbol;
if sy <> semicolon then perror(14, fsys+[rparent,semicolon], [])
end;
if sy = semicolon then insymbol
end else error(3);
repeat block(fsys,period,nil);
if sy <> period then error(21)
until (sy = period) or eof(prd);
if list then writeln(output);
if errinx <> 0 then
begin list := false; endofline end;
end (*programme*) ;
ファイル No は 5 から始まります。1～4 のファイル No は予約されています。
| ファイル No | 識別子 |
|---|---|
| 1 | input |
| 2 | output |
| 3 | prd |
| 4 | prr |
ファイル名を指定した場合にはそのファイル名が、指定しなかった場合には外部ファイルの識別子がファイル名として指定されます。
program Test(Input, input, output, TMP='TEMP.TXT', FIZZ, BUZZ);
!
! Pascal intermediate file Generated by P5 Pascal compiler vs. 1.4
!
o b-c+d+i-l+r+s-t-u+v+x-y-z-
:1
x 5 'TEMP.TXT'
x 6 'FIZZ'
x 7 'BUZZ'
PINT にファイル名の格納場所を作ります。
pint.dpr
filtable : array [1..maxfil] of text; { general (temp) text file holders }
nfiltable : array [1..maxfil] of string; // Add
generate() を書き換えます
pint.dpr
procedure generate;(*generate segment of code*)
var x: integer; (* label number *)
l: integer;
again: boolean;
ch1: char;
ad: address;
s: string; // Add
...
getnxt;(* first character of line*)
// if not CharInSet(ch, ['!', 'l', 'q', ' ', ':', 'o', 'g','v', 'f']) then
if not CharInSet(ch, ['!', 'l', 'q', ' ', ':', 'o', 'g','v', 'f', 'x']) then
errorl('unexpected line start ');
'f': begin { faults (errors) }
read(prd,i); errsinprg := errsinprg+i; getlin
end;
{ Add begin }
'x': begin { external file }
read(prd, i);
read(prd, s);
nfiltable[i] := StringReplace(Trim(s), '''', '', [rfReplaceAll]);
getlin
end;
{ Add end }
Reset() または Rewrite() が実行される直前に AssignFile() でファイルを割り当てます。
pint.dpr
procedure callsp;
var line: boolean;
i, j, w, l, f: integer;
c: char;
b: boolean;
ad,ad1: address;
r: real;
fn: fileno;
mn,mx: integer;
FileName: string; // Add
...
22(*rsf*): begin popadr(ad); valfil(ad); fn := store[ad];
if fn <= prrfn then case fn of
inputfn: errori('Reset on input file ');
outputfn: errori('Reset on output file ');
prdfn: reset(prd);
prrfn: errori('Reset on prr file ')
end
else begin
filstate[fn] := fread;
{ Add begin }
if nfiltable[fn] = '' then
FileName := 'FILE.' + IntToStr(fn - 4)
else
FileName := nfiltable[fn];
AssignFile(filtable[fn] , FileName);
{ Add end}
reset(filtable[fn]);
filbuff[fn] := false
end
end;
23(*rwf*): begin popadr(ad); valfil(ad); fn := store[ad];
if fn <= prrfn then case fn of
inputfn: errori('Rewrite on input file ');
outputfn: errori('Rewrite on output file ');
prdfn: errori('Rewrite on prd file ');
prrfn: rewrite(prr)
end
else begin
filstate[fn] := fwrite;
{ Add begin }
if nfiltable[fn] = '' then
FileName := 'FILE.' + IntToStr(fn - 4)
else
FileName := nfiltable[fn];
AssignFile(filtable[fn] , FileName);
{ Add end}
rewrite(filtable[fn])
end
end;
x コマンドが記述されていない場合には FILE.(ファイルNo) のファイル名が使われます。
この拡張は外部ファイルを利用しなければオリジナルの Pascal-P5 中間ファイルと互換性を保っています。
3. PCOM / PINT でコマンドラインパラメータとしてファイル名を受け付けるようにする
入力ファイルと出力ファイルが prd / prr 固定というのはあまりに不便なので、コマンドラインパラメータとしてファイル名を受け付けるようにします。
PCOM <Pascal ソースファイル (*.pas)>
Pascal ソースファイル をコマンドラインパラメータとして指定した場合にはそれを Pascal ソースファイルとみなしてコンパイルし、中間形式ファイルとして拡張子を .p5 にしたものを出力します。
pcom.dpr
begin
if ParamCount > 0 then
begin
AssignFile(prd, ParamStr(1));
AssignFile(prr, ChangeFileExt(ParamStr(1), '.p5'));
end
else
begin
AssignFile(prd, 'prd');
AssignFile(prr, 'prr');
end;
try
...
PINT <中間形式ファイル (*.p5)>
中間形式ファイル をコマンドラインパラメータとして指定した場合にはそれを Pascal 中間形式ファイルとして解釈・実行します。
pint.dpr
begin (* main *)
if ParamCount > 0 then
AssignFile(prd, ParamStr(1))
else
AssignFile(prd, 'prd');
AssignFile(prr, 'prr');
try
...
コマンドラインパラメータにファイルを指定しなかった場合には従来と同じ挙動となります。
■ 不具合の修正
不具合に関する修正です。
1. 内部ファイルへの対応 (1)
標準 Pascal では外部ファイルに関連付けない内部ファイルが使えますが、Delphi はこれに対応していないため、外部ファイルとして対応します。
uses に System.IOUtils を追加します。
pint.dpr
uses
System.SysUtils, System.Math, System.IOUtils;
テンポラリファイルを外部ファイルとして割り当てます。
pint.dpr
33(*rsb*): begin popadr(ad); valfil(ad); fn := store[ad];
if filstate[fn] = fclosed then
errori('Cannot reset closed file ');
filstate[fn] := fread;
if nfiltable[fn] = '' then // 追加
FileName := TPath.Combine(TPath.GetTempPath, Format('TMPFILE%.3d.BIN', [fn-4])) // 追加
else // 追加
FileName := nfiltable[fn]; // 追加
AssignFile(bfiltable[fn] , FileName); // 追加
reset(bfiltable[fn]);
filbuff[fn] := false
end;
34(*rwb*): begin popadr(ad); valfil(ad); fn := store[ad];
filstate[fn] := fwrite;
if nfiltable[fn] = '' then // 追加
FileName := TPath.Combine(TPath.GetTempPath, Format('TMPFILE%.3d.BIN', [fn-4])) // 追加
else // 追加
FileName := nfiltable[fn]; // 追加
AssignFile(bfiltable[fn] , FileName); // 追加
rewrite(bfiltable[fn]);
filbuff[fn] := false
end;
アプリケーション終了時にテンポラリファイルを閉じるようにします。
pint.dpr
for i := 5 to maxfil do
begin
if TtextRec(filtable[i]).Handle <> 0 then
begin
if filstate[i] = fwrite then
Flush(filtable[i]);
CloseFile(filtable[i]);
end;
if TFileRec(bfiltable[i]).Handle <> 0 then
CloseFile(bfiltable[i]);
end;
CloseFile(prd);
Flush(prr);
CloseFile(prr);
end.
2. 内部ファイルへの対応 (2)
Delphi では常に外部ファイルを用いる関係上、Reset / Rewrite を切り替えるには一旦ファイルをクローズしなくてはなりません。
また、このような使い方は内部ファイルでしかあり得ないので、これもテンポラリファイルとして処理します。
pint.dpr
22(*rsf*): begin popadr(ad); valfil(ad); fn := store[ad];
if fn <= prrfn then case fn of
inputfn: errori('Reset on input file ');
outputfn: errori('Reset on output file ');
prdfn: reset(prd);
prrfn: errori('Reset on prr file ')
end
else begin
{ Add begin }
if filstate[fn] <> fclosed then
begin
if filstate[fn] = fwrite then
Flush(filtable[fn]);
CloseFile(filtable[fn]);
end;
{ Add end }
filstate[fn] := fread;
if nfiltable[fn] = '' then
FileName := TPath.Combine(TPath.GetTempPath, Format('TMPFILE%.3d.TXT', [fn-4])) // 変更
else
FileName := nfiltable[fn];
AssignFile(filtable[fn] , FileName);
reset(filtable[fn]);
filbuff[fn] := false
end
end;
23(*rwf*): begin popadr(ad); valfil(ad); fn := store[ad];
if fn <= prrfn then case fn of
inputfn: errori('Rewrite on input file ');
outputfn: errori('Rewrite on output file ');
prdfn: errori('Rewrite on prd file ');
prrfn: rewrite(prr)
end
else begin
{ Add begin }
if filstate[fn] <> fclosed then
begin
if filstate[fn] = fwrite then
Flush(filtable[fn]);
CloseFile(filtable[fn]);
end;
{ Add end }
filstate[fn] := fwrite;
if nfiltable[fn] = '' then
FileName := TPath.Combine(TPath.GetTempPath, Format('TMPFILE%.3d.TXT', [fn-4])) // 変更
else
FileName := nfiltable[fn];
AssignFile(filtable[fn] , FileName);
rewrite(filtable[fn])
end
end;
3. Write() / Writeln() での Boolean
例えば、次のようなコードがあると、
program BoolStr(Output);
begin
Writeln(1=1);
end.
オリジナルの Pascal-P5 (GPC) では
True
と表示されますが、Delphi でビルドすると
TRUE
と表示されます。さらに幅を指定してみます。
program BoolStr(Output);
begin
Writeln(1=1:3);
end.
Pascal-P5 では
Tru
と表示されますが、Delphi では
TRUE
と表示されます。この非互換を解消するために、WriteBool() 手続きを用意します。
pint.dpr
procedure WriteBool(var F: Text; b: Boolean; w: Integer = 0);
const
BOOLSTR: array [Boolean] of string = ('false', 'true');
var
s: string;
begin
s := BOOLSTR[b];
if w > 0 then
begin
if Length(s) < w then
s := StringOfChar(' ', w - (Length(s))) + s
else
s := Copy(s, 1, w);
end;
Write(F, s);
end (*WriteBool*) ;
Boolean 値をファイル出力している箇所を修正します。
pint.dpr
24(*wrb*): begin popint(w); popint(i); b := i <> 0; popadr(ad);
pshadr(ad); valfil(ad); fn := store[ad];
if w < 1 then errori('Width cannot be < 1 ');
if fn <= prrfn then case fn of
inputfn: errori('Write on input file ');
// outputfn: write(output, b:w);
outputfn: WriteBool(output, b, w);
prdfn: errori('Write on prd file ');
// prrfn: write(prr, b:w)
prrfn: WriteBool(prr, b, w)
end
else begin
if filstate[fn] <> fwrite then
errori('File not in write mode ');
// write(filtable[fn], b:w)
WriteBool(filtable[fn], b, w)
end
end;
Write() / Writeln() における論理値の大文字・小文字は処理系定義となっており、どれが正解というのはありません。
『Pascal User Manual and Report』ではすべて小文字になっていますので、これに倣います。
4. Write() / Writeln() での Real (固定小数点)
例えば、次のようなコードがあると、
program RealStr(Output);
begin
Writeln(987.6:10);
Writeln(-987.6:10);
end.
オリジナルの Pascal-P5 (GPC) では
9.876e+02
-9.876e+02
と表示されますが、Delphi でビルドすると
9.876E+0002
-9.876E+0002
と表示されます。
この非互換を解消するために、WriteReal() 手続きを用意します。
pint.dpr
procedure WriteReal(var F: Text; r: Real; w: Integer = 0);
var
s: string;
w2: Integer;
begin
if w < 8 then
w2 := 2
else
w2 := w - 6;
s := FloatToStrF(r, ffExponent, w2, 2);
if r >= 0 then
s := ' ' + s;
Write(F, s);
end (*WriteReal*) ;
pint.dpr
9 (*wrr*): begin popint(w); poprel(r); popadr(ad); pshadr(ad);
valfil(ad); fn := store[ad];
if w < 1 then errori('Width cannot be < 1 ');
if fn <= prrfn then case fn of
inputfn: errori('Write on input file ');
// outputfn: write(output, r: w);
outputfn: WriteReal(output, r, w);
prdfn: errori('Write on prd file ');
// prrfn: write(prr, r:w)
prrfn: WriteReal(prr, r, w)
end
else begin
if filstate[fn] <> fwrite then
errori('File not in write mode ');
// write(filtable[fn], r:w)
WriteReal(filtable[fn], r, w)
end;
end;
Write() / Writeln() における指数桁数は処理系定義となっており、どれが正解というのはありません。
『Pascal User Manual and Report』では 2 になっていますので、これに倣います。
同様に指数文字の大文字・小文字も処理系定義となっており、どれが正解というのはありません。
『Pascal User Manual and Report』では大文字の E になっていますので、これに倣います。
5. Eoln() が True の時の文字
Eoln() が True の時の文字ですが、Delphi では改行文字をそのまま返してしまうので、空白文字を返すようにします。加えて、Windows 環境で CR (0D) が来たら、次の 1 文字も読み飛ばすようにします。
pint.dpr
procedure readc(var f: text; var c: char);
begin if eof(f) then errori('End of file ');
read(f,c);
{$IFDEF MSWINDOWS}
if c = #$0D then
read(f,c);
{$ENDIF}
if c = #$0A then
c := ' ';
end;(*readc*)
6. テキストファイルでの Write と Writeln
標準 Pascal ではテキストファイルに不完全な行があった場合、行末が書き込まれる仕様です。つまり、Writeln() ではなく Write() で終わった場合には行末が書き込まれるのですが、Delphi ではそのようになっていません。
行末の状態を確認し、必要に応じて行末を書き込む AddEoln() 手続きを用意します。
pint.dpr
procedure AddEoln(var F: Text);
begin
if (TTextRec(F).BufPtr + TTextRec(F).BufPos - 1)^ <> #$0A then
Writeln(F);
end (*AddEoln*) ;
ファイルが閉じられる際に行末の状態をチェックし、行末がなければ行末を書き込みます。
pint.dpr
22(*rsf*): begin popadr(ad); valfil(ad); fn := store[ad];
if fn <= prrfn then case fn of
inputfn: errori('Reset on input file ');
outputfn: errori('Reset on output file ');
prdfn: reset(prd);
prrfn: errori('Reset on prr file ')
end
else begin
if filstate[fn] <> fclosed then
begin
if filstate[fn] = fwrite then
begin
AddEoln(filtable[fn]); // 追加
Flush(filtable[fn]);
end;
CloseFile(filtable[fn]);
end;
filstate[fn] := fread;
if nfiltable[fn] = '' then
FileName := TPath.Combine(TPath.GetTempPath, Format('TMPFILE%.3d.TXT', [fn-4]))
else
FileName := nfiltable[fn];
AssignFile(filtable[fn] , FileName);
reset(filtable[fn]);
filbuff[fn] := false
end
end;
23(*rwf*): begin popadr(ad); valfil(ad); fn := store[ad];
if fn <= prrfn then case fn of
inputfn: errori('Rewrite on input file ');
outputfn: errori('Rewrite on output file ');
prdfn: errori('Rewrite on prd file ');
prrfn: rewrite(prr)
end
else begin
if filstate[fn] <> fclosed then
begin
if filstate[fn] = fwrite then
begin
AddEoln(filtable[fn]); // 追加
Flush(filtable[fn]);
end;
CloseFile(filtable[fn]);
end;
filstate[fn] := fwrite;
if nfiltable[fn] = '' then
FileName := TPath.Combine(TPath.GetTempPath, Format('TMPFILE%.3d.TXT', [fn-4]))
else
FileName := nfiltable[fn];
AssignFile(filtable[fn] , FileName);
rewrite(filtable[fn])
end
end;
pint.dpr
for i := 5 to maxfil do
begin
if TtextRec(filtable[i]).Handle <> 0 then
begin
if filstate[i] = fwrite then
begin
AddEoln(filtable[i]); // 追加
Flush(filtable[i]);
end;
CloseFile(filtable[i]);
end;
if TFileRec(bfiltable[i]).Handle <> 0 then
CloseFile(bfiltable[i]);
end;
CloseFile(prd);
Flush(prr);
CloseFile(prr);
end.
■ チューニング
チューニングに関する修正です。
1. 条件コンパイル指令の削除
Delphi でコンパイルできるようにソースコードを改変した時点でセルフコンパイルは望めないので、セルフコンパイル用の不要なコードを削除します。
pcom.dpr
// { !!! remove this statement for self compile }
//{$IFNDEF SELF_COMPILE}
prd,prr: text; { output code file }
//{$ENDIF}
pcom.dpr
// { !!! remove these statements for self compile }
//{$IFNDEF SELF_COMPILE}
reset(prd); rewrite(prr); { open output file }
//{$ENDIF}
pint.dpr
//{$IFNDEF SELF_COMPILE}
maxstr = 16777215; { maximum size of addressing for program/var }
maxtop = 16777216; { maximum size of addressing for program/var+1 }
maxdef = 2097152; { maxstr / 8 for defined bits }
//{$ELSE}
// maxstr = 2000000; { maximum size of addressing for program/var }
// maxtop = 2000001; { maximum size of addressing for program/var+1 }
// maxdef = 250000; { maxstr /8 for defined bits }
//{$ENDIF}
pint.dpr
// { !!! remove this next statement for self compile }
//{$IFNDEF SELF_COMPILE}
prd,prr : text; (*prd for read only, prr for write only *)
//{$ENDIF}
pint.dpr
// { !!! remove this next statement for self compile }
//{$IFNDEF SELF_COMPILE}
reset(prd);
//{$ENDIF}
pint.dpr
// { !!! remove this next statement for self compile }
//{$IFNDEF SELF_COMPILE}
rewrite(prr);
//{$ENDIF}
2. 文字配列の縮小
Unicode 版 Delphi の Char は WideChar なため、array [Char] of のような定義は無駄に大きい配列を確保します。
部分範囲型 subchar を定義して、
pcom.dpr
{ Subrange char }
subchar = Chr(ordminchar)..Chr(ordmaxchar);
(*-------------------------------------------------------------------------*)
var
[char] を [subchar] に置き換えます。
pcom.dpr
// chartp : array[char] of chtp;
chartp : array[subchar] of chtp;
rw: array [1..maxres(*nr. of res. words*)] of restr;
frw: array [1..10] of 1..36(*nr. of res. words + 1*);
rsy: array [1..maxres(*nr. of res. words*)] of symbol;
// ssy: array [char] of symbol;
ssy: array [subchar] of symbol;
rop: array [1..maxres(*nr. of res. words*)] of operatort;
// sop: array [char] of operatort;
sop: array [subchar] of operatort;
na: array [1..maxstd] of restr;
mn: array [0..maxins] of packed array [1..4] of char;
sna: array [1..maxsp] of packed array [1..4] of char;
cdx: array [0..maxins] of integer;
cdxs: array [1..6, 1..7] of integer;
pdx: array [1..maxsp] of integer;
// ordint: array [char] of integer;
ordint: array [subchar] of integer;
3. コンパイラを騙すためのコードの削除
「参照されていない」というエラーを出さないようにするためのコードがあるので、これを削除します。Delphi ではエラーにならないようです。
pcom.dpr
// { Suppress unreferenced errors. These are all MPB (machine parameter
// block) equations that need to stay the same between front end and backend. }
// if begincode = 0 then;
// if heapal = 0 then;
// if inthex = 0 then;
// if market = 0 then;
// if markwb = 0 then;
// if markep = 0 then;
// if markdl = 0 then;
// if markra = 0 then;
// if marksb = 0 then;
// if marksl = 0 then;
// if maxresult = 0 then;
// if maxsize = 0 then;
// if gbsal = 0 then;
// if ujplen = 0 then;
pint.dpr
// { Suppress unreferenced errors. }
// {$WARN COMPARISON_FALSE OFF}
// if adral = 0 then;
// if adral = 0 then;
// if boolal = 0 then;
// if charmax = 0 then;
// if charal = 0 then;
// if codemax = 0 then;
// if filesize = 0 then;
// if fileal = 0 then;
// if intdig = 0 then;
// if maxresult = 0 then;
// if ordminchar = 0 then;
// if ordmaxchar = 0 then;
// if maxexp = 0 then;
// if stackelsize = 0 then;
// if filres = 0 then;
// if ujplen = 0 then;
// if false then dmpdsp(0);
// {$WARN COMPARISON_FALSE ON}
4. 冗長な New() / Dispose() の削除
New() / Dispose() の二番目の書式を使わないようにしたため、冗長な記述になっている箇所があります。
pcom.dpr
{ recycle constant entry }
procedure putcst(p: csp);
begin
{ recycle string if present }
if p^.cclass = strg then putstrs(p^.sval)
else if p^.cclass = reel then putstrs(p^.rval);
{ release entry }
// case p^.cclass of
// reel: dispose(p);
// pset: dispose(p);
// strg: dispose(p)
// end;
Dispose(p); // 追加
cspcnt := cspcnt-1 { remove from count }
end;
pcom.dpr
{ recycle structure entry }
procedure putstc(p: stp);
begin
{ release entry }
// case p^.form of
// scalar: if p^.scalkind = declared then dispose(p)
// else dispose(p);
// subrange: dispose(p);
// pointer: dispose(p);
// power: dispose(p);
// arrays: dispose(p);
// records: dispose(p);
// files: dispose(p);
// tagfld: begin dispose(p^.vart); dispose(p) end;
// variant: dispose(p);
// end;
if p^.form = tagfld then // 追加
Dispose(p^.vart); // 追加
Dispose(p); // 追加
stpcnt := stpcnt-1
end;
pcom.dpr
procedure putnam{(p: ctp)};
begin
if (p^.klass = proc) or (p^.klass = func) then putidlst(p^.pflist);
putstrs(p^.name); { release name string }
{ release entry according to class }
// case p^.klass of
// types: dispose(p);
// konst: dispose(p);
// vars: dispose(p);
// field: dispose(p);
// proc: if p^.pfdeckind = standard then dispose(p)
// else if p^.pfkind = actual then
// dispose(p)
// else dispose(p);
// func: if p^.pfdeckind = standard then dispose(p)
// else if p^.pfkind = actual then
// dispose(p)
// else dispose(p)
// end;
Dispose(p); // 追加
ctpcnt := ctpcnt-1 { remove from count }
end;
5. テンポラリファイルの削除
PINT 終了時にテンポラリファイルを削除するようにします。
pint.dpr
majorver = 1; { major version number }
minorver = 3; { minor version number }
experiment = false; { is version experimental? }
p5temp = 'P5TMP'; // 追加
RemoveTempFile() 手続きを実装します。
pint.dpr
procedure RemoveTempFile;
begin
for var FileName in TDirectory.GetFiles(TPath.GetTempPath, p5temp + '*.*', TSearchOption.soTopDirectoryOnly) do
try
TFile.Delete(FileName);
except
;
end;
end (*RemoveTempFile*) ;
PINT が出力したテンポラリファイルを特定できるように、ファイル名を p5temp を使って指定します。
pint.dpr
FileName := TPath.Combine(TPath.GetTempPath, Format(p5temp + '%.3d.TXT', [fn-4]))
...
FileName := TPath.Combine(TPath.GetTempPath, Format(p5temp + '%.3d.TXT', [fn-4]))
...
FileName := TPath.Combine(TPath.GetTempPath, Format(p5temp + '%.3d.BIN', [fn-4]))
...
FileName := TPath.Combine(TPath.GetTempPath, Format(p5temp + '%.3d.BIN', [fn-4]))
終了時にテンポラリファイルを削除するようにします。
pint.dpr
CloseFile(prd);
Flush(prr);
CloseFile(prr);
RemoveTempFile; // 追加
end.
ウィルス対策ソフトが反応して、すべてのテンポラリファイルが消えない事があります。
おわりに
やはり v1.3 よりも修正箇所が増えました。改変したソースファイル一式は GitHub にアップしてあります。
プラットフォームに固有の機能は使っていないので、macOS 用や Linux 用としてもビルド可能だと思います。
GitHub の source フォルダにある pcom.dpr と pint.dpr は v1.4 のものですが、mod 1.3 サブフォルダのファイルを上書きして v1.3 をビルドする事もできます。
See also:
-
64bit 環境用のパラメータが設定されないだけで、ビルドは成功します。 ↩