Delphi で Pascal-P5 v1.3 をビルドする

# はじめに
標準 Pascal に準拠した **Pascal-P5** を使う方法や、ビルドする方法についての記事を以前書きました。

 - [割と簡単に '標準 Pascal' を試してみたい (Qiita)](https://qiita.com/ht_deko/items/41e95154e8da2f901698)

Delphi でコンパイルする方法が書いてなかったのは、**Pascal-P5** のソースコードは標準 Pascal に準拠したコンパイラでしかコンパイルできないためです。移植するために致命的だと思われたのは、Delphi にはバッファ変数のサポート (ファイルポインタを進めずに 1 文字読む) がない事でした。

 - [Delphi と標準 Pascal の比較 (標準 Pascal コードを Delphi に移植する際の注意点) (Qiita)](https://qiita.com/ht_deko/items/a13d6459227e787422ae)

ところが、ひょんな事からバッファ変数の代替機能を作れる事が判明したため、Delphi でコンパイルできるように **Pascal-P5** のソースコードを改変してみようという事になりました。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/21785/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](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/21785/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](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/21785/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)](https://qiita.com/ht_deko/items/a13d6459227e787422ae#2-goto-%E3%81%AE%E6%89%B1%E3%81%84)
 - [Delphi で多重ループを抜ける方法 (Qiita)](https://qiita.com/ht_deko/items/ec4963f6d6ade3db8734#%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)](https://qiita.com/ht_deko/items/a13d6459227e787422ae#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)](https://qiita.com/ht_deko/items/a13d6459227e787422ae#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)](https://qiita.com/ht_deko/items/eedda6d38b6d0887d4ac#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](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/21785/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](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/21785/fa12f95e-5d69-9b19-b0cc-c5974ed5b12d.png)

 - [<2> データの概念: 単純型 (標準 Pascal 範囲内での Delphi 入門)〔裏〕(Qiita)](https://qiita.com/ht_deko/items/e36898d7aa4bb3300f78#%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](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/21785/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)](https://qiita.com/ht_deko/items/eedda6d38b6d0887d4ac#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)](https://qiita.com/ht_deko/items/a13d6459227e787422ae#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)](https://qiita.com/ht_deko/items/a13d6459227e787422ae#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)](https://qiita.com/ht_deko/items/a13d6459227e787422ae#11-page)
 - [12.4. 手続き Page() - <12> テキストファイルの入出力 (標準 Pascal 範囲内での Delphi 入門) (Qiita)](https://qiita.com/ht_deko/items/391d6c1a53c7aaa3416f#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)](https://qiita.com/ht_deko/items/a13d6459227e787422ae#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](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/21785/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](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/21785/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](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/21785/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)](https://qiita.com/ht_deko/items/986fa01c9e6cfc3fd673#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)](https://qiita.com/ht_deko/items/0e012da26f46b915307d#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 ソースファイル (*.pas)>
```

`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.
```

**See also:**

 - [9. 内部ファイル - Delphi と標準 Pascal の比較 (標準 Pascal コードを Delphi に移植する際の注意点) (Qiita)](https://qiita.com/ht_deko/items/a13d6459227e787422ae#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)](https://qiita.com/ht_deko/items/2b7cab95ffc60de10c25#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)](https://qiita.com/ht_deko/items/2b7cab95ffc60de10c25#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)](https://qiita.com/ht_deko/items/2b7cab95ffc60de10c25#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)](https://qiita.com/ht_deko/items/a13d6459227e787422ae#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)](https://qiita.com/ht_deko/items/a13d6459227e787422ae#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)

## ■ チューニング

チューニングに関する修正です。

### 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}
```

### 3. テンポラリファイルの削除
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.
```

# おわりに

割と大掛かりな修正になってしまいました。改変したソースファイル一式は [GitHub にアップしてあります](https://github.com/ht-deko/Pascal-P5)。

プラットフォームに固有の機能は使っていないので、macOS 用や Linux 用としてもビルド可能だと思います。

**追記:**
v1.4 もビルドできるようになりました。

 - [Delphi で Pascal-P5 v 1.4 をビルドする (Qiita)](https://qiita.com/ht_deko/items/0a3a4a7613aa1b6c5296)

**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/)