はじめに
前回、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. コンパイラ指令の削除
先頭のコンパイラ指令を削除します。
//(*$l-,p*)
{*******************************************************************************
* *
* PASCAL-P5 PORTABLE INTERPRETER *
* *
...
*******************************************************************************}
2. 条件コンパイル指令の変更 (1)
GNU Pascal (GPC) 用の条件コンパイル指令を Delphi 用に書き換えます。
{ 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
{$DEFINE WRDSIZ32}
常に 32bit コンパイラ用の設定を使います。これは Pascal-P5 v1.4 をコンパイルするための Pascal コンパイラの Integer 型が 16bit / 32bit / 64bit コンパイラでそれぞれ 16bit / 32bit / 64bit 整数であると想定されているからです。Delphi の Integer 型は 32bit / 64bit コンパイラともに 32bit 整数です。
Delphi 1 の Integer 型は 16bit 整数ですが、今回の記事ではビルド対象外です。
3. コンソールアプリケーションの指定
{$APPTYPE Console} を追記して、コンソールアプリケーションであることを明示します。RTTI も使わない設定にします。
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 を追加します。
...
program pascalcompiler(output,prd,prr);
{$APPTYPE Console}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
uses
System.SysUtils;
label 99; { terminate immediately }
ラベル 99を削除。
program pascalcompiler(output,prd,prr);
{$APPTYPE Console}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
uses
System.SysUtils;
//label 99; { terminate immediately }
メインブロックを try～except で括ります。ラベル 99 は削除します。
...
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 で置換します。
{ 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 用に書き換えます。
//#ifdef WRDSIZ16
//#include "mpb16.inc"
//#endif
//
//#ifdef WRDSIZ32
//#include "mpb32.inc"
//#endif
//
//#ifdef WRDSIZ64
//#include "mpb64.inc"
//#endif
{$IFDEF WRDSIZ16}
{$I 'mpb16.inc'}
{$ENDIF}
{$IFDEF WRDSIZ32}
{$I 'mpb32.inc'}
{$ENDIF}
{$IFDEF WRDSIZ64}
{$I 'mpb64.inc'}
{$ENDIF}
常に mpb32.inc を使います。
6. 条件コンパイル指令の変更 (3)
GPC 用の条件コンパイル指令を Delphi 用に書き換えます。
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() 関数の二番目の書式を使っている箇所を変更します。二番目以降のパラメータを削除するだけです。
// reel: dispose(p, reel);
reel: dispose(p);
変更対象が複数あります。
8. 条件コンパイル指令の変更 (4)
GPC 用の条件コンパイル指令を Delphi 用に書き換えます。
//#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 用に書き換えます。
//#ifdef IMM_ERR
{$IFDEF IMM_ERR}
writeln; writeln('error: ', ferrnr:1);
//#endif
{$ENDIF}
10. 識別子 string の変更
string という名前の識別子が使われていますので、これを passtr に置換します。
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() 手続きよりも前に追加してください。
function CurrentChar(var F: Text): WideChar;
begin
Eoln(F);
result := WideChar((TTextRec(F).BufPtr + TTextRec(F).BufPos)^);
end (*CurrentChar*) ;
バッファ変数を使っている箇所を CurrentChar() で置換します。
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 の長い文字列に変換します。
// ident: write('ident: ', id:10);
ident: write('ident: ', string(id):10);
変更対象が複数あります。
13. 条件コンパイル指令の変更 (6)
GPC 用の条件コンパイル指令を Delphi 用に書き換えます。
{ !!! 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() を追加します。
...
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() を追加します。
//99:
except
on E: EAbort do
;
end;
CloseFile(prd);
Flush(prr);
CloseFile(prr);
end.
16. W1050 を消す
WideChar に対して in 演算子を使用している箇所を CharInSet() で置き換えます。
// 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 を消す
ローカル変数が初期化されていない箇所があるので初期化します。
lp := nil;
変更対象が複数あります。
18. H2077 を消す
使われていない代入があるのでコメントアウトします。
// lsize := parmsize; if id <> nil then lsize := id^.size;
変更対象が複数あります。
19. H2164 を消す
H2077 を潰すと、使われていない変数が発生するので、これもブロックコメントでコメントアウトします。
var lsp,lsp1,lsp2: stp; {varts: integer;}
20. W1022 を消す
バグか仕様か不明なので、ブロックコメントでコメントアウトしておきます。
{if varcnt >= 0 then} begin
これでヒントも警告もなくなりました。
21. 改行コードの問題を解決する
Windows 環境の場合、改行コードは CR+LF (0D 0A) ですが、Delphi の Eoln() は 0x0d の位置で True を返し、0x0a の位置では False を返します。このため、Windows 環境では行末を検知したらもう 1 バイト読み飛ばす必要があります。
nextch() 手続きを次のように書き換えます。
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 ソースコードの最後のピリオドの後に改行がない場合、ピリオドが連続したとみなされて部分範囲型の範囲文字列 .. と判定されてしまいます。
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 が来たような判定がされてしまうので、次のようなコードを追加します。
// 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 を追加します。
program pascalcompiler(output,prd,prr);
{$APPTYPE Console}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
uses
System.SysUtils, System.Math;
できるだけ前方に Mod2() 関数を記述します。
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() 関数で置き換えます。
// flc := l + k - (k+l) mod k
flc := l + k - Mod2(k+l, k)
変更対象が複数あります。
これで PCOM は正しく動作するようになりました。
■ PINT
そのまま Delphi でコンパイルすると 57 件のコンパイルエラーと 1 件の警告が出ます。
1. コンパイラ指令の削除
先頭のコンパイラ指令を削除します。
//(*$l-,u-*)
{*******************************************************************************
* *
* Portable Pascal compiler *
* ************************ *
...
*******************************************************************************}
2. 条件コンパイル指令の変更 (1)
GNU Pascal (GPC) 用の条件コンパイル指令を Delphi 用に書き換えます。
{ 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
{$DEFINE WRDSIZ32}
3. コンソールアプリケーションの指定
{$APPTYPE Console} を追記して、コンソールアプリケーションであることを明示します。RTTI も使わない設定にします。
program pcode(input,output,prd,prr);
{$APPTYPE Console}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
4. goto 1 の削除
プログラム終端付近にラベル 1 が設定されていますので、Abort() を使って代替します。
例外を使うので、uses に SysUtils を追加します。
...
program pcode(input,output,prd,prr);
{$APPTYPE Console}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
uses
System.SysUtils;
label 1;
ラベル 1を削除。
program pascalcompiler(output,prd,prr);
{$APPTYPE Console}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
//label 1;
メインブロックを try～except で括ります。ラベル 1 は削除します。
...
begin (* main *)
try
{ Suppress unreferenced errors. }
...
// 1 : { abort run }
except
on E: EAbort do
;
end;
writeln;
writeln('program complete');
end.
goto 1 を Abort で置換します。
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*)
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 用に書き換えます。
//#ifdef WRDSIZ16
//#include "mpb16.inc"
//#endif
//
//#ifdef WRDSIZ32
//#include "mpb32.inc"
//#endif
//
//#ifdef WRDSIZ64
//#include "mpb64.inc"
//#endif
{$IFDEF WRDSIZ16}
{$I 'mpb16.inc'}
{$ENDIF}
{$IFDEF WRDSIZ32}
{$I 'mpb32.inc'}
{$ENDIF}
{$IFDEF WRDSIZ64}
{$I 'mpb64.inc'}
{$ENDIF}
6. 条件コンパイル指令の変更 (3)
GPC 用の条件コンパイル指令を Delphi 用に書き換えます。
{ !!! 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 用に書き換えます。
{ !!! 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 でキャストしておきます。
//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*)
// 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 の長い文字列に変換します。
// write(' ', instr[op]:10, ' ');
write(' ', string(instr[op]):10, ' ');
変更対象が複数あります。
10. 条件コンパイル指令の変更 (5)
GPC 用の条件コンパイル指令を Delphi 用に書き換えます。
{ !!! remove this next statement for self compile }
//#ifndef SELF_COMPILE
{$IFNDEF SELF_COMPILE}
reset(prd);
//#endif
{$ENDIF}
11. Pack の削除
Delphi には Pack() がないので削除します。ここでの処理は word -> name のコピーなので、Move() 手続きで代替します。
// pack(word,1,name)
Move(word, name, SizeOf(name));
12. バッファ変数の置換
Delphi にはバッファ変数がありませんので、CurrentChar() 関数を用意します。load() 手続きよりも前に追加してください。
function CurrentChar(var F: Text): WideChar;
begin
result := WideChar((TTextRec(F).BufPtr + TTextRec(F).BufPos)^);
end (*CurrentChar*) ;
バッファ変数を使っている箇所を CurrentChar() で置換します。
// c := ch; if (ch = '''') and (prd^ = '''') then begin
c := ch; if (ch = '''') and (CurrentChar(prd) = '''') then begin
変更対象が複数あります。
13. Get() の追加
Delphi には Get() がありませんので、同等の関数を追加します。
{$HINTS OFF}
procedure Get(var F: Text);
var
ch: Char;
begin
Read(F, ch);
end (*Get*) ;
{$HINTS ON}
14. Page() の追加
Delphi には Page() 手続きがありませんので、同等の関数を追加します。
procedure Page(var F: Text);
begin
Write(F, #$0C);
end (*Page*) ;
15. Put() の代替
Delphi には Put() 手続きがありませんので、同等のロジックを追加します。
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 用に書き換えます。
{ !!! remove this next statement for self compile }
//#ifndef SELF_COMPILE
{$IFNDEF SELF_COMPILE}
rewrite(prr);
//#endif
{$ENDIF}
17. ファイルアサイン
ここまでの変更でコンパイルは通るようになったと思いますが、まだ正しく動作はしません。
'prd' を外部ファイル prd に、'prr' を外部ファイル prr に関連付けるよう、メインブロックの先頭に AssignFile() を追加します。
...
begin (* main *)
AssignFile(prd, 'prd');
AssignFile(prr, 'prr');
try
{ Suppress unreferenced errors. }
18. ファイルクローズ
ファイルを確実にフラッシュするために Flush() と CloseFile() を追加します。
writeln;
writeln('program complete');
CloseFile(prd);
Flush(prr);
CloseFile(prr);
end.
19. W1050 を消す
WideChar に対して in 演算子を使用している箇所を CharInSet() で置き換えます。
// if not (ch in ['!', 'l', 'q', ' ', ':', 'o', 'g','v', 'f']) then
if not CharInSet(ch, ['!', 'l', 'q', ' ', ':', 'o', 'g','v', 'f']) then
変更対象が複数あります。
20. W1036 を消す
ローカル変数が初期化されていない箇所があるので初期化します。
p := 0;
変更対象が複数あります。
21. H2077 を消す
使われていない代入があるのでコメントアウトします。
// len := len; { shut up compiler check }
22. H2164 を消す
H2077 を潰すと、使われていない変数が発生するので、これもコメントアウトします。
{op: instyp;} q : address; (*instruction register*)
23. W1021 を消す
{$WARN} 指令を使ってワーニングを握りつぶします。
{ 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() 関数を作って処理を置き換えます。
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;
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;
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 を追加します。
program pcode(input,output,prd,prr);
{$APPTYPE Console}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
uses
System.SysUtils, System.Math;
できるだけ前方に Mod2() 関数を記述します。
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() 関数で置き換えます。
// v := v mod maxpow16; { remove digit }
v := Mod2(v, maxpow16); { remove digit }
変更対象が複数あります。
これで PINT が正しく動作するようになりました。
■ 機能拡張
機能拡張に関する修正です。
1. 任意の外部ファイルを扱えるようにする
Pascal-P5 では標準入出力 input / output 以外では特殊なファイル prd (入力) prr (出力) しか使えません。この制約はあまりにも大きいので、任意の外部ファイルを扱えるように改変します。
PCOM で外部ファイルをエラーにしている箇所をコメントアウトします。
// { 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() でファイルを割り当てます。
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 終了時に外部ファイルをすべて閉じます。
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 文字まで拡張します。
// varsqt = 10; { variable string quanta }
varsqt = strglgth; { variable string quanta }
programme() を書き換え、中間形式ファイルに x コマンドを追加します。これはファイル No にファイル名を割り当てる機能です。
| コマンド | オペランド 1 | オペランド 2 |
|---|---|---|
| x | ファイル No | ファイル名 |
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 にファイル名の格納場所を作ります。
filtable : array [1..maxfil] of text; { general (temp) text file holders }
nfiltable : array [1..maxfil] of string; // Add
generate() を書き換えます
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() でファイルを割り当てます。
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 にしたものを出力します。
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 中間形式ファイルとして解釈・実行します。
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 を追加します。
uses
System.SysUtils, System.Math, System.IOUtils;
テンポラリファイルを外部ファイルとして割り当てます。
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;
アプリケーション終了時にテンポラリファイルを閉じるようにします。
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 を切り替えるには一旦ファイルをクローズしなくてはなりません。
また、このような使い方は内部ファイルでしかあり得ないので、これもテンポラリファイルとして処理します。
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() 手続きを用意します。
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 値をファイル出力している箇所を修正します。
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() 手続きを用意します。
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*) ;
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 文字も読み飛ばすようにします。
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() 手続きを用意します。
procedure AddEoln(var F: Text);
begin
if (TTextRec(F).BufPtr + TTextRec(F).BufPos - 1)^ <> #$0A then
Writeln(F);
end (*AddEoln*) ;
ファイルが閉じられる際に行末の状態をチェックし、行末がなければ行末を書き込みます。
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;
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 でコンパイルできるようにソースコードを改変した時点でセルフコンパイルは望めないので、セルフコンパイル用の不要なコードを削除します。
// { !!! remove this statement for self compile }
//{$IFNDEF SELF_COMPILE}
prd,prr: text; { output code file }
//{$ENDIF}
// { !!! remove these statements for self compile }
//{$IFNDEF SELF_COMPILE}
reset(prd); rewrite(prr); { open output file }
//{$ENDIF}
//{$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}
// { !!! remove this next statement for self compile }
//{$IFNDEF SELF_COMPILE}
prd,prr : text; (*prd for read only, prr for write only *)
//{$ENDIF}
// { !!! remove this next statement for self compile }
//{$IFNDEF SELF_COMPILE}
reset(prd);
//{$ENDIF}
// { !!! remove this next statement for self compile }
//{$IFNDEF SELF_COMPILE}
rewrite(prr);
//{$ENDIF}
2. 文字配列の縮小
Unicode 版 Delphi の Char は WideChar なため、array [Char] of のような定義は無駄に大きい配列を確保します。
部分範囲型 subchar を定義して、
{ Subrange char }
subchar = Chr(ordminchar)..Chr(ordmaxchar);
(*-------------------------------------------------------------------------*)
var
[char] を [subchar] に置き換えます。
// 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 ではエラーにならないようです。
// { 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;
// { 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() の二番目の書式を使わないようにしたため、冗長な記述になっている箇所があります。
{ 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;
{ 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;
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 終了時にテンポラリファイルを削除するようにします。
majorver = 1; { major version number }
minorver = 3; { minor version number }
experiment = false; { is version experimental? }
p5temp = 'P5TMP'; // 追加
RemoveTempFile() 手続きを実装します。
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 を使って指定します。
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]))
終了時にテンポラリファイルを削除するようにします。
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 環境用のパラメータが設定されないだけで、ビルドは成功します。 ↩