(*********************************************************************
 *  *** HAPPy PL/T Dis Assembler version 0.0 **                      *
 *                                                                   *
 *          PL/T = Programming Language / Toy                        *
 *                                                                   *
 *        HAPPyのサンプルプログラム                                  *
 *          (作者  浅野比富美 Public Domain Software)                *
 *********************************************************************)
(*
　　この逆アセンブラは、ＰＬ／Ｔコンパイラでコンパイルしたオブジェクトを逆
  アセンブルし、listファイルに出力する。
    なおこのソースコードは、標準Ｐａｓｃａｌの言語仕様の範囲内で書かれてい
  るので、他の環境に移植するのも容易にできるはずである。

    const,type,var の各部に * 印がついたものは、コンパイラ、逆アセンブラ、
  インタプリタ共通の定義項目である。
*)

program HAPPyPLTdisAssembler(codef,cstf,list) ;

  const

{*} MaxCode    = 1000{番地}   ;         { P-code格納部上限        }
{*} MaxConst   = 1000{番地}   ;         { 定数格納部上限          }

  type

   (*** P-codeオペレーションの定義 ***)
{*}  opType =
         ( iABS,  { absolute                             }
           iADD,  { add                                  }
           iCHK,  { check value                          }
           iCUP,  { call user procedure                  }
           iDIV,  { divide integers                      }
           iENT,  { enter procedure or function          }
           iEOF,  { eof standard function                }
           iEOL,  { eoln standard function               }
           iEQM,  { equal operator for multiple area     }
           iEQU,  { equal operator                       }
           iZJP,  { jump on zero                         }
           iFOR,  { start of for loop                    }
           iGEQ,  { grater than equal operator           }
           iGRT,  { grater than operator                 }
           iINC,  { increment                            }
           iIND,  { indirect fetch                       }
           iINX,  { indexed fetch                        }
           iIXA,  { indexed address                      }
           iLCA,  { load address of constant             }
           iLDA,  { load level p address                 }
           iLDC,  { load constant                        }
           iLEQ,  { less than equal operator             }
           iLES,  { less than operator                   }
           iLOD,  { load contents of address at level p  }
           iMOD,  { modulo operator                      }
           iMOV,  { move                                 }
           iMUL,  { multiple                             }
           iMST,  { mark stack                           }
           iNEG,  { negative                             }
           iNEM,  { not equal operator for multiple area }
           iNEQ,  { not equal operator                   }
           iNOT,  { logical not operator                 }
           iNXT,  { end of for loop                      }
           iRDC,  { read char                            }
           iRDI,  { read integer                         }
           iRET,  { return from procedure or function    }
           iRLN,  { readln standard procedure            }
           iSUB,  { subtract                             }
           iSTI,  { store indirect                       }
           iSTP,  { stop                                 }
           iSTR,  { store contents at address at level p }
           iUJP,  { uncondition jump                     }
           iWLN,  { writeln standard procedure           }
           iWRC,  { write char                           }
           iWRI,  { write integer                        }
           iWRS   { write string                         }
         ) ;

   (**** P-codeの形式定義 ****)
{*} pType = 0..255  ;                             { pオペランドの型    }
{*} qType = integer ;                             { qオペランドの型    }
{*} pCodeType = record
                  op : opType ;                   { 命令部             }
                  p  : pType  ;                   { pオペランド        }
                  q  : qType  ;                   { qオペランド        }
                end ;

{*} codeRange  =  0..MaxCode ;                    { P-code格納域範囲   }


  var

  (*** 入出力ファイル ***)
{*} codef   : file of pCodeType ;                 { P-codeファイル     }
{*} cstf    : file of char      ;                 { 定数ファイル       }
    list    : text              ;                 { リスト出力ファイル }

   (*** P-code仮想計算機記憶装置 ***)
{*} code    : array[codeRange]   of pCodeType ;   { P-code格納域       }
{*} cstTbl  : array[0..MaxConst] of char      ;   { 定数データ格納域   }
               { 現在のところ、文字列を格納する｡
                 各文字列の先頭に、文字列長が入っている構造をしている｡ }

    cdIndex : integer ;                           { P-code命令maxを示す}

   (**** 各命令に関する情報 *****)
    inst    : array[opType] of
                record
                  mnemonic : packed array[1..3] of char ; { ニーモニック     }
                  operand  : (non,pn,nq,pq,pL,nL,nS)      { オペランドの種類 }
                end ;


