PascalScritに SAR演算子 を追加する

記事
IT・テクノロジー
私はwindowsの開発ツールでDelphiが好きでした。C系も書けますが、私は性格がいい加減なのでC系統だと他人に読めないどころか後から自分でも分からないコードを作ってしまいます。Pascalだと型に厳格で書き方に多様性が少ない分、内容に拘れるとも言えます。動けば良いという感覚で書いても後からある程度は読めますから。
ただPascalの唯一の欠点は SAR演算子が無いことです。 C言語のシフト演算なら符号付きの場合SARをしてくれるのにと、何度も思いました。

何故 SAR が欲しいのか
-1 SHR 1 の結果は予想出来るでしょうか?  正の最大数になります。
まあそれを利用してintサイズを知るという事も出来るのですが
C言語なら -1>>1 は -1 ですし -2>> 1も-!です

SAR演算が昔は 整数除算の DIV で代用出来ました。
x SHR 1を x DIV 2と書けたのです コンパイラが DIV 2を SAR 1 と変換してくれたのです。ところが何時のころからか DIVで代用出来なくなりました。
今の時代は -1 DIV 2 は 0になるのです。 何が問題なのかというと、
-3,-2,-1,0,1,2,3 を
   DIV 2すると -1,-1, 0, 0, 0, 1, 1
   SAR 1すると -2,-1, -1, 0, 0, 1, 1 
 アセンブラとかCで書いたデジタルフィルタとは DIV 2で代用すると期待してるより振幅が小さくなってしまうのです。シミュレータとして無視出来ない問題です。


さて、Lazarusに組み込まれているPascalScript ソースが付いています。これは 長年のモヤモヤを解決するチャンス。 やってみましょう。
組み込まれている SHR 演算子の処理を探して追加すればよいので大きな変更にはならない目算もあります。

1,最初に "'SHR'" を全ファイルから検索する

  lazarus\components\pascalscript\Source\ を検索します
  検索→ファイルの中を検索か 外部ツールとしては K2Grep.exe等
  検索文字列として "SHR"でなく "'SHR'"で検索します
  そうすると2つhitします
    uPSDisassembly.pas 6: s:= 'SHR';
    uPSUtils.pas (name: 'SHR'; c: CSTII_shr),
 最初のファイルの前後を見ると バイトコードでCM_CAの次のバイトが6であればSHR演算です
 そしてパーサーでshr を見つけた時の識別子が CSTII_shrです

2, "CM_CA" を全ファイルから検索する

    1 uPSCompiler.pas(): BlockWriteByte(BlockInfo, Cm_CA);
    2 uPSDisassembly.pas(): CM_CA:
    3 uPSRuntime.pas():procedure P_CM_CA; begin end;
    4 uPSRuntime.pas(): CM_CA:
    5 uPSUtils.pas(): CM_CA = 1;
   この4、5番目のコメントからCM_CAの次のバイトはCalcType
  CalcTypeには 0~9が使われており 6がSHRのようです
    CalcTypeはuPSRuntimeでは列挙型でなく数値が直接使われています
    調べてみるとuPSRuntime側で TPSBinOperatorTypeをOrd()関数で数値にしています
    だから CalcTypeに10で追加するのは危険です。
    そこで 36をSARのCalcTypeに割り当てましょう(数字は適当)
    if BVal.Operator >= otGreaterEqual then
    と問題になりそうな行も見つかりました

3, CalcTypeに36を追加

  uPSDisassembly.pas
         6: s:= 'SHR';
