# Delphi で Pascal-P5 v1.4 をビルドする --- tags: Delphi programming Pascal embarcadero objectpascal created_at: 2022-01-16 updated_at: 2023-01-10 --- # はじめに 前回、Delphi で **Pascal-P5 v1.3** のソースコードをコンパイルできるように改変する記事を書きました。 - [Delphi で Pascal-P5 v1.3 をビルドする (Qiita)](./d40399477ff5a8823a33.md) 今回は Pascal-P5 v1.4 のソースコードにチャレンジしてみます。 何故、最初から v1.4 でやらなかったかというと、v1.4 は **GNU Pascal (GPC)** でしかコンパイルできないような改変がなされていたからです。v1.3 は **Free Pascal (FPC)** でもコンパイルできましたから、比較的容易にトラブルシューティングができたのです。 目論見通り v1.3 は Delphi へと移植できましたから、次は v1.4 との差分を修正すればいいわけです。  :::note info v1.3 と v1.4 で共通な詳細情報へのリンクは本記事では省いてあります。 ::: # 改変 使うのは Pascal-P5 **バージョン 1.4** のソースコードです。 - [https://sourceforge.net/projects/pascalp5/](https://sourceforge.net/projects/pascalp5/) - [https://ht-deko.com/software/pascal-p5_1_4.tgz](https://ht-deko.com/software/pascal-p5_1_4.tgz) (ミラー) アーカイブを解凍したら、`source` サブフォルダにある `pcom.pas` と `pint.pas` をそれぞれ `pcom.dpr` `pint.dpr` にリネームし、コンソールアプリケーションのプロジェクトファイルとして Delphi IDE に読み込めるようにしておきます。  Delphi は **11.0 Alexandria** を使っていますが、無償の **Community Edition** でもコンパイルできると思います。新しい機能はほぼ使っていませんが、条件シンボルの関係で Delphi XE8 以降が必要です [^1]。 **See also:** - [Delphi Community Edition (Embarcadero)](https://www.embarcadero.com/jp/products/delphi/starter) ## ■ PCOM そのまま Delphi でコンパイルすると 42 件のコンパイルエラーと 1 件の警告が出ます。  ### 1. コンパイラ指令の削除 先頭のコンパイラ指令を削除します。 ```pascal:pcom.dpr //(*$l-,p*) {******************************************************************************* * * * PASCAL-P5 PORTABLE INTERPRETER * * * ... *******************************************************************************} ``` ### 2. 条件コンパイル指令の変更 (1) **GNU Pascal (GPC)** 用の条件コンパイル指令を Delphi 用に書き換えます。 ```pascal: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} ``` :::note info 16bit コンパイラ用の設定はありません。 ::: ### 3. コンソールアプリケーションの指定 `{$APPTYPE Console}` を追記して、コンソールアプリケーションであることを明示します。RTTI も使わない設定にします。 ```pascal: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` を追加します。 ```pascal:pcom.dpr ... program pascalcompiler(output,prd,prr); {$APPTYPE Console} {$WEAKLINKRTTI ON} {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} uses System.SysUtils; label 99; { terminate immediately } ``` ラベル `99`を削除。 ```pascal: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` は削除します。 ```pascal: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` で置換します。 ```pascal: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; ``` :::note warn 変更対象が複数あります。 ::: ### 5. 条件コンパイル指令の変更 (2) **GPC** 用の条件コンパイル指令を Delphi 用に書き換えます。 ```pascal: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} ``` :::note info 16bit コンパイラ用の設定はありません。`mpb16.inc` は使いません。 ::: ### 6. 条件コンパイル指令の変更 (3) **GPC** 用の条件コンパイル指令を Delphi 用に書き換えます。 ```pascal: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() 関数の二番目の書式を使っている箇所を変更します。二番目以降のパラメータを削除するだけです。 ```pascal:pcom.dpr // reel: dispose(p, reel); reel: dispose(p); ``` :::note warn 変更対象が複数あります。 ::: ### 8. 条件コンパイル指令の変更 (4) **GPC** 用の条件コンパイル指令を Delphi 用に書き換えます。 ```pascal: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 用に書き換えます。 ```pascal:pcom.dpr //#ifdef IMM_ERR {$IFDEF IMM_ERR} writeln; writeln('error: ', ferrnr:1); //#endif {$ENDIF} ``` ### 10. 識別子 string の変更 `string` という名前の識別子が使われていますので、これを `passtr` に置換します。 ```pascal: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()` 手続きよりも前に追加してください。 ```pascal:pcom.dpr function CurrentChar(var F: Text): WideChar; begin Eoln(F); result := WideChar((TTextRec(F).BufPtr + TTextRec(F).BufPos)^); end (*CurrentChar*) ; ``` バッファ変数を使っている箇所を `CurrentChar()` で置換します。 ```pascal: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 ``` :::note warn 変更対象が複数あります。 ::: ### 12. Write() / Writeln() の書式 `write()` / `writeln()` に Pascal 文字列を渡している所があるので、Delphi の長い文字列に変換します。 ```pascal:pcom.dpr // ident: write('ident: ', id:10); ident: write('ident: ', string(id):10); ``` :::note warn 変更対象が複数あります。 ::: ### 13. 条件コンパイル指令の変更 (6) **GPC** 用の条件コンパイル指令を Delphi 用に書き換えます。 ```pascal: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()` を追加します。 ```pascal: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()` を追加します。 ```pascal:pcom.dpr //99: except on E: EAbort do ; end; CloseFile(prd); Flush(prr); CloseFile(prr); end. ``` ### 16. W1050 を消す WideChar に対して **in** 演算子を使用している箇所を `CharInSet()` で置き換えます。 ```pascal: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')); ``` :::note warn 変更対象が複数あります。 ::: ### 17. W1036 を消す ローカル変数が初期化されていない箇所があるので初期化します。 ```pascal:pcom.dpr lp := nil; ``` :::note warn 変更対象が複数あります。 ::: ### 18. H2077 を消す 使われていない代入があるのでコメントアウトします。 ```pascal:pcom.dpr // lsize := parmsize; if id <> nil then lsize := id^.size; ``` :::note warn 変更対象が複数あります。 ::: ### 19. H2164 を消す H2077 を潰すと、使われていない変数が発生するので、これもブロックコメントでコメントアウトします。 ```pascal:pcom.dpr var lsp,lsp1,lsp2: stp; {varts: integer;} ``` ### 20. W1022 を消す バグか仕様か不明なので、ブロックコメントでコメントアウトしておきます。 ```pascal:pcom.dpr {if varcnt >= 0 then} begin ``` これでヒントも警告もなくなりました。  ### 21. 改行コードの問題を解決する Windows 環境の場合、改行コードは `CR+LF (0D 0A)` ですが、Delphi の `Eoln()` は 0x0d の位置で True を返し、0x0a の位置では False を返します。このため、Windows 環境では行末を検知したらもう 1 バイト読み飛ばす必要があります。 `nextch()` 手続きを次のように書き換えます。 ```pascal: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 ソースコードの最後のピリオドの後に改行がない場合、ピリオドが連続したとみなされて部分範囲型の範囲文字列 `..` と判定されてしまいます。 ```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 が来たような判定がされてしまうので、次のようなコードを追加します。 ```pascal: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` を追加します。 ```pascal:pcom.dpr program pascalcompiler(output,prd,prr); {$APPTYPE Console} {$WEAKLINKRTTI ON} {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} uses System.SysUtils, System.Math; ``` できるだけ前方に `Mod2()` 関数を記述します。 ```pascal: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()` 関数で置き換えます。 ```pascal:pcom.dpr // flc := l + k - (k+l) mod k flc := l + k - Mod2(k+l, k) ``` :::note warn 変更対象が複数あります。 ::: これで **PCOM** は正しく動作するようになりました。  ## ■ PINT そのまま Delphi でコンパイルすると 57 件のコンパイルエラーと 1 件の警告が出ます。  ### 1. コンパイラ指令の削除 先頭のコンパイラ指令を削除します。 ```pascal:pint.dpr //(*$l-,u-*) {******************************************************************************* * * * Portable Pascal compiler * * ************************ * ... *******************************************************************************} ``` ### 2. 条件コンパイル指令の変更 (1) **GNU Pascal (GPC)** 用の条件コンパイル指令を Delphi 用に書き換えます。 ```pascal: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 も使わない設定にします。 ```pascal:pint.dpr program pcode(input,output,prd,prr); {$APPTYPE Console} {$WEAKLINKRTTI ON} {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} ``` ### 4. goto 1 の削除 プログラム終端付近にラベル `1` が設定されていますので、**Abort()** を使って代替します。 例外を使うので、**uses** に `SysUtils` を追加します。 ```pascal:pint.dpr ... program pcode(input,output,prd,prr); {$APPTYPE Console} {$WEAKLINKRTTI ON} {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} uses System.SysUtils; label 1; ``` ラベル `1`を削除。 ```pascal:pint.dpr program pascalcompiler(output,prd,prr); {$APPTYPE Console} {$WEAKLINKRTTI ON} {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} //label 1; ``` メインブロックを **try**～**except** で括ります。ラベル `1` は削除します。 ```pascal: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` で置換します。 ```pascal: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*) ``` ```pascal: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 用に書き換えます。 ```pascal: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 用に書き換えます。 ```pascal: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 用に書き換えます。 ```pascal: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** でキャストしておきます。 ```pascal: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*) ``` ```pascal: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 の長い文字列に変換します。 ```pascal:pint.dpr // write(' ', instr[op]:10, ' '); write(' ', string(instr[op]):10, ' '); ``` :::note warn 変更対象が複数あります。 ::: ### 10. 条件コンパイル指令の変更 (5) **GPC** 用の条件コンパイル指令を Delphi 用に書き換えます。 ```pascal: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()` 手続きで代替します。 ```pascal:pint.dpr // pack(word,1,name) Move(word, name, SizeOf(name)); ``` ### 12. バッファ変数の置換 Delphi にはバッファ変数がありませんので、`CurrentChar() `関数を用意します。`load()` 手続きよりも前に追加してください。 ```pascal:pint.dpr function CurrentChar(var F: Text): WideChar; begin result := WideChar((TTextRec(F).BufPtr + TTextRec(F).BufPos)^); end (*CurrentChar*) ; ``` バッファ変数を使っている箇所を `CurrentChar()` で置換します。 ```pascal:pint.dpr // c := ch; if (ch = '''') and (prd^ = '''') then begin c := ch; if (ch = '''') and (CurrentChar(prd) = '''') then begin ``` :::note warn 変更対象が複数あります。 ::: ### 13. Get() の追加 Delphi には `Get()` がありませんので、同等の関数を追加します。 ```pascal:pint.dpr {$HINTS OFF} procedure Get(var F: Text); var ch: Char; begin Read(F, ch); end (*Get*) ; {$HINTS ON} ``` ### 14. Page() の追加 Delphi には `Page()` 手続きがありませんので、同等の関数を追加します。 ```pascal:pint.dpr procedure Page(var F: Text); begin Write(F, #$0C); end (*Page*) ; ``` ### 15. Put() の代替 Delphi には `Put()` 手続きがありませんので、同等のロジックを追加します。 ```pascal: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 用に書き換えます。 ```pascal: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()` を追加します。 ```pascal:pint.dpr ... begin (* main *) AssignFile(prd, 'prd'); AssignFile(prr, 'prr'); try { Suppress unreferenced errors. } ``` ### 18. ファイルクローズ ファイルを確実にフラッシュするために `Flush()` と `CloseFile()` を追加します。 ```pascal:pint.dpr writeln; writeln('program complete'); CloseFile(prd); Flush(prr); CloseFile(prr); end. ``` ### 19. W1050 を消す WideChar に対して **in** 演算子を使用している箇所を `CharInSet()` で置き換えます。 ```pascal:pint.dpr // if not (ch in ['!', 'l', 'q', ' ', ':', 'o', 'g','v', 'f']) then if not CharInSet(ch, ['!', 'l', 'q', ' ', ':', 'o', 'g','v', 'f']) then ``` :::note warn 変更対象が複数あります。 ::: ### 20. W1036 を消す ローカル変数が初期化されていない箇所があるので初期化します。 ```pascal:pint.dpr p := 0; ``` :::note warn 変更対象が複数あります。 ::: ### 21. H2077 を消す 使われていない代入があるのでコメントアウトします。 ```pascal:pint.dpr // len := len; { shut up compiler check } ``` ### 22. H2164 を消す H2077 を潰すと、使われていない変数が発生するので、これもコメントアウトします。 ```pascal:pint.dpr {op: instyp;} q : address; (*instruction register*) ``` ### 23. W1021 を消す `{$WARN}` 指令を使ってワーニングを握りつぶします。 ```pascal: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()` 関数を作って処理を置き換えます。 ```pascal: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; ``` ```pascal: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; ``` ```pascal: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` を追加します。 ```pascal:pint.dpr program pcode(input,output,prd,prr); {$APPTYPE Console} {$WEAKLINKRTTI ON} {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} uses System.SysUtils, System.Math; ``` できるだけ前方に `Mod2()` 関数を記述します。 ```pascal: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()` 関数で置き換えます。 ```pascal:pint.dpr // v := v mod maxpow16; { remove digit } v := Mod2(v, maxpow16); { remove digit } ``` :::note warn 変更対象が複数あります。 ::: これで **PINT** が正しく動作するようになりました。  ## ■ 機能拡張 機能拡張に関する修正です。 ### 1. 任意の外部ファイルを扱えるようにする Pascal-P5 では標準入出力 **input** / **output** 以外では特殊なファイル **prd (入力)** **prr (出力)** しか使えません。この制約はあまりにも大きいので、任意の外部ファイルを扱えるように改変します。 PCOM で外部ファイルをエラーにしている箇所をコメントアウトします。 ```pascal: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()` でファイルを割り当てます。 ```pascal: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 終了時に外部ファイルをすべて閉じます。 ```pascal: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. ``` この拡張を行う事で任意のファイルが扱えるようになりますが、ファイル名を指定できないため、次のようなプログラムヘッダだった場合、 ```pascal program Test(Input, Output, TEMP, FIZZ, BUZZ); ``` 次のようなファイル名が割り当てられます。 | 外部ファイル | ファイル名 | |:---|:---| | TEMP | 'FILE.1' | | FIZZ | 'FILE.2' | | BUZZ | 'FILE.3' | 外部ファイルの識別子をそのままファイル名にすればよさそうに思えるかもしれませんが、Pascal-P5 はコンパイラなのです。コンパイルした時点で識別子の情報は失われます。 :::note info この拡張はオリジナルの Pascal-P5 中間ファイルと互換性を保っています。 ::: ### 2. 任意のファイル名をバインドできるようにする もっと簡単に外部ファイルを使えるようにするため、言語を拡張します。具体的にはプログラムヘッダでファイル名をバインドできるようにします。 ```pascal program Test(Input, Output, TEMP='TEMP.TXT'); ``` ファイル名のバインドは、今まで数多くの Pascal 方言が実装してきました。 - Assign() / AssignFile() - Reset() / Rewrite() の追加パラメータでファイル名を指定 - Bind() / Binding() / Unbind() でバインド これらの実装は理に適っており、ファイル名をプログラム中で任意に変更する事ができます。しかしながらその代償としてプログラムヘッダが形骸化してしまいます。 標準 Pascal では **string** 型がありませんし (標準 Pascal の任意の長さの文字列型をルーチンに渡すのは面倒)、先に示した拡張の方が Pascal の雰囲気に合っているかと思います。 PCOM で、文字列定数の認識長さを 250 文字まで拡張します。 ```pascal:pcom.dpr // varsqt = 10; { variable string quanta } varsqt = strglgth; { variable string quanta } ``` `programme()` を書き換え、中間形式ファイルに `x` コマンドを追加します。これはファイル No にファイル名を割り当てる機能です。 | コマンド | オペランド 1 | オペランド 2 | |:---|:---|:---| | x | ファイル No | ファイル名 | ```pascal: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** | ファイル名を指定した場合にはそのファイル名が、指定しなかった場合には外部ファイルの識別子がファイル名として指定されます。 ```pascal 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 にファイル名の格納場所を作ります。 ```pascal:pint.dpr filtable : array [1..maxfil] of text; { general (temp) text file holders } nfiltable : array [1..maxfil] of string; // Add ``` `generate()` を書き換えます ```pascal: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()` でファイルを割り当てます。 ```pascal: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)` のファイル名が使われます。 :::note info この拡張は外部ファイルを利用しなければオリジナルの Pascal-P5 中間ファイルと互換性を保っています。 ::: ### 3. PCOM / PINT でコマンドラインパラメータとしてファイル名を受け付けるようにする 入力ファイルと出力ファイルが `prd` / `prr` 固定というのはあまりに不便なので、コマンドラインパラメータとしてファイル名を受け付けるようにします。 ``` PCOM ``` `Pascal ソースファイル` をコマンドラインパラメータとして指定した場合にはそれを Pascal ソースファイルとみなしてコンパイルし、中間形式ファイルとして拡張子を `.p5` にしたものを出力します。 ```pascal: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 中間形式ファイルとして解釈・実行します。 ```pascal:pint.dpr begin (* main *) if ParamCount > 0 then AssignFile(prd, ParamStr(1)) else AssignFile(prd, 'prd'); AssignFile(prr, 'prr'); try ... ``` :::note info コマンドラインパラメータにファイルを指定しなかった場合には従来と同じ挙動となります。 ::: ## ■ 不具合の修正 不具合に関する修正です。 ### 1. 内部ファイルへの対応 (1) 標準 Pascal では外部ファイルに関連付けない内部ファイルが使えますが、Delphi はこれに対応していないため、外部ファイルとして対応します。 **uses** に `System.IOUtils` を追加します。 ```pascal:pint.dpr uses System.SysUtils, System.Math, System.IOUtils; ``` テンポラリファイルを外部ファイルとして割り当てます。 ```pascal: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; ``` アプリケーション終了時にテンポラリファイルを閉じるようにします。 ```pascal: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 を切り替えるには一旦ファイルをクローズしなくてはなりません。 また、このような使い方は内部ファイルでしかあり得ないので、これもテンポラリファイルとして処理します。 ```pascal: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 例えば、次のようなコードがあると、 ```pascal program BoolStr(Output); begin Writeln(1=1); end. ``` オリジナルの Pascal-P5 (GPC) では ``` True ``` と表示されますが、Delphi でビルドすると ``` TRUE ``` と表示されます。さらに幅を指定してみます。 ```pascal program BoolStr(Output); begin Writeln(1=1:3); end. ``` Pascal-P5 では ``` Tru ``` と表示されますが、Delphi では ``` TRUE ``` と表示されます。この非互換を解消するために、`WriteBool()` 手続きを用意します。 ```pascal: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 値をファイル出力している箇所を修正します。 ```pascal: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; ``` :::note info Write() / Writeln() における論理値の大文字・小文字は処理系定義となっており、どれが正解というのはありません。 『Pascal User Manual and Report』ではすべて小文字になっていますので、これに倣います。 ::: ### 4. Write() / Writeln() での Real (固定小数点) 例えば、次のようなコードがあると、 ```pascal 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()` 手続きを用意します。 ```pascal: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*) ; ``` ```pascal: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; ``` :::note info Write() / Writeln() における指数桁数は処理系定義となっており、どれが正解というのはありません。 『Pascal User Manual and Report』では 2 になっていますので、これに倣います。 ::: :::note info 同様に指数文字の大文字・小文字も処理系定義となっており、どれが正解というのはありません。 『Pascal User Manual and Report』では大文字の E になっていますので、これに倣います。 ::: ### 5. Eoln() が True の時の文字 `Eoln()` が **True** の時の文字ですが、Delphi では改行文字をそのまま返してしまうので、空白文字を返すようにします。加えて、Windows 環境で `CR (0D)` が来たら、次の 1 文字も読み飛ばすようにします。 ```pascal: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()` 手続きを用意します。 ```pascal:pint.dpr procedure AddEoln(var F: Text); begin if (TTextRec(F).BufPtr + TTextRec(F).BufPos - 1)^ <> #$0A then Writeln(F); end (*AddEoln*) ; ``` ファイルが閉じられる際に行末の状態をチェックし、行末がなければ行末を書き込みます。 ```pascal: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; ``` ```pascal: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 でコンパイルできるようにソースコードを改変した時点でセルフコンパイルは望めないので、セルフコンパイル用の不要なコードを削除します。 ```pascal:pcom.dpr // { !!! remove this statement for self compile } //{$IFNDEF SELF_COMPILE} prd,prr: text; { output code file } //{$ENDIF} ``` ```pascal:pcom.dpr // { !!! remove these statements for self compile } //{$IFNDEF SELF_COMPILE} reset(prd); rewrite(prr); { open output file } //{$ENDIF} ``` ```pascal: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} ``` ```pascal:pint.dpr // { !!! remove this next statement for self compile } //{$IFNDEF SELF_COMPILE} prd,prr : text; (*prd for read only, prr for write only *) //{$ENDIF} ``` ```pascal:pint.dpr // { !!! remove this next statement for self compile } //{$IFNDEF SELF_COMPILE} reset(prd); //{$ENDIF} ``` ```pascal:pint.dpr // { !!! remove this next statement for self compile } //{$IFNDEF SELF_COMPILE} rewrite(prr); //{$ENDIF} ``` ### 2. 文字配列の縮小 Unicode 版 Delphi の Char は WideChar なため、`array [Char] of` のような定義は無駄に大きい配列を確保します。 部分範囲型 `subchar` を定義して、 ```pascal:pcom.dpr { Subrange char } subchar = Chr(ordminchar)..Chr(ordmaxchar); (*-------------------------------------------------------------------------*) var ``` `[char]` を `[subchar]` に置き換えます。 ```pascal: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 ではエラーにならないようです。 ```pascal: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; ``` ```pascal: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()` の二番目の書式を使わないようにしたため、冗長な記述になっている箇所があります。 ```pascal: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; ``` ```pascal: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; ``` ```pascal: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 終了時にテンポラリファイルを削除するようにします。 ```pascal:pint.dpr majorver = 1; { major version number } minorver = 3; { minor version number } experiment = false; { is version experimental? } p5temp = 'P5TMP'; // 追加 ``` `RemoveTempFile()` 手続きを実装します。 ```pascal: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` を使って指定します。 ```pascal: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])) ``` 終了時にテンポラリファイルを削除するようにします。 ```pascal:pint.dpr CloseFile(prd); Flush(prr); CloseFile(prr); RemoveTempFile; // 追加 end. ``` :::note info ウィルス対策ソフトが反応して、すべてのテンポラリファイルが消えない事があります。 ::: # おわりに やはり v1.3 よりも修正箇所が増えました。改変したソースファイル一式は [GitHub にアップしてあります](https://github.com/ht-deko/Pascal-P5)。 プラットフォームに固有の機能は使っていないので、macOS 用や Linux 用としてもビルド可能だと思います。 GitHub の `source` フォルダにある `pcom.dpr` と `pint.dpr` は v1.4 のものですが、`mod 1.3` サブフォルダのファイルを上書きして v1.3 をビルドする事もできます。 **See also:** - [Pascal-P5 (GitHub: @ht-deko)](https://github.com/ht-deko/Pascal-P5) - [P_IDE (GitHub: @ht-deko)](https://github.com/ht-deko/P_IDE/) [^1]: 64bit 環境用のパラメータが設定されないだけで、ビルドは成功します。