(****************************)
(*     逆アセンブル処理     *)
(****************************)
  procedure putDisAsmList ;
    var i,j   : integer ;
        lbTbl : array[codeRange] of Boolean ;
  begin
   (* ラベル出力を要する番地を調べる *)
    for i:=0 to cdIndex do lbTbl[i] := false ;
    for i:=0 to cdIndex do
      with code[i] do
        if inst[op].operand in [pL,nL] then lbTbl[q] := true ;

   (* P-codeの逆アセンブルをする *)
    rewrite(list) ;
    writeln(list,' ADDR:  mnc   p           q') ;
    writeln(list,'---------------------------') ;
    for i:=0 to cdIndex do
      with code[i],inst[op] do
      begin
        if lbTbl[i] then write(list,'L')
                    else write(list,' ') ;
        write(list,i:4,':  ',mnemonic) ;
        case operand of                   { オペランドの出力幅は全部で16桁 }
          non : ;
          pn  : write(list,p:4) ;
          nq  : write(list,     q:16) ;
          pq  : write(list,p:4, q:12) ;
          pL  : write(list,p:4, 'L': 8,q:4) ;
          nL  : write(list,     'L':12,q:4) ;
          nS  : begin
                  write(list,' ''') ;
                  for j:=1 to ord(cstTbl[q]) do
                    write(list,cstTbl[q+j]) ;
                  write(list,'''')
                end
        end ;
        writeln(list) ;
        if (i  = 0   ) or         { 0番地の命令はメインプログラムへのujp }
           (op = iRET)    then    { ret命令で そのブロックが終了         }
          writeln(list)           { 区切りを付けてわかりやすくする       }
      end
  end ;

(****************************)
(*    P-codeロード処理      *)
(****************************)
  procedure loadPcode ;
    var i        : integer ;
        cstIndex : integer ;
        cstFlag  : Boolean ;
  begin
  (* P-codeのロード *)
    cdIndex := -1 ;
    reset(codef) ;
    while not eof(codef) do
    begin
      cdIndex := cdIndex + 1 ;
      read(codef,code[cdIndex])
    end ;

   (* 定数部があるか調べる *)
    cstIndex := 0 ;
    cstFlag  := false ;
    for i:=0 to cdIndex do
      if code[i].op = iLCA then cstFlag := true ; { lca命令で定数部を使う }

   (* 定数部があれば、定数ファイルをロード *)
    if cstFlag then
    begin
      reset(cstf) ;
      while not eof(cstf) do
      begin
        read(cstf,cstTbl[cstIndex]) ;
        cstIndex := cstIndex + 1
      end
    end
  end ;

(****************************)
(*       初期設定処理       *)
(****************************)
  procedure initialize ;
  begin
    with inst[iABS] do begin mnemonic := 'abs' ; operand := non  end ;
    with inst[iADD] do begin mnemonic := 'add' ; operand := non  end ;
    with inst[iCHK] do begin mnemonic := 'chk' ; operand := nq   end ;
    with inst[iCUP] do begin mnemonic := 'cup' ; operand := pL   end ;
    with inst[iDIV] do begin mnemonic := 'div' ; operand := non  end ;
    with inst[iENT] do begin mnemonic := 'ent' ; operand := pq   end ;
    with inst[iEOF] do begin mnemonic := 'eof' ; operand := non  end ;
    with inst[iEOL] do begin mnemonic := 'eol' ; operand := non  end ;
    with inst[iEQM] do begin mnemonic := 'eqm' ; operand := nq   end ;
    with inst[iEQU] do begin mnemonic := 'equ' ; operand := non  end ;
    with inst[iZJP] do begin mnemonic := 'zjp' ; operand := nL   end ;
    with inst[iFOR] do begin mnemonic := 'for' ; operand := pL   end ;
    with inst[iGEQ] do begin mnemonic := 'geq' ; operand := non  end ;
    with inst[iGRT] do begin mnemonic := 'grt' ; operand := non  end ;
    with inst[iINC] do begin mnemonic := 'inc' ; operand := nq   end ;
    with inst[iIND] do begin mnemonic := 'ind' ; operand := non  end ;
    with inst[iINX] do begin mnemonic := 'inx' ; operand := non  end ;
    with inst[iIXA] do begin mnemonic := 'ixa' ; operand := nq   end ;
    with inst[iLCA] do begin mnemonic := 'lca' ; operand := nS   end ;
    with inst[iLDA] do begin mnemonic := 'lda' ; operand := pq   end ;
    with inst[iLDC] do begin mnemonic := 'ldc' ; operand := nq   end ;
    with inst[iLEQ] do begin mnemonic := 'leq' ; operand := non  end ;
    with inst[iLES] do begin mnemonic := 'les' ; operand := non  end ;
    with inst[iLOD] do begin mnemonic := 'lod' ; operand := pq   end ;
    with inst[iMOD] do begin mnemonic := 'mod' ; operand := non  end ;
    with inst[iMOV] do begin mnemonic := 'mov' ; operand := nq   end ;
    with inst[iMUL] do begin mnemonic := 'mul' ; operand := non  end ;
    with inst[iMST] do begin mnemonic := 'mst' ; operand := pn   end ;
    with inst[iNEG] do begin mnemonic := 'neg' ; operand := non  end ;
    with inst[iNEM] do begin mnemonic := 'nem' ; operand := nq   end ;
    with inst[iNEQ] do begin mnemonic := 'neq' ; operand := non  end ;
    with inst[iNOT] do begin mnemonic := 'not' ; operand := non  end ;
    with inst[iNXT] do begin mnemonic := 'nxt' ; operand := pL   end ;
    with inst[iRDC] do begin mnemonic := 'rdc' ; operand := non  end ;
    with inst[iRDI] do begin mnemonic := 'rdi' ; operand := non  end ;
    with inst[iRET] do begin mnemonic := 'ret' ; operand := pn   end ;
    with inst[iRLN] do begin mnemonic := 'rln' ; operand := non  end ;
    with inst[iSUB] do begin mnemonic := 'sub' ; operand := non  end ;
    with inst[iSTI] do begin mnemonic := 'sti' ; operand := non  end ;
    with inst[iSTP] do begin mnemonic := 'stp' ; operand := non  end ;
    with inst[iSTR] do begin mnemonic := 'str' ; operand := pq   end ;
    with inst[iUJP] do begin mnemonic := 'ujp' ; operand := nL   end ;
    with inst[iWLN] do begin mnemonic := 'wln' ; operand := non  end ;
    with inst[iWRC] do begin mnemonic := 'wrc' ; operand := non  end ;
    with inst[iWRI] do begin mnemonic := 'wri' ; operand := non  end ;
    with inst[iWRS] do begin mnemonic := 'wrs' ; operand := non  end ;
  end ;

(****************************)
(*       メイン処理         *)
(****************************)
begin
  initialize    ;                       { 初期設定     }
  loadPcode     ;                       { P-codeロード }
  putDisAsmList                         { 逆アセンブル }
end.