36: s:= 'SAR';{追加行}
         7: s:= 'AND';
  uPSRuntime.pas の unction TPSExec.DoCalc(
         6: begin { SHR } ~ end; (7:の行の前まで)をcopyしてpast
        36: begin { SAR } とpast先を変更します。
   SARという演算があれば無いので関数化します shr演算子のある行の内 左辺が符号付の場合が
         btS8: tbtS8(var1^) := tbtS8(var1^) shr PSGetUInt(Var2, var2type);
                                ↓ ↓ ↓
         btS8: tbts8(var1^) := sar(tbts8(var1^) , PSGetInt(Var2, var2type) );
    のように8行あるので内5行を変更してゆきます
        符号無しの整数に符号付シフトというのが、そもそもエラーですけどね
    36: begin { SAR }
           case var1Type.BaseType of
             btU8: tbtU8(var1^) := tbtU8(var1^) shr PSGetUInt(Var2, var2type);
             btS8: tbts8(var1^) := sar(tbts8(var1^) , PSGetInt(Var2, var2type) );
             btU16: tbtU16(var1^) := tbtU16(var1^) shr PSGetUInt(Var2, var2type);
             btS16: tbts16(var1^) := sar(tbts16(var1^) , PSGetInt(Var2, var2type) );
             btU32: tbtU32(var1^) := tbtU32(var1^) shr PSGetUInt(Var2, var2type);
             btS32: tbts32(var1^) := sar(tbts32(var1^) , PSGetInt(Var2, var2type) );
            {$IFNDEF PS_NOINT64}
             btS64: tbts64(var1^) := sar(tbts64(var1^) , PSGetInt64(var2, var2type) );
            {$ENDIF}
             btVariant:
               begin
                 if not IntPIFVariantToVariant(var2, var2type, tvar) then
                 begin
                   Result := false;
                 end else
                   Variant(var1^) := sar(Variant(var1^) , tvar);
               end;

4, function SAR(s:Int64 ; sft:byte):int64; を追加

  仕様として shrは負数でもshlにはならないので型別に作らなくても自動的な型変換で問題ないです
  SAR関数を必要とするのは( uPSDisassembly.pasとuPSCompiler.pas)です
  記載場所は 共通でusesされる  uPSUtils.pasが適当でしょう
       function SAR(s:Int64 ; sft:byte):int64;
       begin
         asm
           mov s,%RAX;
           mov sft,%CL ;//シフト回数が指定出来るのはCLのみ
           sar %CL,%RAX;
         end['RAX'];
       end;
インラインアセンブラを使っています。インラインアセンブラの簡単な説明はhttps://coconala.com/blogs/2753232/264052

5,ここまでで変更ミスが無いか一度コンパイルしてみましょう。

   LazarusMenu-パッケージ→パッケージを開く で PascalScriptを選びます
   開いた窓の上に並ぶボタンの左から2番目[コンパイル]です

5,全体を"CSTII_shr"で検索します

   uPSCompiler.pasとuPSUtils.pasに見つかります
    CSTII_shrの定義場所を検索します (マウスの右ボタンの一番上が楽)

6,"CSTII_sar"を追加します

    追加場所は CSTII_shrの定義場所の下です(uPSUtils.pasにあります)
    CSTII_shr,
  CSTII_sar,{追加行}
    CSTII_then,
    もう一か所は最後に追加しましょう

7,uPSCompiler.pas から "otshr" を検索します

 検索->ファイル検索で検索すると便利
    5行見つかりました
     1 TPSBinOperatorType = (otAdd, otSub, otMul, otDiv, otMod, otShl, otShr, otAnd, ot...
     2 otshr:
     3 otMod, otShl, otShr: {mod,shl,shr}
     4 CSTII_shr: Op := otShr;
     5 CSTII_shr: Op := otShr;

    1,2を後にしてotShrを追加してゆきます
   3 otMod, otShl, otShr: {mod,shl,shr}
    otMod, otShl, otShr, otSar: {mod,shl,shr}
    4 CSTII_shr: Op := otShr;
CSTII_sar: Op := otSar; {行追加}
    5 CSTII_shr: Op := otShr;
  CSTII_sar: Op := otSar; {行追加}

    2 otshr:
        これはコンパイル時に双方が数値なら先に計算してしまおうという事のようですから
        左辺が符号付きの行だけ SARに変更します"otsar:"の行から"otAnd:"の手前までをcopy&貼付
        複製した行を
    otsar:
     begin { SAR }
     case Var1.FType.BaseType of
     btU8: var1^.tu8 := var1^.tu8 shr GetUint(Var2, Result);
     btS8: var1^.ts8 := SAR(var1^.ts8 , Getint(Var2, Result));
     btU16: var1^.tu16 := var1^.tu16 shr GetUint(Var2, Result);
     btS16: var1^.ts16 := SAR(var1^.ts16 , Getint(Var2, Result));
     btU32: var1^.tu32 := var1^.tu32 shr GetUint(Var2, Result);
     btS32: var1^.ts32 := SAR(var1^.ts32 , Getint(Var2, Result));
     {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := SAR( var1^.ts64 , GetInt64( Var2, Result)); {$ENDIF}
     else Result := False;
     end;
     end;
   1 TPSBinOperatorType = (otAdd, otSub, otMul, otDiv, otMod, otShl, otShr, ...
         2行後の最後に追加
          元 otNotEqual, otIs, otIn);
          加 otNotEqual, otIs, otIn,otSar=36);
7, uPSCompiler.pasで追加したotSarで問題になりそうな行を修正します
 元 if BVal.Operator >= otGreaterEqual then {otSarが含まれてしまいますから}
if BVal.Operator in [otGreaterEqual..otIn] then

8,uPSCompiler.pas から "CSTII_shr" を検索します 

検索->ファイル検索で検索すると便利
   while FParser.CurrTokenID in [.. の行が2行見つかっているので、それぞれに
    ",CSTII_sar"を追加します
   他に
   CSTII_shr: Op := otShr; が2つ見つかるので
        CSTII_shr: Op := otShr;
        CSTII_sar: Op := otSar; {行追加}
    のように追加されているはずです

9,最後にLookupTableにKEYWORD追加

   ここまでで一度再コンパイルし、PascalScriptを含むプロジェクトを"掃除して構築"で実行してみましょう https://coconala.com/blogs/2753232/261034
   まだSARは使えません。使うためにはKEYWORD登録します。これまでの捜査で間違えているなら動作が変になっているでしょう。
9-1 uPSUtils.pasで KEYWORD_COUNT を探し1増やします
    元 KEYWORD_COUNT = 65; //*NVDS
                       ↓
    後 KEYWORD_COUNT = 66; //*NVDS {sar追加}
9-2 SHRを検索しアルファベット順を見て1行追加します
      (name: 'REPEAT'; c: CSTII_repeat),
      (name: 'SAR'; c: CSTII_sar), {追加行}
      (name: 'SET'; c: CSTII_set),
      (name: 'SHL'; c: CSTII_shl),
      (name: 'SHR'; c: CSTII_shr),
  名前がLookupTableですから二分検索してる筈です。アルファベット順を壊さないように追加します。

10.実行

 PascalScriptを含むプロジェクトを"掃除して構築"で実行してみましょう
 (-3 sar 1)とか整数型x:=-2  で (x sar 1) の結果が -1 になれば正常です

やっては見たけど・・・・今回の失敗

 これ実際に使ってしまうと自分の環境でしか動かないことになる。
あまり意味ないことやっちゃった。

インラインアセンブラで SAR使うほうが良いよね。

関連ブログ


サービス数40万件のスキルマーケット、あなたにぴったりのサービスを探す ココナラコンテンツマーケット ノウハウ記事・テンプレート・デザイン素材はこちら