# Delphi で Pascal-P5 v1.3 をビルドする --- tags: Delphi programming Pascal embarcadero objectpascal created_at: 2022-01-16 updated_at: 2022-01-27 --- # はじめに 標準 Pascal に準拠した **Pascal-P5** を使う方法や、ビルドする方法についての記事を以前書きました。 - [割と簡単に '標準 Pascal' を試してみたい (Qiita)](./41e95154e8da2f901698.md) Delphi でコンパイルする方法が書いてなかったのは、**Pascal-P5** のソースコードは標準 Pascal に準拠したコンパイラでしかコンパイルできないためです。移植するために致命的だと思われたのは、Delphi にはバッファ変数のサポート (ファイルポインタを進めずに 1 文字読む) がない事でした。 - [Delphi と標準 Pascal の比較 (標準 Pascal コードを Delphi に移植する際の注意点) (Qiita)](./a13d6459227e787422ae.md) ところが、ひょんな事からバッファ変数の代替機能を作れる事が判明したため、Delphi でコンパイルできるように **Pascal-P5** のソースコードを改変してみようという事になりました。 ![image.png](./images/e9102019-fcd8-7617-6ab9-a693c707a53d.png) # 改変 使うのは Pascal-P5 **バージョン 1.3** のソースコードです。もう既に DL できないようだったので、私のサイトでアーカイブをミラーしています。 - [https://ht-deko.com/software/pascal-p5.tar.gz](https://ht-deko.com/software/pascal-p5.tar.gz) アーカイブを解凍したら、`source` サブフォルダにある `pcom.pas` と `pint.pas` をそれぞれ `pcom.dpr` `pint.dpr` にリネームし、コンソールアプリケーションのプロジェクトファイルとして Delphi IDE に読み込めるようにしておきます。 ![image.png](./images/745dadbb-93f6-3347-4275-d246f81aa472.png) Delphi は **11.0 Alexandria** を使っていますが、無償の **Community Edition** でもコンパイルできると思います。新しい機能はほぼ使っていないので、Delphi 2009 以降の Unicode 版 Delphi であれば普通にコンパイルできると思います (**uses** に追加したユニットの名前空間だけ注意)。 **See also:** - [Delphi Community Edition (Embarcadero)](https://www.embarcadero.com/jp/products/delphi/starter) ## ■ PCOM そのまま Delphi でコンパイルすると 30 件のコンパイルエラーと 4 件の警告が出ます。 ![image.png](./images/95779774-5658-556c-fb7f-e2bd5e35ebd0.png) ### 1. コンパイラ指令の削除 先頭のコンパイラ指令を削除します。 ```pascal:pcom.dpr //(*$c+,t-,d-,l-*) {******************************************************************************* * * * Portable Pascal assembler/interpreter * * ************************************* * ... *******************************************************************************} ``` ### 2. コンソールアプリケーションの指定 `{$APPTYPE Console}` を追記して、コンソールアプリケーションであることを明示します。RTTI も使わない設定にします。 ```pascal:pcom.dpr program pascalcompiler(output,prd,prr); {$APPTYPE Console} {$WEAKLINKRTTI ON} {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} ``` ### 3. 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 cipcnt <> 0 then writeln('*** Error: Compiler internal error: case recycle balance: ', cipcnt: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; ``` **See also:** - [2. goto の扱い - Delphi と標準 Pascal の比較 (標準 Pascal コードを Delphi に移植する際の注意点) (Qiita)](./a13d6459227e787422ae.md#2-goto-%E3%81%AE%E6%89%B1%E3%81%84) - [Delphi で多重ループを抜ける方法 (Qiita)](./ec4963f6d6ade3db8734.md#%E3%81%AF%E3%81%98%E3%82%81%E3%81%AB) - [System.SysUtils.Abort (DocWiki)](https://docwiki.embarcadero.com/Libraries/Sydney/ja/System.SysUtils.Abort) ### 4. 識別子 string の変更 (1) `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*) label 1; var i,k: integer; digit: nmstr; { temp holding for digit string } rvalb: nmstr; { temp holding for real string } // string: csstr; passtr: csstr; lvp: csp; test, ferr: boolean; iscmte: boolean; ev: integer; ``` ```pascal:pcom.dpr chstrquo: begin lgth := 0; sy := stringconst; op := noop; // for i := 1 to strglgth do string[i] := ' '; for i := 1 to strglgth do passtr[i] := ' '; repeat repeat nextch; lgth := lgth + 1; // if lgth <= strglgth then string[lgth] := ch if lgth <= strglgth then passtr[lgth] := ch until (eol) or (ch = ''''); if eol then error(202) else nextch until ch <> ''''; // string[lgth] := ' '; { get rid of trailing quote } passtr[lgth] := ' '; { get rid of trailing quote } lgth := lgth - 1; (*now lgth = nr of chars in passtr*) // if lgth = 1 then val.ival := ord(string[1]) if lgth = 1 then val.ival := ord(passtr[1]) else begin if lgth = 0 then error(205); new(lvp,strg); pshcst(lvp); lvp^.cclass:=strg; if lgth > strglgth then begin error(399); lgth := strglgth end; with lvp^ do // begin slgth := lgth; strassvc(sval, string, strglgth) end; begin slgth := lgth; strassvc(sval, passtr, strglgth) end; val.valp := lvp end end; ``` ### 5. 識別子 string の変更 (2) `string()` という名前の関数がありますので、これを `_string()` に置換します。 ```pascal:pcom.dpr //function string(fsp: stp) : boolean; forward; function _string(fsp: stp) : boolean; forward; ``` ```pascal:pcom.dpr // function string; function _string; var fmin, fmax: integer; // begin string := false; begin _string := false; if fsp <> nil then if fsp^.form = arrays then if fsp^.packing then begin { if the index is nil, either the array is a string constant or the index type was in error. Either way, we call it a string } if fsp^.inxtype = nil then fmin := 1 else getbounds(fsp^.inxtype,fmin,fmax); // if comptypes(fsp^.aeltype,charptr) and (fmin = 1) then string := true if comptypes(fsp^.aeltype,charptr) and (fmin = 1) then _string := true end // end (*string*) ; end (*_string*) ; ``` 関数を使っている所も置換します。 ```pascal:pcom.dpr { Arrays are compatible if they are string types and equal in size } // arrays: comptypes := string(fsp1) and string(fsp2) and arrays: comptypes := _string(fsp1) and _string(fsp2) and (fsp1^.size = fsp2^.size ); ``` :::note warn 変更対象が複数あります。 ::: ### 6. バッファ変数の置換 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*) ; procedure insymbol; (*read next basic symbol of source program and return its description in the global variables sy, op, id, val and lgth*) ``` バッファ変数を使っている箇所を `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; // if ((ch = '.') and (prd^ <> '.') and (prd^ <> ')')) or if ((ch = '.') and (CurrentChar(prd) <> '.') and (CurrentChar(prd) <> ')')) or (lcase(ch) = 'e') then ``` :::note warn 変更対象が複数あります。 ::: **See also:** - [3. バッファ変数と Get() / Put() - Delphi と標準 Pascal の比較 (標準 Pascal コードを Delphi に移植する際の注意点) (Qiita)](./a13d6459227e787422ae.md#3-%E3%83%90%E3%83%83%E3%83%95%E3%82%A1%E5%A4%89%E6%95%B0%E3%81%A8-get--put) ### 7. New() 関数の二番目の書式 New() 関数の二番目の書式を使っている箇所を変更します。二番目以降のパラメータを削除するだけです。 ```pascal:pcom.dpr // new(lvp,reel); pshcst(lvp); sy:= realconst; new(lvp); pshcst(lvp); sy:= realconst; ``` :::note warn 変更対象が複数あります。 ::: **See also:** - [4. New() / Dispose() の二番目の書式 - Delphi と標準 Pascal の比較 (標準 Pascal コードを Delphi に移植する際の注意点) (Qiita)](./a13d6459227e787422ae.md#4-new--dispose-%E3%81%AE%E4%BA%8C%E7%95%AA%E7%9B%AE%E3%81%AE%E6%9B%B8%E5%BC%8F) ### 8. Write() / Writeln() の書式 `write()` / `writeln()` に Pascal 文字列を渡している所があるので、Delphi の長い文字列に変換します。 ```pascal:pcom.dpr // ident: write('ident: ', id:10); ident: write('ident: ', string(id):10); ``` :::note warn 変更対象が複数あります。 ::: **See also:** - [6.2. 文字配列 (標準 Pascal の文字列型) - <6> 構造化型の概要と配列型 (標準 Pascal 範囲内での Delphi 入門) (Qiita)](./eedda6d38b6d0887d4ac.md#62-%E6%96%87%E5%AD%97%E9%85%8D%E5%88%97-%E6%A8%99%E6%BA%96-pascal-%E3%81%AE%E6%96%87%E5%AD%97%E5%88%97%E5%9E%8B) ### 9. ファイルアサイン ここまでの変更でコンパイルは通るようになったと思いますが、まだ正しく動作はしません。 '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. } ``` ### 10. ファイルクローズ ファイルを確実にフラッシュするために `Flush()` と `CloseFile()` を追加します。 ```pascal:pcom.dpr //99: except on E: EAbort do ; end; CloseFile(prd); Flush(prr); CloseFile(prr); end. ``` ### 11. 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 変更対象が複数あります。 ::: ### 12. W1036 を消す ローカル変数が初期化されていない箇所があるので初期化します。 ```pascal:pcom.dpr lp := nil; ``` :::note warn 変更対象が複数あります。 ::: ### 13. H2077 を消す 使われていない代入があるのでブロックコメントでコメントアウトします。 ```pascal:pcom.dpr if not(lsp^.form in[scalar,subrange,pointer]) then begin error(120); {lsp := nil} end; ``` :::note warn 変更対象が複数あります。 ::: ### 14. H2164 を消す H2077 を潰すと、使われていない変数が発生するので、これもブロックコメントでコメントアウトします。 ```pascal:pcom.dpr var lsp,lsp1,lsp2: stp; {varts: integer;} ``` これでヒントも警告もなくなりました。 ![image.png](./images/0de9d157-95c0-e84f-d29b-8ee5d344da7a.png) ### 15. 改行コードの問題を解決する 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; ``` ### 16. ピリオドの判定を解決する 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; ``` ### 17. 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** は正しく動作するようになりました。 ![image.png](./images/fa12f95e-5d69-9b19-b0cc-c5974ed5b12d.png) - [<2> データの概念: 単純型 (標準 Pascal 範囲内での Delphi 入門)〔裏〕(Qiita)](./e36898d7aa4bb3300f78.md#%E5%89%B0%E4%BD%99%E6%BC%94%E7%AE%97%E5%AD%90%E3%81%AB%E3%81%A4%E3%81%84%E3%81%A6) ## ■ PINT そのまま Delphi でコンパイルすると 93 件のコンパイルエラーと 7 件の警告が出ます。エラーが多すぎてコンパイルが打ち切られます。 ![image.png](./images/98c684db-7cc9-01c4-e09b-efc2ef50aa5c.png) ### 1. コンパイラ指令の削除 先頭のコンパイラ指令を削除します。 ```pascal:pint.dpr //(*$c+,t-,d-,l-*) {******************************************************************************* * * * Portable Pascal compiler * * ************************ * ... *******************************************************************************} ``` ### 2. コンソールアプリケーションの指定 `{$APPTYPE Console}` を追記して、コンソールアプリケーションであることを明示します。RTTI も使わない設定にします。 ```pascal:pint.dpr program pcode(input,output,prd,prr); {$APPTYPE Console} {$WEAKLINKRTTI ON} {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} ``` ### 3. 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*) ``` ### 4. 識別子 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*) ``` ### 5. Write() / Writeln() の書式 `write()` / `writeln()` に Pascal 文字列を渡している所があるので、Delphi の長い文字列に変換します。 ```pascal:pint.dpr // write(' ', instr[op]:10, ' '); write(' ', string(instr[op]):10, ' '); ``` :::note warn 変更対象が複数あります。 ::: ### 6. Pack の削除 Delphi には `Pack()` がないので削除します。ここでの処理は `word -> name` のコピーなので、`Move()` 手続きで代替します。 ```pascal:pint.dpr // pack(word,1,name) Move(word, name, SizeOf(name)); ``` **See also:** - [6.3. パックとアンパック - <6> 構造化型の概要と配列型 (Qiita)](./eedda6d38b6d0887d4ac.md#63-%E3%83%91%E3%83%83%E3%82%AF%E3%81%A8%E3%82%A2%E3%83%B3%E3%83%91%E3%83%83%E3%82%AF) - [5. Pack() / Unpack() - Delphi と標準 Pascal の比較 (標準 Pascal コードを Delphi に移植する際の注意点) (Qiita)](./a13d6459227e787422ae.md#5-pack--unpack) - [System.Move (DocWiki)](http://docwiki.embarcadero.com/Libraries/ja/System.Move) ### 7. バッファ変数の置換 Delphi にはバッファ変数がありませんので、`CurrentChar() `関数を用意します。`load()` 手続きよりも前に追加してください。 ```pascal:pint.dpr ... (*--------------------------------------------------------------------*) function CurrentChar(var F: Text): WideChar; begin result := WideChar((TTextRec(F).BufPtr + TTextRec(F).BufPos)^); end (*CurrentChar*) ; { load intermediate file } procedure load; ``` バッファ変数を使っている箇所を `CurrentChar()` で置換します。 ```pascal:pint.dpr // c := ch; if (ch = '''') and (prd^ = '''') then begin c := ch; if (ch = '''') and (CurrentChar(prd) = '''') then begin ``` :::note warn 変更対象が複数あります。 ::: ### 8. Get() の追加 Delphi には `Get()` がありませんので、同等の関数を追加します。 ```pascal:pint.dpr {$HINTS OFF} procedure Get(var F: Text); var ch: Char; begin Read(F, ch); end (*Get*) ; {$HINTS ON} ``` **See also:** - [3. バッファ変数と Get() / Put() - Delphi と標準 Pascal の比較 (標準 Pascal コードを Delphi に移植する際の注意点) (Qiita)](./a13d6459227e787422ae.md#3-%E3%83%90%E3%83%83%E3%83%95%E3%82%A1%E5%A4%89%E6%95%B0%E3%81%A8-get--put) ### 9. Page() の追加 Delphi には `Page()` 手続きがありませんので、同等の関数を追加します。 ```pascal:pint.dpr procedure Page(var F: Text); begin Write(F, #$0C); end (*Page*) ; ``` **See also:** - [(11. Page()) - Delphi と標準 Pascal の比較 (標準 Pascal コードを Delphi に移植する際の注意点) (Qiita)](./a13d6459227e787422ae.md#11-page) - [12.4. 手続き Page() - <12> テキストファイルの入出力 (標準 Pascal 範囲内での Delphi 入門) (Qiita)](./391d6c1a53c7aaa3416f.md#124-%E6%89%8B%E7%B6%9A%E3%81%8D-page) ### 10. 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*) ``` **See also:** - [3. バッファ変数と Get() / Put() - Delphi と標準 Pascal の比較 (標準 Pascal コードを Delphi に移植する際の注意点) (Qiita)](./a13d6459227e787422ae.md#3-%E3%83%90%E3%83%83%E3%83%95%E3%82%A1%E5%A4%89%E6%95%B0%E3%81%A8-get--put) ### 11. ファイルアサイン ここまでの変更でコンパイルは通るようになったと思いますが、まだ正しく動作はしません。 ![image.png](./images/002ee5de-9fde-d88f-a907-ceaa6114d29a.png) 'prd' を外部ファイル `prd` に、'prr' を外部ファイル `prr` に関連付けるよう、メインブロックの先頭に `AssignFile()` を追加します。 ```pascal:pint.dpr ... begin (* main *) AssignFile(prd, 'prd'); AssignFile(prr, 'prr'); try { Suppress unreferenced errors. } ``` ### 12. ファイルクローズ ファイルを確実にフラッシュするために `Flush()` と `CloseFile()` を追加します。 ```pascal:pint.dpr writeln; writeln('program complete'); CloseFile(prd); Flush(prr); CloseFile(prr); end. ``` ### 13. W1050 を消す WideChar に対して **in** 演算子を使用している箇所を `CharInSet()` で置き換えます。 ```pascal:pint.dpr // if not (ch in ['i', 'l', 'q', ' ', ':', 'o', 'g']) then if not CharInSet(ch, ['i', 'l', 'q', ' ', ':', 'o', 'g']) then ``` :::note warn 変更対象が複数あります。 ::: ### 14. W1036 を消す ローカル変数が初期化されていない箇所があるので初期化します。 ```pascal:pint.dpr lp := nil; ``` :::note warn 変更対象が複数あります。 ::: ### 15. H2077 を消す 使われていない代入があるのでコメントアウトします。 ```pascal:pint.dpr // len := len; { shut up compiler check } ``` ### 16. 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 intdig = 0 then; if markfv = 0 then; if maxresult = 0 then; if ordminchar = 0 then; if ordmaxchar = 0 then; if stackelsize = 0 then; {$WARN COMPARISON_FALSE ON} ``` これでヒントも警告もなくなりました。 ![image.png](./images/dc2c8ac1-4c7b-f017-02a0-bddccb11574d.png) ### 17. 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 GetNum(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 'i': 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 // begin read(prd,s1); getnxt; s := s + [s1] begin s1 := ReadNum(prd); getnxt; s := s + [s1] ``` ### 18. 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 268435456; { remove digit } v := Mod2(v, 268435456); { remove digit } ``` :::note warn 変更対象が複数あります。 ::: これで **PINT** が正しく動作するようになりました。 ![image.png](./images/e92b7cc7-91d8-a999-57e2-5b0ed3df174b.png) ## ■ 機能拡張 機能拡張に関する修正です。 ### 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 中間ファイルと互換性を保っています。 ::: **See also:** - [9.1 ファイル構造 - <9> ファイル型 (標準 Pascal 範囲内での Delphi 入門) (Qiita)](./986fa01c9e6cfc3fd673.md#91-%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E6%A7%8B%E9%80%A0) - [9.1 ファイル構造 - <9> ファイル型 (標準 Pascal 範囲内での Delphi 入門)〔裏〕(Qiita)](./0e012da26f46b915307d.md#91-%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E6%A7%8B%E9%80%A0) ### 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; // Add 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); 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; // Del if not ( sy in [comma,rparent] ) then error(20) { Add begin } if not ( sy in [comma,rparent,relop] ) then error(20) else if sy = relop then begin insymbol; if sy <> stringconst then error(31) 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 error(2) until sy <> comma; if sy <> rparent then error(4); insymbol; if sy <> semicolon then error(14) 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 *) again: boolean; ch1: char; 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 '); ... 'g': begin read(prd,gbsiz); gbset := true; 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. 文字配列の縮小 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; ``` ### 2. コンパイラを騙すためのコードの削除 「参照されていない」というエラーを出さないようにするためのコードがあるので、これを削除します。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 markep = 0 then; // if markdl = 0 then; // if markra = 0 then; // if marksb = 0 then; // if markfv = 0 then; // if marksl = 0 then; // if maxresult = 0 then; // if maxsize = 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 intdig = 0 then; // if markfv = 0 then; // if maxresult = 0 then; // if ordminchar = 0 then; // if ordmaxchar = 0 then; // if stackelsize = 0 then; // {$WARN COMPARISON_FALSE ON} ``` ## ■ 不具合の修正 不具合に関する修正です。 ### 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. ``` **See also:** - [9. 内部ファイル - Delphi と標準 Pascal の比較 (標準 Pascal コードを Delphi に移植する際の注意点) (Qiita)](./a13d6459227e787422ae.md#9-%E5%86%85%E9%83%A8%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB) ### 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』ではすべて小文字になっていますので、これに倣います。 ::: **See also:** - [10. 論理値の Write() における大文字・小文字の別 - Delphi における Pascal の処理系定義 (Qiita)](./2b7cab95ffc60de10c25.md#10-%E8%AB%96%E7%90%86%E5%80%A4%E3%81%AE-write-%E3%81%AB%E3%81%8A%E3%81%91%E3%82%8B%E5%A4%A7%E6%96%87%E5%AD%97%E5%B0%8F%E6%96%87%E5%AD%97%E3%81%AE%E5%88%A5) ### 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 になっていますので、これに倣います。 ::: **See also:** - [8. 実数の Write() における ExpDigits の値 - Delphi における Pascal の処理系定義 (Qiita)](./2b7cab95ffc60de10c25.md#8-%E5%AE%9F%E6%95%B0%E3%81%AE-write-%E3%81%AB%E3%81%8A%E3%81%91%E3%82%8B-expdigits-%E3%81%AE%E5%80%A4) - [9. 実数の Write() における指数表現文字の大文字・小文字の別 - Delphi における Pascal の処理系定義 (Qiita)](./2b7cab95ffc60de10c25.md#9-%E5%AE%9F%E6%95%B0%E3%81%AE-write-%E3%81%AB%E3%81%8A%E3%81%91%E3%82%8B%E6%8C%87%E6%95%B0%E8%A1%A8%E7%8F%BE%E6%96%87%E5%AD%97%E3%81%AE%E5%A4%A7%E6%96%87%E5%AD%97%E5%B0%8F%E6%96%87%E5%AD%97%E3%81%AE%E5%88%A5) ### 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*) ``` **See also:** - [7. eoln() が True の場合の文字 - Delphi と標準 Pascal の比較 (標準 Pascal コードを Delphi に移植する際の注意点) (Qiita)](./a13d6459227e787422ae.md#7-eoln-%E3%81%8C-true-%E3%81%AE%E5%A0%B4%E5%90%88%E3%81%AE%E6%96%87%E5%AD%97) ### 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. ``` **See also:** - [(13. テキストファイルでの Write と Writeln) - Delphi と標準 Pascal の比較 (標準 Pascal コードを Delphi に移植する際の注意点) (Qiita)](./a13d6459227e787422ae.md#13-%E3%83%86%E3%82%AD%E3%82%B9%E3%83%88%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E3%81%A7%E3%81%AE-write-%E3%81%A8-writeln) # おわりに 割と大掛かりな修正になってしまいました。改変したソースファイル一式は [GitHub にアップしてあります](https://github.com/ht-deko/Pascal-P5)。 プラットフォームに固有の機能は使っていないので、macOS 用や Linux 用としてもビルド可能だと思います。 **追記:** v1.4 もビルドできるようになりました。 - [Delphi で Pascal-P5 v 1.4 をビルドする (Qiita)](./0a3a4a7613aa1b6c5296.md) **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/)